mtxrun.lua /size: 695 Kb    last modification: 2025-02-21 11:03
1#!/usr/bin/env texlua
2
3if not modules then modules = { } end modules ['mtxrun'] = {
4    version   = 1.001,
5    comment   = "runner, lua replacement for texmfstart.rb",
6    author    = "Hans Hagen, PRAGMA-ADE, Hasselt NL",
7    copyright = "PRAGMA ADE / ConTeXt Development Team",
8    license   = "see context related readme files"
9}
10
11-- one can make a stub:
12
13-- mtxrun :
14--
15-- #!/bin/sh
16-- env LUATEXDIR=/....../texmf/scripts/context/lua luatex --luaonly mtxrun.lua "$@"
17
18-- mtxrun.cmd :
19--
20-- @luatex --luaonly %~d0%~p0mtxrun.lua %*
21
22-- filename : mtxrun.lua
23-- comment  : companion to context.tex
24-- author   : Hans Hagen, PRAGMA-ADE, Hasselt NL
25-- copyright: PRAGMA ADE / ConTeXt Development Team
26-- license  : see context related readme files
27
28-- This script is based on texmfstart.rb but does not use kpsewhich to locate files.
29-- Although kpse is a library it never came to opening up its interface to other
30-- programs (esp scripting languages) and so we do it ourselves. The lua variant
31-- evolved out of an experimental ruby one. Interesting is that using a scripting
32-- language instead of c does not have a speed penalty. Actually the lua variant is
33-- more efficient, especially when multiple calls to kpsewhich are involved. The lua
34-- library also gives way more control.
35
36-- When libraries used here are updates you can run
37--
38--   mtxrun --selfmerge
39--
40-- to update the embedded code. After that you might need to run
41--
42--   mtxrun --selfupdate
43--
44-- to copy the new script (from scripts/context/lua) to location where
45-- binaries are expected. If you want to remove the embedded code you can run
46--
47--   mtxxun --selfclean
48
49-- to be done / considered
50--
51-- support for --exec or make it default
52-- support for jar files (or maybe not, never used, too messy)
53-- support for $RUBYINPUTS cum suis (if still needed)
54-- remember for subruns: _CTX_K_V_#{original}_
55-- remember for subruns: _CTX_K_S_#{original}_
56-- remember for subruns: TEXMFSTART.#{original} [tex.rb texmfstart.rb]
57
58-- begin library merge
59
60
61
62do -- create closure to overcome 200 locals limit
63
64package.loaded["l-bit32"] = package.loaded["l-bit32"] or true
65
66-- original size: 3607, stripped down to: 3009
67
68if not modules then modules={} end modules ['l-bit32']={
69 version=1.001,
70 license="the same as regular Lua",
71 source="bitwise.lua, v 1.24 2014/12/26 17:20:53 roberto",
72 comment="drop-in for bit32, adapted a bit by Hans Hagen",
73}
74if bit32 then
75elseif utf8 then
76 load ([[
77local select = select -- instead of: arg = { ... }
78bit32 = {
79  bnot = function (a)
80    return ~a & 0xFFFFFFFF
81  end,
82  band = function (x, y, z, ...)
83    if not z then
84      return ((x or -1) & (y or -1)) & 0xFFFFFFFF
85    else
86      local res = x & y & z
87      for i=1,select("#",...) do
88        res = res & select(i,...)
89      end
90      return res & 0xFFFFFFFF
91    end
92  end,
93  bor = function (x, y, z, ...)
94    if not z then
95      return ((x or 0) | (y or 0)) & 0xFFFFFFFF
96    else
97      local res = x | y | z
98      for i=1,select("#",...) do
99        res = res | select(i,...)
100      end
101      return res & 0xFFFFFFFF
102    end
103  end,
104  bxor = function (x, y, z, ...)
105    if not z then
106      return ((x or 0) ~ (y or 0)) & 0xFFFFFFFF
107    else
108      local res = x ~ y ~ z
109      for i=1,select("#",...) do
110        res = res ~ select(i,...)
111      end
112      return res & 0xFFFFFFFF
113    end
114  end,
115  btest = function (x, y, z, ...)
116    if not z then
117      return (((x or -1) & (y or -1)) & 0xFFFFFFFF) ~= 0
118    else
119      local res = x & y & z
120      for i=1,select("#",...) do
121          res = res & select(i,...)
122      end
123      return (res & 0xFFFFFFFF) ~= 0
124    end
125  end,
126  lshift = function (a, b)
127    return ((a & 0xFFFFFFFF) << b) & 0xFFFFFFFF
128  end,
129  rshift = function (a, b)
130    return ((a & 0xFFFFFFFF) >> b) & 0xFFFFFFFF
131  end,
132  arshift = function (a, b)
133    a = a & 0xFFFFFFFF
134    if b <= 0 or (a & 0x80000000) == 0 then
135      return (a >> b) & 0xFFFFFFFF
136    else
137      return ((a >> b) | ~(0xFFFFFFFF >> b)) & 0xFFFFFFFF
138    end
139  end,
140  lrotate = function (a ,b)
141    b = b & 31
142    a = a & 0xFFFFFFFF
143    a = (a << b) | (a >> (32 - b))
144    return a & 0xFFFFFFFF
145  end,
146  rrotate = function (a, b)
147    b = -b & 31
148    a = a & 0xFFFFFFFF
149    a = (a << b) | (a >> (32 - b))
150    return a & 0xFFFFFFFF
151  end,
152  extract = function (a, f, w)
153    return (a >> f) & ~(-1 << (w or 1))
154  end,
155  replace = function (a, v, f, w)
156    local mask = ~(-1 << (w or 1))
157    return ((a & ~(mask << f)) | ((v & mask) << f)) & 0xFFFFFFFF
158  end,
159}
160        ]] ) ()
161elseif bit then
162 load ([[
163local band, bnot, rshift, lshift = bit.band, bit.bnot, bit.rshift, bit.lshift
164bit32 = {
165  arshift = bit.arshift,
166  band    = band,
167  bnot    = bnot,
168  bor     = bit.bor,
169  bxor    = bit.bxor,
170  btest   = function(...)
171    return band(...) ~= 0
172  end,
173  extract = function(a,f,w)
174    return band(rshift(a,f),2^(w or 1)-1)
175  end,
176  lrotate = bit.rol,
177  lshift  = lshift,
178  replace = function(a,v,f,w)
179    local mask = 2^(w or 1)-1
180    return band(a,bnot(lshift(mask,f)))+lshift(band(v,mask),f)
181  end,
182  rrotate = bit.ror,
183  rshift  = rshift,
184}
185        ]] ) ()
186else
187 xpcall(function() local _,t=require("bit32") if t then bit32=t end return end,function() end)
188end
189
190
191end -- of closure
192
193do -- create closure to overcome 200 locals limit
194
195package.loaded["l-lua"] = package.loaded["l-lua"] or true
196
197-- original size: 6546, stripped down to: 2909
198
199if not modules then modules={} end modules ['l-lua']={
200 version=1.001,
201 comment="companion to luat-lib.mkiv",
202 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
203 copyright="PRAGMA ADE / ConTeXt Development Team",
204 license="see context related readme files"
205}
206local next,type,tonumber=next,type,tonumber
207LUAMAJORVERSION,LUAMINORVERSION=string.match(_VERSION,"^[^%d]+(%d+)%.(%d+).*$")
208LUAMAJORVERSION=tonumber(LUAMAJORVERSION) or 5
209LUAMINORVERSION=tonumber(LUAMINORVERSION) or 1
210LUAVERSION=LUAMAJORVERSION+LUAMINORVERSION/10
211LUAFORMAT=status and status.lua_format or 0
212if LUAVERSION<5.2 and jit then
213 MINORVERSION=2
214 LUAVERSION=5.2
215end
216if not lpeg then
217 lpeg=require("lpeg")
218end
219if loadstring then
220 local loadnormal=load
221 function load(first,...)
222  if type(first)=="string" then
223   return loadstring(first,...)
224  else
225   return loadnormal(first,...)
226  end
227 end
228else
229 loadstring=load
230end
231if not ipairs then
232 local function iterate(a,i)
233  i=i+1
234  local v=a[i]
235  if v~=nil then
236   return i,v 
237  end
238 end
239 function ipairs(a)
240  return iterate,a,0
241 end
242end
243if not pairs then
244 function pairs(t)
245  return next,t 
246 end
247end
248if not table.unpack then
249 table.unpack=_G.unpack
250elseif not unpack then
251 _G.unpack=table.unpack
252end
253if not package.loaders then 
254 package.loaders=package.searchers
255end
256local print,select,tostring=print,select,tostring
257local inspectors={}
258function setinspector(kind,inspector) 
259 inspectors[kind]=inspector
260end
261function inspect(...) 
262 for s=1,select("#",...) do
263  local value=select(s,...)
264  if value==nil then
265   print("nil")
266  else
267   local done=false
268   local kind=type(value)
269   local inspector=inspectors[kind]
270   if inspector then
271    done=inspector(value)
272    if done then
273     break
274    end
275   end
276   for kind,inspector in next,inspectors do
277    done=inspector(value)
278    if done then
279     break
280    end
281   end
282   if not done then
283    print(tostring(value))
284   end
285  end
286 end
287end
288local dummy=function() end
289function optionalrequire(...)
290 local ok,result=xpcall(require,dummy,...)
291 if ok then
292  return result
293 end
294end
295local flush=io.flush
296if flush then
297 local execute=os.execute if execute then function os.execute(...) flush() return execute(...) end end
298 local exec=os.exec if exec then function os.exec   (...) flush() return exec   (...) end end
299 local spawn=os.spawn   if spawn   then function os.spawn  (...) flush() return spawn  (...) end end
300 local popen=io.popen   if popen   then function io.popen  (...) flush() return popen  (...) end end
301end
302FFISUPPORTED=type(ffi)=="table" and ffi.os~="" and ffi.arch~="" and ffi.load
303if not FFISUPPORTED then
304 local okay;okay,ffi=pcall(require,"ffi")
305 FFISUPPORTED=type(ffi)=="table" and ffi.os~="" and ffi.arch~="" and ffi.load
306end
307if not FFISUPPORTED then
308 ffi=nil
309elseif not ffi.number then
310 ffi.number=tonumber
311end
312if LUAVERSION>5.3 then
313end
314if status and os.setenv then
315 os.setenv("engine",string.lower(status.luatex_engine or "unknown"))
316end
317
318
319end -- of closure
320
321do -- create closure to overcome 200 locals limit
322
323package.loaded["l-macro"] = package.loaded["l-macro"] or true
324
325-- original size: 10130, stripped down to: 5990
326
327if not modules then modules={} end modules ['l-macros']={
328 version=1.001,
329 comment="companion to luat-lib.mkiv",
330 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
331 copyright="PRAGMA ADE / ConTeXt Development Team",
332 license="see context related readme files"
333}
334local S,P,R,V,C,Cs,Cc,Ct,Carg=lpeg.S,lpeg.P,lpeg.R,lpeg.V,lpeg.C,lpeg.Cs,lpeg.Cc,lpeg.Ct,lpeg.Carg
335local lpegmatch=lpeg.match
336local concat=table.concat
337local format,sub,match=string.format,string.sub,string.match
338local next,load,type=next,load,type
339local newline=S("\n\r")^1
340local continue=P("\\")*newline
341local whitespace=S(" \t\n\r")
342local spaces=S(" \t")+continue
343local nametoken=R("az","AZ","__","09")
344local name=nametoken^1
345local body=((continue/""+1)-newline)^1
346local lparent=P("(")
347local rparent=P(")")
348local noparent=1-(lparent+rparent)
349local nested=P { lparent*(noparent+V(1))^0*rparent }
350local escaped=P("\\")*P(1)
351local squote=P("'")
352local dquote=P('"')
353local quoted=dquote*(escaped+(1-dquote))^0*dquote+squote*(escaped+(1-squote))^0*squote
354local arguments=lparent*Ct((Cs((nested+(quoted+1-S("),")))^1)+S(", "))^0)*rparent
355local macros=lua.macros or {}
356lua.macros=macros
357local patterns={}
358local definitions={}
359local resolve
360local subparser
361local report_lua=function(...)
362 if logs and logs.reporter then
363  report_lua=logs.reporter("system","lua")
364  report_lua(...)
365 else
366  print(format(...))
367 end
368end
369local safeguard=P("local")*whitespace^1*name*(whitespace+P("="))
370resolve=safeguard+C(C(name)*(arguments^-1))/function(raw,s,a)
371 local d=definitions[s]
372 if d then
373  if a then
374   local n=#a
375   local p=patterns[s][n]
376   if p then
377    local d=d[n]
378    for i=1,n do
379     a[i]=lpegmatch(subparser,a[i]) or a[i]
380    end
381    return lpegmatch(p,d,1,a) or d
382   else
383    return raw
384   end
385  else
386   return d[0] or raw
387  end
388 elseif a then
389  for i=1,#a do
390   a[i]=lpegmatch(subparser,a[i]) or a[i]
391  end
392  return s.."("..concat(a,",")..")"
393 else
394  return raw
395 end
396end
397subparser=Cs((resolve+P(1))^1)
398local enddefine=P("#enddefine")/""
399local beginregister=(C(name)*(arguments+Cc(false))*C((1-enddefine)^1)*enddefine)/function(k,a,v)
400 local n=0
401 if a then
402  n=#a
403  local pattern=P(false)
404  for i=1,n do
405   pattern=pattern+(P(a[i])*Carg(1))/function(t) return t[i] end
406  end
407  pattern=Cs((pattern+P(1))^1)
408  local p=patterns[k]
409  if not p then
410   p={ [0]=false,false,false,false,false,false,false,false,false }
411   patterns[k]=p
412  end
413  p[n]=pattern
414 end
415 local d=definitions[k]
416 if not d then
417  d={ a=a,[0]=false,false,false,false,false,false,false,false,false }
418  definitions[k]=d
419 end
420 d[n]=lpegmatch(subparser,v) or v
421 return ""
422end
423local register=(Cs(name)*(arguments+Cc(false))*spaces^0*Cs(body))/function(k,a,v)
424 local n=0
425 if a then
426  n=#a
427  local pattern=P(false)
428  for i=1,n do
429   pattern=pattern+(P(a[i])*Carg(1))/function(t) return t[i] end
430  end
431  pattern=Cs((pattern+P(1))^1)
432  local p=patterns[k]
433  if not p then
434   p={ [0]=false,false,false,false,false,false,false,false,false }
435   patterns[k]=p
436  end
437  p[n]=pattern
438 end
439 local d=definitions[k]
440 if not d then
441  d={ a=a,[0]=false,false,false,false,false,false,false,false,false }
442  definitions[k]=d
443 end
444 d[n]=lpegmatch(subparser,v) or v
445 return ""
446end
447local unregister=(C(name)*spaces^0*(arguments+Cc(false)))/function(k,a)
448 local n=0
449 if a then
450  n=#a
451  local p=patterns[k]
452  if p then
453   p[n]=false
454  end
455 end
456 local d=definitions[k]
457 if d then
458  d[n]=false
459 end
460 return ""
461end
462local begindefine=(P("begindefine")*spaces^0/"")*beginregister
463local define=(P("define"  )*spaces^0/"")*register
464local undefine=(P("undefine"   )*spaces^0/"")*unregister
465local parser=Cs((((P("#")/"")*(define+begindefine+undefine)*(newline^0/"") )+resolve+P(1) )^0 )
466function macros.reset()
467 definitions={}
468 patterns={}
469end
470function macros.showdefinitions()
471 for name,list in table.sortedhash(definitions) do
472  local arguments=list.a
473  if arguments then
474   arguments="("..concat(arguments,",")..")"
475  else
476   arguments=""
477  end
478  print("macro: "..name..arguments)
479  for i=0,#list do
480   local l=list[i]
481   if l then
482    print("  "..l)
483   end
484  end
485 end
486end
487function macros.resolvestring(str)
488 return lpegmatch(parser,str) or str
489end
490function macros.resolving()
491 return next(patterns)
492end
493local function reload(path,name,data)
494 local only=match(name,".-([^/]+)%.lua")
495 if only and only~="" then
496  local name=path.."/"..only
497  local f=io.open(name,"wb")
498  f:write(data)
499  f:close()
500  local f=loadfile(name)
501  os.remove(name)
502  return f
503 end
504end
505local function reload(path,name,data)
506 if path and path~="" then
507  local only=string.match(name,".-([^/]+)%.lua")
508  if only and only~="" then
509   local name=path.."/"..only.."-macro.lua"
510   local f=io.open(name,"wb")
511   if f then
512    f:write(data)
513    f:close()
514    local l=loadfile(name)
515    os.remove(name)
516    return l
517   end
518  end
519 end
520 return load(data,name)
521end
522local function loaded(name,trace,detail)
523 local f=io.open(name,"rb")
524 if not f then
525  return false,format("file '%s' not found",name)
526 end
527 local c=f:read("*a")
528 if not c then
529  return false,format("file '%s' is invalid",name)
530 end
531 f:close()
532 local n=lpegmatch(parser,c)
533 if trace then
534  if #n~=#c then
535   report_lua("macros expanded in '%s' (%i => %i bytes)",name,#c,#n)
536   if detail then
537    report_lua()
538    report_lua(n)
539    report_lua()
540   end
541  elseif detail then
542   report_lua("no macros expanded in '%s'",name)
543  end
544 end
545 return reload(lfs and lfs.currentdir(),name,n)
546end
547macros.loaded=loaded
548function required(name,trace)
549 local filename=file.addsuffix(name,"lua")
550 local fullname=resolvers and resolvers.findfile(filename) or filename
551 if not fullname or fullname=="" then
552  return false
553 end
554 local codeblob=package.loaded[fullname]
555 if codeblob then
556  return codeblob
557 end
558 local code,message=loaded(fullname,macros,trace,trace)
559 if type(code)=="function" then
560  code=code()
561 else
562  report_lua("error when loading '%s'",fullname)
563  return false,message
564 end
565 if code==nil then
566  code=false
567 end
568 package.loaded[fullname]=code
569 return code
570end
571macros.required=required
572
573
574end -- of closure
575
576do -- create closure to overcome 200 locals limit
577
578package.loaded["l-sandbox"] = package.loaded["l-sandbox"] or true
579
580-- original size: 9604, stripped down to: 6394
581
582if not modules then modules={} end modules ['l-sandbox']={
583 version=1.001,
584 comment="companion to luat-lib.mkiv",
585 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
586 copyright="PRAGMA ADE / ConTeXt Development Team",
587 license="see context related readme files"
588}
589local global=_G
590local next=next
591local unpack=unpack or table.unpack
592local type=type
593local tprint=texio and texio.write_nl or print
594local tostring=tostring
595local format=string.format 
596local concat=table.concat
597local sort=table.sort
598local gmatch=string.gmatch
599local gsub=string.gsub
600local requiem=require
601sandbox={}
602local sandboxed=false
603local overloads={}
604local skiploads={}
605local initializers={}
606local finalizers={}
607local originals={}
608local comments={}
609local trace=false
610local logger=false
611local blocked={}
612local function report(...)
613 tprint("sandbox         ! "..format(...)) 
614end
615sandbox.report=report
616function sandbox.setreporter(r)
617 report=r
618 sandbox.report=r
619end
620function sandbox.settrace(v)
621 trace=v
622end
623function sandbox.setlogger(l)
624 logger=type(l)=="function" and l or false
625end
626local function register(func,overload,comment)
627 if type(func)=="function" then
628  if type(overload)=="string" then
629   comment=overload
630   overload=nil
631  end
632  local function f(...)
633   if sandboxed then
634    local overload=overloads[f]
635    if overload then
636     if logger then
637      local result={ overload(func,...) }
638      logger {
639       comment=comments[f] or tostring(f),
640       arguments={... },
641       result=result[1] and true or false,
642      }
643      return unpack(result)
644     else
645      return overload(func,...)
646     end
647    else
648    end
649   else
650    return func(...)
651   end
652  end
653  if comment then
654   comments[f]=comment
655   if trace then
656    report("registering function: %s",comment)
657   end
658  end
659  overloads[f]=overload or false
660  originals[f]=func
661  return f
662 end
663end
664local function redefine(func,comment)
665 if type(func)=="function" then
666  skiploads[func]=comment or comments[func] or "unknown"
667  if overloads[func]==false then
668   overloads[func]=nil 
669  end
670 end
671end
672sandbox.register=register
673sandbox.redefine=redefine
674function sandbox.original(func)
675 return originals and originals[func] or func
676end
677function sandbox.overload(func,overload,comment)
678 comment=comment or comments[func] or "?"
679 if type(func)~="function" then
680  if trace then
681   report("overloading unknown function: %s",comment)
682  end
683 elseif type(overload)~="function" then
684  if trace then
685   report("overloading function with bad overload: %s",comment)
686  end
687 elseif overloads[func]==nil then
688  if trace then
689   report("function is not registered: %s",comment)
690  end
691 elseif skiploads[func] then
692  if trace then
693   report("function is not skipped: %s",comment)
694  end
695 else
696  if trace then
697   report("overloading function: %s",comment)
698  end
699  overloads[func]=overload
700 end
701 return func
702end
703local function whatever(specification,what,target)
704 if type(specification)~="table" then
705  report("%s needs a specification",what)
706 elseif type(specification.category)~="string" or type(specification.action)~="function" then
707  report("%s needs a category and action",what)
708 elseif not sandboxed then
709  target[#target+1]=specification
710 elseif trace then
711  report("already enabled, discarding %s",what)
712 end
713end
714function sandbox.initializer(specification)
715 whatever(specification,"initializer",initializers)
716end
717function sandbox.finalizer(specification)
718 whatever(specification,"finalizer",finalizers)
719end
720function require(name)
721 local n=gsub(name,"^.*[\\/]","")
722 local n=gsub(n,"[%.].*$","")
723 local b=blocked[n]
724 if b==false then
725  return nil 
726 elseif b then
727  if trace then
728   report("using blocked: %s",n)
729  end
730  return b
731 else
732  if trace then
733   report("requiring: %s",name)
734  end
735  return requiem(name)
736 end
737end
738function blockrequire(name,lib)
739 if trace then
740  report("preventing reload of: %s",name)
741 end
742 blocked[name]=lib or _G[name] or false
743end
744function sandbox.enable()
745 if not sandboxed then
746  debug={
747   traceback=debug.traceback,
748  }
749  for i=1,#initializers do
750   initializers[i].action()
751  end
752  for i=1,#finalizers do
753   finalizers[i].action()
754  end
755  local nnot=0
756  local nyes=0
757  local cnot={}
758  local cyes={}
759  local skip={}
760  for k,v in next,overloads do
761   local c=comments[k]
762   if v then
763    if c then
764     cyes[#cyes+1]=c
765    else 
766     nyes=nyes+1
767    end
768   else
769    if c then
770     cnot[#cnot+1]=c
771    else 
772     nnot=nnot+1
773    end
774   end
775  end
776  for k,v in next,skiploads do
777   skip[#skip+1]=v
778  end
779  if #cyes>0 then
780   sort(cyes)
781   report("overloaded known: %s",concat(cyes," | "))
782  end
783  if nyes>0 then
784   report("overloaded unknown: %s",nyes)
785  end
786  if #cnot>0 then
787   sort(cnot)
788   report("not overloaded known: %s",concat(cnot," | "))
789  end
790  if nnot>0 then
791   report("not overloaded unknown: %s",nnot)
792  end
793  if #skip>0 then
794   sort(skip)
795   report("not overloaded redefined: %s",concat(skip," | "))
796  end
797  initializers=nil
798  finalizers=nil
799  originals=nil
800  sandboxed=true
801 end
802end
803blockrequire("lfs",lfs)
804blockrequire("io",io)
805blockrequire("os",os)
806blockrequire("ffi",ffi)
807local function supported(library)
808 local l=_G[library]
809 return l
810end
811loadfile=register(loadfile,"loadfile")
812if supported("lua") then
813 lua.openfile=register(lua.openfile,"lua.openfile")
814end
815if supported("io") then
816 io.open=register(io.open,"io.open")
817 io.popen=register(io.popen,"io.popen") 
818 io.lines=register(io.lines,"io.lines")
819 io.output=register(io.output,"io.output")
820 io.input=register(io.input,"io.input")
821end
822if supported("os") then
823 os.execute=register(os.execute,"os.execute")
824 os.spawn=register(os.spawn,"os.spawn")
825 os.exec=register(os.exec,"os.exec")
826 os.rename=register(os.rename,"os.rename")
827 os.remove=register(os.remove,"os.remove")
828end
829if supported("lfs") then
830 lfs.chdir=register(lfs.chdir,"lfs.chdir")
831 lfs.mkdir=register(lfs.mkdir,"lfs.mkdir")
832 lfs.rmdir=register(lfs.rmdir,"lfs.rmdir")
833 lfs.isfile=register(lfs.isfile,"lfs.isfile")
834 lfs.isdir=register(lfs.isdir,"lfs.isdir")
835 lfs.attributes=register(lfs.attributes,"lfs.attributes")
836 lfs.dir=register(lfs.dir,"lfs.dir")
837 lfs.lock_dir=register(lfs.lock_dir,"lfs.lock_dir")
838 lfs.touch=register(lfs.touch,"lfs.touch")
839 lfs.link=register(lfs.link,"lfs.link")
840 lfs.setmode=register(lfs.setmode,"lfs.setmode")
841 lfs.readlink=register(lfs.readlink,"lfs.readlink")
842 lfs.shortname=register(lfs.shortname,"lfs.shortname")
843 lfs.symlinkattributes=register(lfs.symlinkattributes,"lfs.symlinkattributes")
844end
845
846
847end -- of closure
848
849do -- create closure to overcome 200 locals limit
850
851package.loaded["l-package"] = package.loaded["l-package"] or true
852
853-- original size: 12566, stripped down to: 8937
854
855if not modules then modules={} end modules ['l-package']={
856 version=1.001,
857 comment="companion to luat-lib.mkiv",
858 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
859 copyright="PRAGMA ADE / ConTeXt Development Team",
860 license="see context related readme files"
861}
862local type,unpack=type,unpack
863local gsub,format,find=string.gsub,string.format,string.find
864local insert,remove=table.insert,table.remove
865local P,S,Cs,lpegmatch=lpeg.P,lpeg.S,lpeg.Cs,lpeg.match
866local package=package
867local searchers=package.searchers or package.loaders
868local filejoin=file and file.join  or function(path,name)   return path.."/"..name end
869local isreadable=file and file.is_readable or function(name)  local f=io.open(name) if f then f:close() return true end end
870local addsuffix=file and file.addsuffix   or function(name,suffix) return name.."."..suffix end
871local function cleanpath(path) 
872 return path
873end
874local pattern=Cs((((1-S("\\/"))^0*(S("\\/")^1/"/"))^0*(P(".")^1/"/"+P(1))^1)*-1)
875local function lualibfile(name)
876 return lpegmatch(pattern,name) or name
877end
878local offset=luarocks and 1 or 0 
879local helpers=package.helpers or {
880 cleanpath=cleanpath,
881 lualibfile=lualibfile,
882 trace=false,
883 report=function(...) print(format(...)) end,
884 builtin={
885  ["preload table"]=searchers[1+offset],
886  ["path specification"]=searchers[2+offset],
887  ["cpath specification"]=searchers[3+offset],
888  ["all in one fallback"]=searchers[4+offset],
889 },
890 methods={},
891 sequence={
892  "reset loaded",
893  "already loaded",
894  "preload table",
895  "qualified path",
896  "lua extra list",
897  "lib extra list",
898  "path specification",
899  "cpath specification",
900  "all in one fallback",
901  "not loaded",
902 }
903}
904package.helpers=helpers
905local methods=helpers.methods
906local builtin=helpers.builtin
907local extraluapaths={}
908local extralibpaths={}
909local checkedfiles={}
910local luapaths=nil 
911local libpaths=nil 
912local oldluapath=nil
913local oldlibpath=nil
914local nofextralua=-1
915local nofextralib=-1
916local nofpathlua=-1
917local nofpathlib=-1
918local function listpaths(what,paths)
919 local nofpaths=#paths
920 if nofpaths>0 then
921  for i=1,nofpaths do
922   helpers.report("using %s path %i: %s",what,i,paths[i])
923  end
924 else
925  helpers.report("no %s paths defined",what)
926 end
927 return nofpaths
928end
929local function getextraluapaths()
930 if helpers.trace and #extraluapaths~=nofextralua then
931  nofextralua=listpaths("extra lua",extraluapaths)
932 end
933 return extraluapaths
934end
935local function getextralibpaths()
936 if helpers.trace and #extralibpaths~=nofextralib then
937  nofextralib=listpaths("extra lib",extralibpaths)
938 end
939 return extralibpaths
940end
941local function getluapaths()
942 local luapath=package.path or ""
943 if oldluapath~=luapath then
944  luapaths=file.splitpath(luapath,";")
945  oldluapath=luapath
946  nofpathlua=-1
947 end
948 if helpers.trace and #luapaths~=nofpathlua then
949  nofpathlua=listpaths("builtin lua",luapaths)
950 end
951 return luapaths
952end
953local function getlibpaths()
954 local libpath=package.cpath or ""
955 if oldlibpath~=libpath then
956  libpaths=file.splitpath(libpath,";")
957  oldlibpath=libpath
958  nofpathlib=-1
959 end
960 if helpers.trace and #libpaths~=nofpathlib then
961  nofpathlib=listpaths("builtin lib",libpaths)
962 end
963 return libpaths
964end
965package.luapaths=getluapaths
966package.libpaths=getlibpaths
967package.extraluapaths=getextraluapaths
968package.extralibpaths=getextralibpaths
969local hashes={
970 lua={},
971 lib={},
972}
973local function registerpath(tag,what,target,...)
974 local pathlist={... }
975 local cleanpath=helpers.cleanpath
976 local trace=helpers.trace
977 local report=helpers.report
978 local hash=hashes[what]
979 local function add(path)
980  local path=cleanpath(path)
981  if not hash[path] then
982   target[#target+1]=path
983   hash[path]=true
984   if trace then
985    report("registered %s path %s: %s",tag,#target,path)
986   end
987  else
988   if trace then
989    report("duplicate %s path: %s",tag,path)
990   end
991  end
992 end
993 for p=1,#pathlist do
994  local path=pathlist[p]
995  if type(path)=="table" then
996   for i=1,#path do
997    add(path[i])
998   end
999  else
1000   add(path)
1001  end
1002 end
1003end
1004local function pushpath(tag,what,target,path)
1005 local path=helpers.cleanpath(path)
1006 insert(target,1,path)
1007 if helpers.trace then
1008  helpers.report("pushing %s path in front: %s",tag,path)
1009 end
1010end
1011local function poppath(tag,what,target)
1012 local path=remove(target,1)
1013 if helpers.trace then
1014  if path then
1015   helpers.report("popping %s path from front: %s",tag,path)
1016  else
1017   helpers.report("no %s path to pop",tag)
1018  end
1019 end
1020end
1021helpers.registerpath=registerpath
1022function package.extraluapath(...)
1023 registerpath("extra lua","lua",extraluapaths,...)
1024end
1025function package.pushluapath(path)
1026 pushpath("extra lua","lua",extraluapaths,path)
1027end
1028function package.popluapath()
1029 poppath("extra lua","lua",extraluapaths)
1030end
1031function package.extralibpath(...)
1032 registerpath("extra lib","lib",extralibpaths,...)
1033end
1034function package.pushlibpath(path)
1035 pushpath("extra lib","lib",extralibpaths,path)
1036end
1037function package.poplibpath()
1038 poppath("extra lib","lua",extralibpaths)
1039end
1040local function loadedaslib(resolved,rawname) 
1041 local base=gsub(rawname,"%.","_")
1042 local init="luaopen_"..gsub(base,"%.","_")
1043 local data={ resolved,init,"" }
1044 checkedfiles[#checkedfiles+1]=data
1045 if helpers.trace then
1046  helpers.report("calling loadlib with '%s' with init '%s'",resolved,init)
1047 end
1048 local a,b,c=package.loadlib(resolved,init)
1049 if not a and type(b)=="string" then
1050  data[3]=string.fullstrip(b or "unknown error")
1051 end
1052 return a,b,c 
1053end
1054helpers.loadedaslib=loadedaslib
1055local function loadedbypath(name,rawname,paths,islib,what)
1056 local trace=helpers.trace
1057 for p=1,#paths do
1058  local path=paths[p]
1059  local resolved=filejoin(path,name)
1060  if trace then
1061   helpers.report("%s path, identifying '%s' on '%s'",what,name,path)
1062  end
1063  if isreadable(resolved) then
1064   if trace then
1065    helpers.report("%s path, '%s' found on '%s'",what,name,resolved)
1066   end
1067   if islib then
1068    return loadedaslib(resolved,rawname)
1069   else
1070    return loadfile(resolved)
1071   end
1072  end
1073 end
1074end
1075helpers.loadedbypath=loadedbypath
1076local function loadedbyname(name,rawname)
1077 if find(name,"^/") or find(name,"^[a-zA-Z]:/") then
1078  local trace=helpers.trace
1079  if trace then
1080   helpers.report("qualified name, identifying '%s'",what,name)
1081  end
1082  if isreadable(name) then
1083   if trace then
1084    helpers.report("qualified name, '%s' found",what,name)
1085   end
1086   return loadfile(name)
1087  end
1088 end
1089end
1090helpers.loadedbyname=loadedbyname
1091methods["reset loaded"]=function(name)
1092 checkedfiles={}
1093 return false
1094end
1095methods["already loaded"]=function(name)
1096 return package.loaded[name]
1097end
1098methods["preload table"]=function(name)
1099 local f=builtin["preload table"]
1100 if f then
1101  return f(name)
1102 end
1103end
1104methods["qualified path"]=function(name)
1105  return loadedbyname(addsuffix(lualibfile(name),"lua"),name)
1106end
1107methods["lua extra list"]=function(name)
1108 return loadedbypath(addsuffix(lualibfile(name),"lua"),name,getextraluapaths(),false,"lua")
1109end
1110methods["lib extra list"]=function(name)
1111 return loadedbypath(addsuffix(lualibfile(name),os.libsuffix),name,getextralibpaths(),true,"lib")
1112end
1113methods["path specification"]=function(name)
1114 local f=builtin["path specification"]
1115 if f then
1116  getluapaths() 
1117  return f(name)
1118 end
1119end
1120methods["cpath specification"]=function(name)
1121 local f=builtin["cpath specification"]
1122 if f then
1123  getlibpaths() 
1124  return f(name)
1125 end
1126end
1127methods["all in one fallback"]=function(name)
1128 local f=builtin["all in one fallback"]
1129 if f then
1130  return f(name)
1131 end
1132end
1133methods["not loaded"]=function(name)
1134 if helpers.trace then
1135  helpers.report("unable to locate '%s'",name or "?")
1136  for i=1,#checkedfiles do
1137   helpers.report("checked file '%s', initializer '%s', message '%s'",unpack(checkedfiles[i]))
1138  end
1139 end
1140 return nil
1141end
1142local level=0
1143local used={}
1144helpers.traceused=false
1145function helpers.loaded(name)
1146 local sequence=helpers.sequence
1147 level=level+1
1148 for i=1,#sequence do
1149  local method=sequence[i]
1150  local lookup=method and methods[method]
1151  if type(lookup)=="function" then
1152   if helpers.trace then
1153    helpers.report("%s, level '%s', method '%s', name '%s'","locating",level,method,name)
1154   end
1155   local result,rest=lookup(name)
1156   if type(result)=="function" then
1157    if helpers.trace then
1158     helpers.report("%s, level '%s', method '%s', name '%s'","found",level,method,name)
1159    end
1160    if helpers.traceused then
1161     used[#used+1]={ level=level,name=name }
1162    end
1163    level=level-1
1164    return result,rest
1165   end
1166  end
1167 end
1168 level=level-1
1169 return nil
1170end
1171function helpers.showused()
1172 local n=#used
1173 if n>0 then
1174  helpers.report("%s libraries loaded:",n)
1175  helpers.report()
1176  for i=1,n do
1177   local u=used[i]
1178   helpers.report("%i %a",u.level,u.name)
1179  end
1180  helpers.report()
1181  end
1182end
1183function helpers.unload(name)
1184 if helpers.trace then
1185  if package.loaded[name] then
1186   helpers.report("unloading, name '%s', %s",name,"done")
1187  else
1188   helpers.report("unloading, name '%s', %s",name,"not loaded")
1189  end
1190 end
1191 package.loaded[name]=nil
1192end
1193table.insert(searchers,1,helpers.loaded)
1194if context then
1195 package.path=""
1196end
1197
1198
1199end -- of closure
1200
1201do -- create closure to overcome 200 locals limit
1202
1203package.loaded["l-lpeg"] = package.loaded["l-lpeg"] or true
1204
1205-- original size: 38742, stripped down to: 19489
1206
1207if not modules then modules={} end modules ['l-lpeg']={
1208 version=1.001,
1209 comment="companion to luat-lib.mkiv",
1210 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
1211 copyright="PRAGMA ADE / ConTeXt Development Team",
1212 license="see context related readme files"
1213}
1214lpeg=require("lpeg") 
1215local lpeg=lpeg
1216if not lpeg.print then function lpeg.print(...) print(lpeg.pcode(...)) end end
1217local type,next,tostring=type,next,tostring
1218local byte,char,gmatch,format=string.byte,string.char,string.gmatch,string.format
1219local floor=math.floor
1220local P,R,S,V,Ct,C,Cs,Cc,Cp,Cmt=lpeg.P,lpeg.R,lpeg.S,lpeg.V,lpeg.Ct,lpeg.C,lpeg.Cs,lpeg.Cc,lpeg.Cp,lpeg.Cmt
1221local lpegtype,lpegmatch,lpegprint=lpeg.type,lpeg.match,lpeg.print
1222if setinspector then
1223 setinspector("lpeg",function(v) if lpegtype(v) then lpegprint(v) return true end end)
1224end
1225lpeg.patterns=lpeg.patterns or {} 
1226local patterns=lpeg.patterns
1227local anything=P(1)
1228local endofstring=P(-1)
1229local alwaysmatched=P(true)
1230patterns.anything=anything
1231patterns.endofstring=endofstring
1232patterns.beginofstring=alwaysmatched
1233patterns.alwaysmatched=alwaysmatched
1234local sign=S('+-')
1235local zero=P('0')
1236local digit=R('09')
1237local digits=digit^1
1238local octdigit=R("07")
1239local octdigits=octdigit^1
1240local lowercase=R("az")
1241local uppercase=R("AZ")
1242local underscore=P("_")
1243local hexdigit=digit+lowercase+uppercase
1244local hexdigits=hexdigit^1
1245local cr,lf,crlf=P("\r"),P("\n"),P("\r\n")
1246local newline=P("\r")*(P("\n")+P(true))+P("\n")  
1247local escaped=P("\\")*anything
1248local squote=P("'")
1249local dquote=P('"')
1250local space=P(" ")
1251local period=P(".")
1252local comma=P(",")
1253local utfbom_32_be=P('\000\000\254\255') 
1254local utfbom_32_le=P('\255\254\000\000') 
1255local utfbom_16_be=P('\254\255')   
1256local utfbom_16_le=P('\255\254')   
1257local utfbom_8=P('\239\187\191')  
1258local utfbom=utfbom_32_be+utfbom_32_le+utfbom_16_be+utfbom_16_le+utfbom_8
1259local utftype=utfbom_32_be*Cc("utf-32-be")+utfbom_32_le*Cc("utf-32-le")+utfbom_16_be*Cc("utf-16-be")+utfbom_16_le*Cc("utf-16-le")+utfbom_8*Cc("utf-8")+alwaysmatched*Cc("utf-8") 
1260local utfstricttype=utfbom_32_be*Cc("utf-32-be")+utfbom_32_le*Cc("utf-32-le")+utfbom_16_be*Cc("utf-16-be")+utfbom_16_le*Cc("utf-16-le")+utfbom_8*Cc("utf-8")
1261local utfoffset=utfbom_32_be*Cc(4)+utfbom_32_le*Cc(4)+utfbom_16_be*Cc(2)+utfbom_16_le*Cc(2)+utfbom_8*Cc(3)+Cc(0)
1262local utf8next=R("\128\191")
1263patterns.utfbom_32_be=utfbom_32_be
1264patterns.utfbom_32_le=utfbom_32_le
1265patterns.utfbom_16_be=utfbom_16_be
1266patterns.utfbom_16_le=utfbom_16_le
1267patterns.utfbom_8=utfbom_8
1268patterns.utf_16_be_nl=P("\000\r\000\n")+P("\000\r")+P("\000\n") 
1269patterns.utf_16_le_nl=P("\r\000\n\000")+P("\r\000")+P("\n\000") 
1270patterns.utf_32_be_nl=P("\000\000\000\r\000\000\000\n")+P("\000\000\000\r")+P("\000\000\000\n")
1271patterns.utf_32_le_nl=P("\r\000\000\000\n\000\000\000")+P("\r\000\000\000")+P("\n\000\000\000")
1272patterns.utf8one=R("\000\127")
1273patterns.utf8two=R("\194\223")*utf8next
1274patterns.utf8three=R("\224\239")*utf8next*utf8next
1275patterns.utf8four=R("\240\244")*utf8next*utf8next*utf8next
1276patterns.utfbom=utfbom
1277patterns.utftype=utftype
1278patterns.utfstricttype=utfstricttype
1279patterns.utfoffset=utfoffset
1280local utf8char=patterns.utf8one+patterns.utf8two+patterns.utf8three+patterns.utf8four
1281local validutf8char=utf8char^0*endofstring*Cc(true)+Cc(false)
1282local utf8character=P(1)*R("\128\191")^0 
1283patterns.utf8=utf8char
1284patterns.utf8char=utf8char
1285patterns.utf8character=utf8character 
1286patterns.validutf8=validutf8char
1287patterns.validutf8char=validutf8char
1288local eol=S("\n\r")
1289local spacer=S(" \t\f\v")  
1290local whitespace=eol+spacer
1291local nonspacer=1-spacer
1292local nonwhitespace=1-whitespace
1293patterns.eol=eol
1294patterns.spacer=spacer
1295patterns.whitespace=whitespace
1296patterns.nonspacer=nonspacer
1297patterns.nonwhitespace=nonwhitespace
1298local stripper=spacer^0*C((spacer^0*nonspacer^1)^0)  
1299local fullstripper=whitespace^0*C((whitespace^0*nonwhitespace^1)^0)
1300local collapser=Cs(spacer^0/""*nonspacer^0*((spacer^0/" "*nonspacer^1)^0))
1301local nospacer=Cs((whitespace^1/""+nonwhitespace^1)^0)
1302local b_collapser=Cs(whitespace^0/""*(nonwhitespace^1+whitespace^1/" ")^0)
1303local m_collapser=Cs((nonwhitespace^1+whitespace^1/" ")^0)
1304local e_collapser=Cs((whitespace^1*endofstring/""+nonwhitespace^1+whitespace^1/" ")^0)
1305local x_collapser=Cs((nonwhitespace^1+whitespace^1/"" )^0)
1306local b_stripper=Cs(spacer^0/""*(nonspacer^1+spacer^1/" ")^0)
1307local m_stripper=Cs((nonspacer^1+spacer^1/" ")^0)
1308local e_stripper=Cs((spacer^1*endofstring/""+nonspacer^1+spacer^1/" ")^0)
1309local x_stripper=Cs((nonspacer^1+spacer^1/"" )^0)
1310patterns.stripper=stripper
1311patterns.fullstripper=fullstripper
1312patterns.collapser=collapser
1313patterns.nospacer=nospacer
1314patterns.b_collapser=b_collapser
1315patterns.m_collapser=m_collapser
1316patterns.e_collapser=e_collapser
1317patterns.x_collapser=x_collapser
1318patterns.b_stripper=b_stripper
1319patterns.m_stripper=m_stripper
1320patterns.e_stripper=e_stripper
1321patterns.x_stripper=x_stripper
1322patterns.lowercase=lowercase
1323patterns.uppercase=uppercase
1324patterns.letter=patterns.lowercase+patterns.uppercase
1325patterns.space=space
1326patterns.tab=P("\t")
1327patterns.spaceortab=patterns.space+patterns.tab
1328patterns.newline=newline
1329patterns.emptyline=newline^1
1330patterns.equal=P("=")
1331patterns.comma=comma
1332patterns.commaspacer=comma*spacer^0
1333patterns.period=period
1334patterns.colon=P(":")
1335patterns.semicolon=P(";")
1336patterns.underscore=underscore
1337patterns.escaped=escaped
1338patterns.squote=squote
1339patterns.dquote=dquote
1340patterns.nosquote=(escaped+(1-squote))^0
1341patterns.nodquote=(escaped+(1-dquote))^0
1342patterns.unsingle=(squote/"")*patterns.nosquote*(squote/"") 
1343patterns.undouble=(dquote/"")*patterns.nodquote*(dquote/"") 
1344patterns.unquoted=patterns.undouble+patterns.unsingle 
1345patterns.unspacer=((patterns.spacer^1)/"")^0
1346patterns.singlequoted=squote*patterns.nosquote*squote
1347patterns.doublequoted=dquote*patterns.nodquote*dquote
1348patterns.quoted=patterns.doublequoted+patterns.singlequoted
1349patterns.digit=digit
1350patterns.digits=digits
1351patterns.octdigit=octdigit
1352patterns.octdigits=octdigits
1353patterns.hexdigit=hexdigit
1354patterns.hexdigits=hexdigits
1355patterns.sign=sign
1356patterns.cardinal=digits
1357patterns.integer=sign^-1*digits
1358patterns.unsigned=digit^0*period*digits
1359patterns.float=sign^-1*patterns.unsigned
1360patterns.cunsigned=digit^0*comma*digits
1361patterns.cpunsigned=digit^0*(period+comma)*digits
1362patterns.cfloat=sign^-1*patterns.cunsigned
1363patterns.cpfloat=sign^-1*patterns.cpunsigned
1364patterns.number=patterns.float+patterns.integer
1365patterns.cnumber=patterns.cfloat+patterns.integer
1366patterns.cpnumber=patterns.cpfloat+patterns.integer
1367patterns.oct=zero*octdigits 
1368patterns.octal=patterns.oct
1369patterns.HEX=zero*P("X")*(digit+uppercase)^1
1370patterns.hex=zero*P("x")*(digit+lowercase)^1
1371patterns.hexadecimal=zero*S("xX")*hexdigits
1372patterns.hexafloat=sign^-1*zero*S("xX")*(hexdigit^0*period*hexdigits+hexdigits*period*hexdigit^0+hexdigits)*(S("pP")*sign^-1*hexdigits)^-1
1373patterns.decafloat=sign^-1*(digit^0*period*digits+digits*period*digit^0+digits)*S("eE")*sign^-1*digits
1374patterns.propername=(uppercase+lowercase+underscore)*(uppercase+lowercase+underscore+digit)^0*endofstring
1375patterns.somecontent=(anything-newline-space)^1 
1376patterns.beginline=#(1-newline)
1377patterns.longtostring=Cs(whitespace^0/""*((patterns.quoted+nonwhitespace^1+whitespace^1/""*(endofstring+Cc(" ")))^0))
1378local function anywhere(pattern) 
1379 return (1-P(pattern))^0*P(pattern)
1380end
1381lpeg.anywhere=anywhere
1382function lpeg.instringchecker(p)
1383 p=anywhere(p)
1384 return function(str)
1385  return lpegmatch(p,str) and true or false
1386 end
1387end
1388function lpeg.splitter(pattern,action)
1389 if action then
1390  return (((1-P(pattern))^1)/action+1)^0
1391 else
1392  return (Cs((1-P(pattern))^1)+1)^0
1393 end
1394end
1395function lpeg.tsplitter(pattern,action)
1396 if action then
1397  return Ct((((1-P(pattern))^1)/action+1)^0)
1398 else
1399  return Ct((Cs((1-P(pattern))^1)+1)^0)
1400 end
1401end
1402local splitters_s,splitters_m,splitters_t={},{},{}
1403local function splitat(separator,single)
1404 local splitter=(single and splitters_s[separator]) or splitters_m[separator]
1405 if not splitter then
1406  separator=P(separator)
1407  local other=C((1-separator)^0)
1408  if single then
1409   local any=anything
1410   splitter=other*(separator*C(any^0)+"") 
1411   splitters_s[separator]=splitter
1412  else
1413   splitter=other*(separator*other)^0
1414   splitters_m[separator]=splitter
1415  end
1416 end
1417 return splitter
1418end
1419local function tsplitat(separator)
1420 local splitter=splitters_t[separator]
1421 if not splitter then
1422  splitter=Ct(splitat(separator))
1423  splitters_t[separator]=splitter
1424 end
1425 return splitter
1426end
1427lpeg.splitat=splitat
1428lpeg.tsplitat=tsplitat
1429function string.splitup(str,separator)
1430 if not separator then
1431  separator=","
1432 end
1433 return lpegmatch(splitters_m[separator] or splitat(separator),str)
1434end
1435local cache={}
1436function lpeg.split(separator,str)
1437 local c=cache[separator]
1438 if not c then
1439  c=tsplitat(separator)
1440  cache[separator]=c
1441 end
1442 return lpegmatch(c,str)
1443end
1444function string.split(str,separator)
1445 if separator then
1446  local c=cache[separator]
1447  if not c then
1448   c=tsplitat(separator)
1449   cache[separator]=c
1450  end
1451  return lpegmatch(c,str)
1452 else
1453  return { str }
1454 end
1455end
1456local spacing=patterns.spacer^0*newline 
1457local empty=spacing*Cc("")
1458local nonempty=Cs((1-spacing)^1)*spacing^-1
1459local content=(empty+nonempty)^1
1460patterns.textline=content
1461local linesplitter=tsplitat(newline)
1462patterns.linesplitter=linesplitter
1463function string.splitlines(str)
1464 return lpegmatch(linesplitter,str)
1465end
1466local cache={}
1467function lpeg.checkedsplit(separator,str)
1468 local c=cache[separator]
1469 if not c then
1470  separator=P(separator)
1471  local other=C((1-separator)^1)
1472  c=Ct(separator^0*other*(separator^1*other)^0)
1473  cache[separator]=c
1474 end
1475 return lpegmatch(c,str)
1476end
1477function string.checkedsplit(str,separator)
1478 local c=cache[separator]
1479 if not c then
1480  separator=P(separator)
1481  local other=C((1-separator)^1)
1482  c=Ct(separator^0*other*(separator^1*other)^0)
1483  cache[separator]=c
1484 end
1485 return lpegmatch(c,str)
1486end
1487local function f2(s) local c1,c2=byte(s,1,2) return   c1*64+c2-12416 end
1488local function f3(s) local c1,c2,c3=byte(s,1,3) return  (c1*64+c2)*64+c3-925824 end
1489local function f4(s) local c1,c2,c3,c4=byte(s,1,4) return ((c1*64+c2)*64+c3)*64+c4-63447168 end
1490local utf8byte=patterns.utf8one/byte+patterns.utf8two/f2+patterns.utf8three/f3+patterns.utf8four/f4
1491patterns.utf8byte=utf8byte
1492local cache={}
1493function lpeg.stripper(str)
1494 if type(str)=="string" then
1495  local s=cache[str]
1496  if not s then
1497   s=Cs(((S(str)^1)/""+1)^0)
1498   cache[str]=s
1499  end
1500  return s
1501 else
1502  return Cs(((str^1)/""+1)^0)
1503 end
1504end
1505local cache={}
1506function lpeg.keeper(str)
1507 if type(str)=="string" then
1508  local s=cache[str]
1509  if not s then
1510   s=Cs((((1-S(str))^1)/""+1)^0)
1511   cache[str]=s
1512  end
1513  return s
1514 else
1515  return Cs((((1-str)^1)/""+1)^0)
1516 end
1517end
1518function lpeg.frontstripper(str) 
1519 return (P(str)+P(true))*Cs(anything^0)
1520end
1521function lpeg.endstripper(str) 
1522 return Cs((1-P(str)*endofstring)^0)
1523end
1524function lpeg.replacer(one,two,makefunction,isutf) 
1525 local pattern
1526 local u=isutf and utf8char or 1
1527 if type(one)=="table" then
1528  local no=#one
1529  local p=P(false)
1530  if no==0 then
1531   for k,v in next,one do
1532    p=p+P(k)/v
1533   end
1534   pattern=Cs((p+u)^0)
1535  elseif no==1 then
1536   local o=one[1]
1537   one,two=P(o[1]),o[2]
1538   pattern=Cs((one/two+u)^0)
1539  else
1540   for i=1,no do
1541    local o=one[i]
1542    p=p+P(o[1])/o[2]
1543   end
1544   pattern=Cs((p+u)^0)
1545  end
1546 else
1547  pattern=Cs((P(one)/(two or "")+u)^0)
1548 end
1549 if makefunction then
1550  return function(str)
1551   return lpegmatch(pattern,str)
1552  end
1553 else
1554  return pattern
1555 end
1556end
1557function lpeg.finder(lst,makefunction,isutf) 
1558 local pattern
1559 if type(lst)=="table" then
1560  pattern=P(false)
1561  if #lst==0 then
1562   for k,v in next,lst do
1563    pattern=pattern+P(k) 
1564   end
1565  else
1566   for i=1,#lst do
1567    pattern=pattern+P(lst[i])
1568   end
1569  end
1570 else
1571  pattern=P(lst)
1572 end
1573 if isutf then
1574  pattern=((utf8char or 1)-pattern)^0*pattern
1575 else
1576  pattern=(1-pattern)^0*pattern
1577 end
1578 if makefunction then
1579  return function(str)
1580   return lpegmatch(pattern,str)
1581  end
1582 else
1583  return pattern
1584 end
1585end
1586local splitters_f,splitters_s={},{}
1587function lpeg.firstofsplit(separator) 
1588 local splitter=splitters_f[separator]
1589 if not splitter then
1590  local pattern=P(separator)
1591  splitter=C((1-pattern)^0)
1592  splitters_f[separator]=splitter
1593 end
1594 return splitter
1595end
1596function lpeg.secondofsplit(separator) 
1597 local splitter=splitters_s[separator]
1598 if not splitter then
1599  local pattern=P(separator)
1600  splitter=(1-pattern)^0*pattern*C(anything^0)
1601  splitters_s[separator]=splitter
1602 end
1603 return splitter
1604end
1605local splitters_s,splitters_p={},{}
1606function lpeg.beforesuffix(separator) 
1607 local splitter=splitters_s[separator]
1608 if not splitter then
1609  local pattern=P(separator)
1610  splitter=C((1-pattern)^0)*pattern*endofstring
1611  splitters_s[separator]=splitter
1612 end
1613 return splitter
1614end
1615function lpeg.afterprefix(separator) 
1616 local splitter=splitters_p[separator]
1617 if not splitter then
1618  local pattern=P(separator)
1619  splitter=pattern*C(anything^0)
1620  splitters_p[separator]=splitter
1621 end
1622 return splitter
1623end
1624function lpeg.balancer(left,right)
1625 left,right=P(left),P(right)
1626 return P { left*((1-left-right)+V(1))^0*right }
1627end
1628function lpeg.counter(pattern,action)
1629 local n=0
1630 local pattern=(P(pattern)/function() n=n+1 end+anything)^0
1631 if action then
1632  return function(str) n=0;lpegmatch(pattern,str);action(n) end
1633 else
1634  return function(str) n=0;lpegmatch(pattern,str);return n end
1635 end
1636end
1637function lpeg.is_lpeg(p)
1638 return p and lpegtype(p)=="pattern"
1639end
1640function lpeg.oneof(list,...) 
1641 if type(list)~="table" then
1642  list={ list,... }
1643 end
1644 local p=P(list[1])
1645 for l=2,#list do
1646  p=p+P(list[l])
1647 end
1648 return p
1649end
1650local sort=table.sort
1651local function copyindexed(old)
1652 local new={}
1653 for i=1,#old do
1654  new[i]=old
1655 end
1656 return new
1657end
1658local function sortedkeys(tab)
1659 local keys,s={},0
1660 for key,_ in next,tab do
1661  s=s+1
1662  keys[s]=key
1663 end
1664 sort(keys)
1665 return keys
1666end
1667function lpeg.append(list,pp,delayed,checked)
1668 local p=pp
1669 if #list>0 then
1670  local keys=copyindexed(list)
1671  sort(keys)
1672  for i=#keys,1,-1 do
1673   local k=keys[i]
1674   if p then
1675    p=P(k)+p
1676   else
1677    p=P(k)
1678   end
1679  end
1680 elseif delayed then 
1681  local keys=sortedkeys(list)
1682  if p then
1683   for i=1,#keys,1 do
1684    local k=keys[i]
1685    local v=list[k]
1686    p=P(k)/list+p
1687   end
1688  else
1689   for i=1,#keys do
1690    local k=keys[i]
1691    local v=list[k]
1692    if p then
1693     p=P(k)+p
1694    else
1695     p=P(k)
1696    end
1697   end
1698   if p then
1699    p=p/list
1700   end
1701  end
1702 elseif checked then
1703  local keys=sortedkeys(list)
1704  for i=1,#keys do
1705   local k=keys[i]
1706   local v=list[k]
1707   if p then
1708    if k==v then
1709     p=P(k)+p
1710    else
1711     p=P(k)/v+p
1712    end
1713   else
1714    if k==v then
1715     p=P(k)
1716    else
1717     p=P(k)/v
1718    end
1719   end
1720  end
1721 else
1722  local keys=sortedkeys(list)
1723  for i=1,#keys do
1724   local k=keys[i]
1725   local v=list[k]
1726   if p then
1727    p=P(k)/v+p
1728   else
1729    p=P(k)/v
1730   end
1731  end
1732 end
1733 return p
1734end
1735local p_false=P(false)
1736local p_true=P(true)
1737local lower=utf and utf.lower or string.lower
1738local upper=utf and utf.upper or string.upper
1739function lpeg.setutfcasers(l,u)
1740 lower=l or lower
1741 upper=u or upper
1742end
1743local function make1(t,rest)
1744 local p=p_false
1745 local keys=sortedkeys(t)
1746 for i=1,#keys do
1747  local k=keys[i]
1748  if k~="" then
1749   local v=t[k]
1750   if v==true then
1751    p=p+P(k)*p_true
1752   elseif v==false then
1753   else
1754    p=p+P(k)*make1(v,v[""])
1755   end
1756  end
1757 end
1758 if rest then
1759  p=p+p_true
1760 end
1761 return p
1762end
1763local function make2(t,rest) 
1764 local p=p_false
1765 local keys=sortedkeys(t)
1766 for i=1,#keys do
1767  local k=keys[i]
1768  if k~="" then
1769   local v=t[k]
1770   if v==true then
1771    p=p+(P(lower(k))+P(upper(k)))*p_true
1772   elseif v==false then
1773   else
1774    p=p+(P(lower(k))+P(upper(k)))*make2(v,v[""])
1775   end
1776  end
1777 end
1778 if rest then
1779  p=p+p_true
1780 end
1781 return p
1782end
1783local function utfchartabletopattern(list,insensitive) 
1784 local tree={}
1785 local n=#list
1786 if n==0 then
1787  for s in next,list do
1788   local t=tree
1789   local p,pk
1790   for c in gmatch(s,".") do
1791    if t==true then
1792     t={ [c]=true,[""]=true }
1793     p[pk]=t
1794     p=t
1795     t=false
1796    elseif t==false then
1797     t={ [c]=false }
1798     p[pk]=t
1799     p=t
1800     t=false
1801    else
1802     local tc=t[c]
1803     if not tc then
1804      tc=false
1805      t[c]=false
1806     end
1807     p=t
1808     t=tc
1809    end
1810    pk=c
1811   end
1812   if t==false then
1813    p[pk]=true
1814   elseif t==true then
1815   else
1816    t[""]=true
1817   end
1818  end
1819 else
1820  for i=1,n do
1821   local s=list[i]
1822   local t=tree
1823   local p,pk
1824   for c in gmatch(s,".") do
1825    if t==true then
1826     t={ [c]=true,[""]=true }
1827     p[pk]=t
1828     p=t
1829     t=false
1830    elseif t==false then
1831     t={ [c]=false }
1832     p[pk]=t
1833     p=t
1834     t=false
1835    else
1836     local tc=t[c]
1837     if not tc then
1838      tc=false
1839      t[c]=false
1840     end
1841     p=t
1842     t=tc
1843    end
1844    pk=c
1845   end
1846   if t==false then
1847    p[pk]=true
1848   elseif t==true then
1849   else
1850    t[""]=true
1851   end
1852  end
1853 end
1854 return (insensitive and make2 or make1)(tree)
1855end
1856lpeg.utfchartabletopattern=utfchartabletopattern
1857function lpeg.utfreplacer(list,insensitive)
1858 local pattern=Cs((utfchartabletopattern(list,insensitive)/list+utf8character)^0)
1859 return function(str)
1860  return lpegmatch(pattern,str) or str
1861 end
1862end
1863patterns.containseol=lpeg.finder(eol)
1864local function nextstep(n,step,result)
1865 local m=n%step   
1866 local d=floor(n/step) 
1867 if d>0 then
1868  local v=V(tostring(step))
1869  local s=result.start
1870  for i=1,d do
1871   if s then
1872    s=v*s
1873   else
1874    s=v
1875   end
1876  end
1877  result.start=s
1878 end
1879 if step>1 and result.start then
1880  local v=V(tostring(step/2))
1881  result[tostring(step)]=v*v
1882 end
1883 if step>0 then
1884  return nextstep(m,step/2,result)
1885 else
1886  return result
1887 end
1888end
1889function lpeg.times(pattern,n)
1890 return P(nextstep(n,2^16,{ "start",["1"]=pattern }))
1891end
1892do
1893 local trailingzeros=zero^0*-digit 
1894 local stripper=Cs((
1895  digits*(
1896   period*trailingzeros/""+period*(digit-trailingzeros)^1*(trailingzeros/"")
1897  )+1
1898 )^0)
1899 lpeg.patterns.stripzeros=stripper 
1900 local nonzero=digit-zero
1901 local trailingzeros=zero^1*endofstring
1902 local stripper=Cs((1-period)^0*(
1903  period*trailingzeros/""+period*(nonzero^1+(trailingzeros/"")+zero^1)^0+endofstring
1904 ))
1905 lpeg.patterns.stripzero=stripper
1906end
1907local byte_to_HEX={}
1908local byte_to_hex={}
1909local byte_to_dec={} 
1910local hex_to_byte={}
1911for i=0,255 do
1912 local H=format("%02X",i)
1913 local h=format("%02x",i)
1914 local d=format("%03i",i)
1915 local c=char(i)
1916 byte_to_HEX[c]=H
1917 byte_to_hex[c]=h
1918 byte_to_dec[c]=d
1919 hex_to_byte[h]=c
1920 hex_to_byte[H]=c
1921end
1922local hextobyte=P(2)/hex_to_byte
1923local bytetoHEX=P(1)/byte_to_HEX
1924local bytetohex=P(1)/byte_to_hex
1925local bytetodec=P(1)/byte_to_dec
1926local hextobytes=Cs(hextobyte^0)
1927local bytestoHEX=Cs(bytetoHEX^0)
1928local bytestohex=Cs(bytetohex^0)
1929local bytestodec=Cs(bytetodec^0)
1930patterns.hextobyte=hextobyte
1931patterns.bytetoHEX=bytetoHEX
1932patterns.bytetohex=bytetohex
1933patterns.bytetodec=bytetodec
1934patterns.hextobytes=hextobytes
1935patterns.bytestoHEX=bytestoHEX
1936patterns.bytestohex=bytestohex
1937patterns.bytestodec=bytestodec
1938function string.toHEX(s)
1939 if not s or s=="" then
1940  return s
1941 else
1942  return lpegmatch(bytestoHEX,s)
1943 end
1944end
1945function string.tohex(s)
1946 if not s or s=="" then
1947  return s
1948 else
1949  return lpegmatch(bytestohex,s)
1950 end
1951end
1952function string.todec(s)
1953 if not s or s=="" then
1954  return s
1955 else
1956  return lpegmatch(bytestodec,s)
1957 end
1958end
1959function string.tobytes(s)
1960 if not s or s=="" then
1961  return s
1962 else
1963  return lpegmatch(hextobytes,s)
1964 end
1965end
1966local patterns={} 
1967local function containsws(what)
1968 local p=patterns[what]
1969 if not p then
1970  local p1=P(what)*(whitespace+endofstring)*Cc(true)
1971  local p2=whitespace*P(p1)
1972  p=P(p1)+P(1-p2)^0*p2+Cc(false)
1973  patterns[what]=p
1974 end
1975 return p
1976end
1977lpeg.containsws=containsws
1978function string.containsws(str,what)
1979 return lpegmatch(patterns[what] or containsws(what),str)
1980end
1981
1982
1983end -- of closure
1984
1985do -- create closure to overcome 200 locals limit
1986
1987package.loaded["l-function"] = package.loaded["l-function"] or true
1988
1989-- original size: 361, stripped down to: 317
1990
1991if not modules then modules={} end modules ['l-functions']={
1992 version=1.001,
1993 comment="companion to luat-lib.mkiv",
1994 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
1995 copyright="PRAGMA ADE / ConTeXt Development Team",
1996 license="see context related readme files"
1997}
1998functions=functions or {}
1999function functions.dummy() end
2000
2001
2002end -- of closure
2003
2004do -- create closure to overcome 200 locals limit
2005
2006package.loaded["l-string"] = package.loaded["l-string"] or true
2007
2008-- original size: 6955, stripped down to: 3504
2009
2010if not modules then modules={} end modules ['l-string']={
2011 version=1.001,
2012 comment="companion to luat-lib.mkiv",
2013 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
2014 copyright="PRAGMA ADE / ConTeXt Development Team",
2015 license="see context related readme files"
2016}
2017local string=string
2018local sub,gmatch,format,char,byte,rep,lower,find=string.sub,string.gmatch,string.format,string.char,string.byte,string.rep,string.lower,string.find
2019local lpegmatch,patterns=lpeg.match,lpeg.patterns
2020local P,S,C,Ct,Cc,Cs=lpeg.P,lpeg.S,lpeg.C,lpeg.Ct,lpeg.Cc,lpeg.Cs
2021local unquoted=patterns.squote*C(patterns.nosquote)*patterns.squote+patterns.dquote*C(patterns.nodquote)*patterns.dquote
2022function string.unquoted(str)
2023 return lpegmatch(unquoted,str) or str
2024end
2025function string.quoted(str)
2026 return format("%q",str) 
2027end
2028function string.count(str,pattern)
2029 local n=0
2030 local i=1
2031 local l=#pattern
2032 while true do
2033  i=find(str,pattern,i)
2034  if i then
2035   n=n+1
2036   i=i+l
2037  else
2038   break
2039  end
2040 end
2041 return n
2042end
2043function string.limit(str,n,sentinel) 
2044 if #str>n then
2045  sentinel=sentinel or "..."
2046  return sub(str,1,(n-#sentinel))..sentinel
2047 else
2048  return str
2049 end
2050end
2051local stripper=patterns.stripper
2052local fullstripper=patterns.fullstripper
2053local collapser=patterns.collapser
2054local nospacer=patterns.nospacer
2055local longtostring=patterns.longtostring
2056function string.strip(str)
2057 return str and lpegmatch(stripper,str) or ""
2058end
2059function string.fullstrip(str)
2060 return str and lpegmatch(fullstripper,str) or ""
2061end
2062function string.collapsespaces(str)
2063 return str and lpegmatch(collapser,str) or ""
2064end
2065function string.nospaces(str)
2066 return str and lpegmatch(nospacer,str) or ""
2067end
2068function string.longtostring(str)
2069 return str and lpegmatch(longtostring,str) or ""
2070end
2071local pattern=P(" ")^0*P(-1)
2072function string.is_empty(str)
2073 if not str or str=="" then
2074  return true
2075 else
2076  return lpegmatch(pattern,str) and true or false
2077 end
2078end
2079local anything=patterns.anything
2080local moreescapes=Cc("%")*S(".-+%?()[]*$^{}")
2081local allescapes=Cc("%")*S(".-+%?()[]*")   
2082local someescapes=Cc("%")*S(".-+%()[]")  
2083local matchescapes=Cc(".")*S("*?")     
2084local pattern_m=Cs ((moreescapes+anything )^0 )
2085local pattern_a=Cs ((allescapes+anything )^0 )
2086local pattern_b=Cs ((someescapes+matchescapes+anything )^0 )
2087local pattern_c=Cs (Cc("^")*(someescapes+matchescapes+anything )^0*Cc("$") )
2088function string.escapedpattern(str,simple)
2089 return lpegmatch(simple and pattern_b or pattern_a,str)
2090end
2091function string.topattern(str,lowercase,strict)
2092 if str=="" or type(str)~="string" then
2093  return ".*"
2094 elseif strict=="all" then
2095  str=lpegmatch(pattern_m,str)
2096 elseif strict then
2097  str=lpegmatch(pattern_c,str)
2098 else
2099  str=lpegmatch(pattern_b,str)
2100 end
2101 if lowercase then
2102  return lower(str)
2103 else
2104  return str
2105 end
2106end
2107function string.valid(str,default)
2108 return (type(str)=="string" and str~="" and str) or default or nil
2109end
2110string.itself=function(s) return s end
2111local pattern_c=Ct(C(1)^0) 
2112local pattern_b=Ct((C(1)/byte)^0)
2113function string.totable(str,bytes)
2114 return lpegmatch(bytes and pattern_b or pattern_c,str)
2115end
2116local replacer=lpeg.replacer("@","%%") 
2117function string.tformat(fmt,...)
2118 return format(lpegmatch(replacer,fmt),...)
2119end
2120string.quote=string.quoted
2121string.unquote=string.unquoted
2122if not string.bytetable then 
2123 local limit=5000 
2124 function string.bytetable(str) 
2125  local n=#str
2126  if n>limit then
2127   local t={ byte(str,1,limit) }
2128   for i=limit+1,n do
2129    t[i]=byte(str,i)
2130   end
2131   return t
2132  else
2133   return { byte(str,1,n) }
2134  end
2135 end
2136end
2137
2138
2139end -- of closure
2140
2141do -- create closure to overcome 200 locals limit
2142
2143package.loaded["l-table"] = package.loaded["l-table"] or true
2144
2145-- original size: 42643, stripped down to: 23053
2146
2147if not modules then modules={} end modules ['l-table']={
2148 version=1.001,
2149 comment="companion to luat-lib.mkiv",
2150 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
2151 copyright="PRAGMA ADE / ConTeXt Development Team",
2152 license="see context related readme files"
2153}
2154local type,next,tostring,tonumber,select,rawget=type,next,tostring,tonumber,select,rawget
2155local table,string=table,string
2156local concat,sort=table.concat,table.sort
2157local format,lower,dump=string.format,string.lower,string.dump
2158local getmetatable,setmetatable=getmetatable,setmetatable
2159local lpegmatch,patterns=lpeg.match,lpeg.patterns
2160local floor=math.floor
2161local stripper=patterns.stripper
2162function table.getn(t)
2163 return t and #t 
2164end
2165function table.strip(tab)
2166 local lst={}
2167 local l=0
2168 for i=1,#tab do
2169  local s=lpegmatch(stripper,tab[i]) or ""
2170  if s=="" then
2171  else
2172   l=l+1
2173   lst[l]=s
2174  end
2175 end
2176 return lst
2177end
2178function table.keys(t)
2179 if t then
2180  local keys={}
2181  local k=0
2182  for key in next,t do
2183   k=k+1
2184   keys[k]=key
2185  end
2186  return keys
2187 else
2188  return {}
2189 end
2190end
2191local function compare(a,b)
2192 local ta=type(a) 
2193 if ta=="number" then
2194  local tb=type(b) 
2195  if ta==tb then
2196   return a<b
2197  elseif tb=="string" then
2198   return tostring(a)<b
2199  end
2200 elseif ta=="string" then
2201  local tb=type(b) 
2202  if ta==tb then
2203   return a<b
2204  else
2205   return a<tostring(b)
2206  end
2207 end
2208 return tostring(a)<tostring(b) 
2209end
2210local function sortedkeys(tab)
2211 if tab then
2212  local srt={}
2213  local category=0 
2214  local s=0
2215  for key in next,tab do
2216   s=s+1
2217   srt[s]=key
2218   if category~=3 then
2219    local tkey=type(key)
2220    if category==1 then
2221     if tkey~="string" then
2222      category=3
2223     end
2224    elseif category==2 then
2225     if tkey~="number" then
2226      category=3
2227     end
2228    else
2229     if tkey=="string" then
2230      category=1
2231     elseif tkey=="number" then
2232      category=2
2233     else
2234      category=3
2235     end
2236    end
2237   end
2238  end
2239  if s<2 then
2240  elseif category==3 then
2241   sort(srt,compare)
2242  else
2243   sort(srt)
2244  end
2245  return srt
2246 else
2247  return {}
2248 end
2249end
2250local function sortedhashonly(tab)
2251 if tab then
2252  local srt={}
2253  local s=0
2254  for key in next,tab do
2255   if type(key)=="string" then
2256    s=s+1
2257    srt[s]=key
2258   end
2259  end
2260  if s>1 then
2261   sort(srt)
2262  end
2263  return srt
2264 else
2265  return {}
2266 end
2267end
2268local function sortedindexonly(tab)
2269 if tab then
2270  local srt={}
2271  local s=0
2272  for key in next,tab do
2273   if type(key)=="number" then
2274    s=s+1
2275    srt[s]=key
2276   end
2277  end
2278  if s>1 then
2279   sort(srt)
2280  end
2281  return srt
2282 else
2283  return {}
2284 end
2285end
2286local function sortedhashkeys(tab,cmp) 
2287 if tab then
2288  local srt={}
2289  local s=0
2290  for key in next,tab do
2291   if key then
2292    s=s+1
2293    srt[s]=key
2294   end
2295  end
2296  if s>1 then
2297   sort(srt,cmp)
2298  end
2299  return srt
2300 else
2301  return {}
2302 end
2303end
2304function table.allkeys(t)
2305 local keys={}
2306 for k,v in next,t do
2307  for k in next,v do
2308   keys[k]=true
2309  end
2310 end
2311 return sortedkeys(keys)
2312end
2313table.sortedkeys=sortedkeys
2314table.sortedhashonly=sortedhashonly
2315table.sortedindexonly=sortedindexonly
2316table.sortedhashkeys=sortedhashkeys
2317local function nothing() end
2318local function sortedhash(t,cmp)
2319 if t then
2320  local s
2321  if cmp then
2322   s=sortedhashkeys(t,function(a,b) return cmp(t,a,b) end)
2323  else
2324   s=sortedkeys(t) 
2325  end
2326  local m=#s
2327  if m==1 then
2328   return next,t
2329  elseif m>0 then
2330   local n=0
2331   return function()
2332    if n<m then
2333     n=n+1
2334     local k=s[n]
2335     return k,t[k]
2336    end
2337   end
2338  end
2339 end
2340 return nothing
2341end
2342table.sortedhash=sortedhash
2343table.sortedpairs=sortedhash 
2344function table.append(t,list)
2345 local n=#t
2346 for i=1,#list do
2347  n=n+1
2348  t[n]=list[i]
2349 end
2350 return t
2351end
2352function table.prepend(t,list)
2353 local nl=#list
2354 local nt=nl+#t
2355 for i=#t,1,-1 do
2356  t[nt]=t[i]
2357  nt=nt-1
2358 end
2359 for i=1,#list do
2360  t[i]=list[i]
2361 end
2362 return t
2363end
2364function table.merge(t,...) 
2365 if not t then
2366  t={}
2367 end
2368 for i=1,select("#",...) do
2369  for k,v in next,(select(i,...)) do
2370   t[k]=v
2371  end
2372 end
2373 return t
2374end
2375function table.merged(...)
2376 local t={}
2377 for i=1,select("#",...) do
2378  for k,v in next,(select(i,...)) do
2379   t[k]=v
2380  end
2381 end
2382 return t
2383end
2384function table.imerge(t,...)
2385 local nt=#t
2386 for i=1,select("#",...) do
2387  local nst=select(i,...)
2388  for j=1,#nst do
2389   nt=nt+1
2390   t[nt]=nst[j]
2391  end
2392 end
2393 return t
2394end
2395function table.imerged(...)
2396 local tmp={}
2397 local ntmp=0
2398 for i=1,select("#",...) do
2399  local nst=select(i,...)
2400  for j=1,#nst do
2401   ntmp=ntmp+1
2402   tmp[ntmp]=nst[j]
2403  end
2404 end
2405 return tmp
2406end
2407local function fastcopy(old,metatabletoo) 
2408 if old then
2409  local new={}
2410  for k,v in next,old do
2411   if type(v)=="table" then
2412    new[k]=fastcopy(v,metatabletoo) 
2413   else
2414    new[k]=v
2415   end
2416  end
2417  if metatabletoo then
2418   local mt=getmetatable(old)
2419   if mt then
2420    setmetatable(new,mt)
2421   end
2422  end
2423  return new
2424 else
2425  return {}
2426 end
2427end
2428local function copy(t,tables) 
2429 if not tables then
2430  tables={}
2431 end
2432 local tcopy={}
2433 if not tables[t] then
2434  tables[t]=tcopy
2435 end
2436 for i,v in next,t do 
2437  local k
2438  if type(i)=="table" then
2439   if tables[i] then
2440    k=tables[i]
2441   else
2442    k=copy(i,tables)
2443   end
2444  else
2445   k=i
2446  end
2447  if type(v)~="table" then
2448   tcopy[k]=v
2449  elseif tables[v] then
2450   tcopy[k]=tables[v]
2451  else
2452   tcopy[k]=copy(v,tables)
2453  end
2454 end
2455 local mt=getmetatable(t)
2456 if mt then
2457  setmetatable(tcopy,mt)
2458 end
2459 return tcopy
2460end
2461table.fastcopy=fastcopy
2462table.copy=copy
2463function table.derive(parent) 
2464 local child={}
2465 if parent then
2466  setmetatable(child,{ __index=parent })
2467 end
2468 return child
2469end
2470function table.tohash(t,value)
2471 local h={}
2472 if t then
2473  if value==nil then value=true end
2474  for _,v in next,t do
2475   h[v]=value
2476  end
2477 end
2478 return h
2479end
2480function table.fromhash(t)
2481 local hsh={}
2482 local h=0
2483 for k,v in next,t do
2484  if v then
2485   h=h+1
2486   hsh[h]=k
2487  end
2488 end
2489 return hsh
2490end
2491local noquotes,hexify,handle,compact,inline,functions,metacheck,accurate
2492local reserved=table.tohash { 
2493 'and','break','do','else','elseif','end','false','for','function','if',
2494 'in','local','nil','not','or','repeat','return','then','true','until','while',
2495 'NaN','goto','const',
2496}
2497local function is_simple_table(t,hexify,accurate) 
2498 local nt=#t
2499 if nt>0 then
2500  local n=0
2501  for _,v in next,t do
2502   n=n+1
2503   if type(v)=="table" then
2504    return nil
2505   end
2506  end
2507  local haszero=rawget(t,0) 
2508  if n==nt then
2509   local tt={}
2510   for i=1,nt do
2511    local v=t[i]
2512    local tv=type(v)
2513    if tv=="number" then
2514     if hexify then
2515      tt[i]=format("0x%X",v)
2516     elseif accurate then
2517      tt[i]=format("%q",v)
2518     else
2519      tt[i]=v 
2520     end
2521    elseif tv=="string" then
2522     tt[i]=format("%q",v) 
2523    elseif tv=="boolean" then
2524     tt[i]=v and "true" or "false"
2525    else
2526     return nil
2527    end
2528   end
2529   return tt
2530  elseif haszero and (n==nt+1) then
2531   local tt={}
2532   for i=0,nt do
2533    local v=t[i]
2534    local tv=type(v)
2535    if tv=="number" then
2536     if hexify then
2537      tt[i+1]=format("0x%X",v)
2538     elseif accurate then
2539      tt[i+1]=format("%q",v)
2540     else
2541      tt[i+1]=v 
2542     end
2543    elseif tv=="string" then
2544     tt[i+1]=format("%q",v) 
2545    elseif tv=="boolean" then
2546     tt[i+1]=v and "true" or "false"
2547    else
2548     return nil
2549    end
2550   end
2551   tt[1]="[0] = "..tt[1]
2552   return tt
2553  end
2554 end
2555 return nil
2556end
2557table.is_simple_table=is_simple_table
2558local propername=patterns.propername 
2559local function dummy() end
2560local function do_serialize(root,name,depth,level,indexed)
2561 if level>0 then
2562  depth=depth.." "
2563  if indexed then
2564   handle(format("%s{",depth))
2565  else
2566   local tn=type(name)
2567   if tn=="number" then
2568    if hexify then
2569     handle(format("%s[0x%X]={",depth,name))
2570    else
2571     handle(format("%s[%s]={",depth,name))
2572    end
2573   elseif tn=="string" then
2574    if noquotes and not reserved[name] and lpegmatch(propername,name) then
2575     handle(format("%s%s={",depth,name))
2576    else
2577     handle(format("%s[%q]={",depth,name))
2578    end
2579   elseif tn=="boolean" then
2580    handle(format("%s[%s]={",depth,name and "true" or "false"))
2581   else
2582    handle(format("%s{",depth))
2583   end
2584  end
2585 end
2586 if root and next(root)~=nil then
2587  local first=nil
2588  local last=0
2589  if compact then
2590   last=#root
2591   for k=1,last do
2592    if rawget(root,k)==nil then
2593     last=k-1
2594     break
2595    end
2596   end
2597   if last>0 then
2598    first=1
2599   end
2600  end
2601  local sk=sortedkeys(root)
2602  for i=1,#sk do
2603   local k=sk[i]
2604   local v=root[k]
2605   local tv=type(v)
2606   local tk=type(k)
2607   if compact and first and tk=="number" and k>=first and k<=last then
2608    if tv=="number" then
2609     if hexify then
2610      handle(format("%s 0x%X,",depth,v))
2611     elseif accurate then
2612      handle(format("%s %q,",depth,v))
2613     else
2614      handle(format("%s %s,",depth,v)) 
2615     end
2616    elseif tv=="string" then
2617     handle(format("%s %q,",depth,v))
2618    elseif tv=="table" then
2619     if next(v)==nil then
2620      handle(format("%s {},",depth))
2621     elseif inline then 
2622      local st=is_simple_table(v,hexify,accurate)
2623      if st then
2624       handle(format("%s { %s },",depth,concat(st,", ")))
2625      else
2626       do_serialize(v,k,depth,level+1,true)
2627      end
2628     else
2629      do_serialize(v,k,depth,level+1,true)
2630     end
2631    elseif tv=="boolean" then
2632     handle(format("%s %s,",depth,v and "true" or "false"))
2633    elseif tv=="function" then
2634     if functions then
2635      handle(format('%s load(%q),',depth,dump(v))) 
2636     else
2637      handle(format('%s "function",',depth))
2638     end
2639    else
2640     handle(format("%s %q,",depth,tostring(v)))
2641    end
2642   elseif k=="__p__" then 
2643    if false then
2644     handle(format("%s __p__=nil,",depth))
2645    end
2646   elseif tv=="number" then
2647    if tk=="number" then
2648     if hexify then
2649      if accurate then
2650       handle(format("%s [0x%X]=%q,",depth,k,v))
2651      else
2652       handle(format("%s [0x%X]=%s,",depth,k,v))
2653      end
2654     elseif accurate then
2655      handle(format("%s [%s]=%q,",depth,k,v))
2656     else
2657      handle(format("%s [%s]=%s,",depth,k,v)) 
2658     end
2659    elseif tk=="boolean" then
2660     if hexify then
2661      if accurate then
2662       handle(format("%s [%s]=%q,",depth,k and "true" or "false",v))
2663      else
2664       handle(format("%s [%s]=%s,",depth,k and "true" or "false",v))
2665      end
2666     elseif accurate then
2667      handle(format("%s [%s]=%q,",depth,k and "true" or "false",v))
2668     else
2669      handle(format("%s [%s]=%s,",depth,k and "true" or "false",v)) 
2670     end
2671    elseif tk~="string" then
2672    elseif noquotes and not reserved[k] and lpegmatch(propername,k) then
2673     if hexify then
2674      if accurate then
2675       handle(format("%s %s=%q,",depth,k,v))
2676      else
2677       handle(format("%s %s=0x%X,",depth,k,v))
2678      end
2679     elseif accurate then
2680      handle(format("%s %s=%q,",depth,k,v))
2681     else
2682      handle(format("%s %s=%s,",depth,k,v)) 
2683     end
2684    else
2685     if hexify then
2686      if accurate then
2687       handle(format("%s [%q]=%q,",depth,k,v))
2688      else
2689       handle(format("%s [%q]=0x%X,",depth,k,v))
2690      end
2691     elseif accurate then
2692      handle(format("%s [%q]=%q,",depth,k,v))
2693     else
2694      handle(format("%s [%q]=%s,",depth,k,v)) 
2695     end
2696    end
2697   elseif tv=="string" then
2698    if tk=="number" then
2699     if hexify then
2700      handle(format("%s [0x%X]=%q,",depth,k,v))
2701     elseif accurate then
2702      handle(format("%s [%q]=%q,",depth,k,v))
2703     else
2704      handle(format("%s [%s]=%q,",depth,k,v))
2705     end
2706    elseif tk=="boolean" then
2707     handle(format("%s [%s]=%q,",depth,k and "true" or "false",v))
2708    elseif tk~="string" then
2709    elseif noquotes and not reserved[k] and lpegmatch(propername,k) then
2710     handle(format("%s %s=%q,",depth,k,v))
2711    else
2712     handle(format("%s [%q]=%q,",depth,k,v))
2713    end
2714   elseif tv=="table" then
2715    if next(v)==nil then
2716     if tk=="number" then
2717      if hexify then
2718       handle(format("%s [0x%X]={},",depth,k))
2719      elseif accurate then
2720       handle(format("%s [%q]={},",depth,k))
2721      else
2722       handle(format("%s [%s]={},",depth,k))
2723      end
2724     elseif tk=="boolean" then
2725      handle(format("%s [%s]={},",depth,k and "true" or "false"))
2726     elseif tk~="string" then
2727     elseif noquotes and not reserved[k] and lpegmatch(propername,k) then
2728      handle(format("%s %s={},",depth,k))
2729     else
2730      handle(format("%s [%q]={},",depth,k))
2731     end
2732    elseif inline then
2733     local st=is_simple_table(v,hexify,accurate)
2734     if st then
2735      if tk=="number" then
2736       if hexify then
2737        handle(format("%s [0x%X]={ %s },",depth,k,concat(st,", ")))
2738       elseif accurate then
2739        handle(format("%s [%q]={ %s },",depth,k,concat(st,", ")))
2740       else
2741        handle(format("%s [%s]={ %s },",depth,k,concat(st,", ")))
2742       end
2743      elseif tk=="boolean" then
2744       handle(format("%s [%s]={ %s },",depth,k and "true" or "false",concat(st,", ")))
2745      elseif tk~="string" then
2746      elseif noquotes and not reserved[k] and lpegmatch(propername,k) then
2747       handle(format("%s %s={ %s },",depth,k,concat(st,", ")))
2748      else
2749       handle(format("%s [%q]={ %s },",depth,k,concat(st,", ")))
2750      end
2751     else
2752      do_serialize(v,k,depth,level+1)
2753     end
2754    else
2755     do_serialize(v,k,depth,level+1)
2756    end
2757   elseif tv=="boolean" then
2758    if tk=="number" then
2759     if hexify then
2760      handle(format("%s [0x%X]=%s,",depth,k,v and "true" or "false"))
2761     elseif accurate then
2762      handle(format("%s [%q]=%s,",depth,k,v and "true" or "false"))
2763     else
2764      handle(format("%s [%s]=%s,",depth,k,v and "true" or "false"))
2765     end
2766    elseif tk=="boolean" then
2767     handle(format("%s [%s]=%s,",depth,tostring(k),v and "true" or "false"))
2768    elseif tk~="string" then
2769    elseif noquotes and not reserved[k] and lpegmatch(propername,k) then
2770     handle(format("%s %s=%s,",depth,k,v and "true" or "false"))
2771    else
2772     handle(format("%s [%q]=%s,",depth,k,v and "true" or "false"))
2773    end
2774   elseif tv=="function" then
2775    if functions then
2776     local getinfo=debug and debug.getinfo
2777     if getinfo then
2778      local f=getinfo(v).what=="C" and dump(dummy) or dump(v)
2779      if tk=="number" then
2780       if hexify then
2781        handle(format("%s [0x%X]=load(%q),",depth,k,f))
2782       elseif accurate then
2783        handle(format("%s [%q]=load(%q),",depth,k,f))
2784       else
2785        handle(format("%s [%s]=load(%q),",depth,k,f))
2786       end
2787      elseif tk=="boolean" then
2788       handle(format("%s [%s]=load(%q),",depth,k and "true" or "false",f))
2789      elseif tk~="string" then
2790      elseif noquotes and not reserved[k] and lpegmatch(propername,k) then
2791       handle(format("%s %s=load(%q),",depth,k,f))
2792      else
2793       handle(format("%s [%q]=load(%q),",depth,k,f))
2794      end
2795     end
2796    end
2797   else
2798    if tk=="number" then
2799     if hexify then
2800      handle(format("%s [0x%X]=%q,",depth,k,tostring(v)))
2801     elseif accurate then
2802      handle(format("%s [%q]=%q,",depth,k,tostring(v)))
2803     else
2804      handle(format("%s [%s]=%q,",depth,k,tostring(v)))
2805     end
2806    elseif tk=="boolean" then
2807     handle(format("%s [%s]=%q,",depth,k and "true" or "false",tostring(v)))
2808    elseif tk~="string" then
2809    elseif noquotes and not reserved[k] and lpegmatch(propername,k) then
2810     handle(format("%s %s=%q,",depth,k,tostring(v)))
2811    else
2812     handle(format("%s [%q]=%q,",depth,k,tostring(v)))
2813    end
2814   end
2815  end
2816 end
2817 if level>0 then
2818  handle(format("%s},",depth))
2819 end
2820end
2821local function serialize(_handle,root,name,specification) 
2822 local tname=type(name)
2823 if type(specification)=="table" then
2824  noquotes=specification.noquotes
2825  hexify=specification.hexify
2826  accurate=specification.accurate
2827  handle=_handle or specification.handle or print
2828  functions=specification.functions
2829  compact=specification.compact
2830  inline=specification.inline and compact
2831  metacheck=specification.metacheck
2832  if functions==nil then
2833   functions=true
2834  end
2835  if compact==nil then
2836   compact=true
2837  end
2838  if inline==nil then
2839   inline=compact
2840  end
2841  if metacheck==nil then
2842   metacheck=true
2843  end
2844 else
2845  noquotes=false
2846  hexify=false
2847  handle=_handle or print
2848  compact=true
2849  inline=true
2850  functions=true
2851  metacheck=true
2852 end
2853 if tname=="string" then
2854  if name=="return" then
2855   handle("return {")
2856  else
2857   handle(name.."={")
2858  end
2859 elseif tname=="number" then
2860  if hexify then
2861   handle(format("[0x%X]={",name))
2862  else
2863   handle("["..name.."]={")
2864  end
2865 elseif tname=="boolean" then
2866  if name then
2867   handle("return {")
2868  else
2869   handle("{")
2870  end
2871 else
2872  handle("t={")
2873 end
2874 if root then
2875  if metacheck and getmetatable(root) then
2876   local dummy=root._w_h_a_t_e_v_e_r_
2877   root._w_h_a_t_e_v_e_r_=nil
2878  end
2879  if next(root)~=nil then
2880   do_serialize(root,name,"",0)
2881  end
2882 end
2883 handle("}")
2884end
2885function table.serialize(root,name,specification)
2886 local t={}
2887 local n=0
2888 local function flush(s)
2889  n=n+1
2890  t[n]=s
2891 end
2892 serialize(flush,root,name,specification)
2893 return concat(t,"\n")
2894end
2895table.tohandle=serialize
2896local maxtab=2*1024
2897function table.tofile(filename,root,name,specification)
2898 local f=io.open(filename,'w')
2899 if f then
2900  if maxtab>1 then
2901   local t={}
2902   local n=0
2903   local function flush(s)
2904    n=n+1
2905    t[n]=s
2906    if n>maxtab then
2907     f:write(concat(t,"\n"),"\n") 
2908     t={} 
2909     n=0
2910    end
2911   end
2912   serialize(flush,root,name,specification)
2913   f:write(concat(t,"\n"),"\n")
2914  else
2915   local function flush(s)
2916    f:write(s,"\n")
2917   end
2918   serialize(flush,root,name,specification)
2919  end
2920  f:close()
2921  io.flush()
2922 end
2923end
2924local function flattened(t,f,depth) 
2925 if f==nil then
2926  f={}
2927  depth=0xFFFF
2928 elseif tonumber(f) then
2929  depth=f
2930  f={}
2931 elseif not depth then
2932  depth=0xFFFF
2933 end
2934 for k,v in next,t do
2935  if type(k)~="number" then
2936   if depth>0 and type(v)=="table" then
2937    flattened(v,f,depth-1)
2938   else
2939    f[#f+1]=v
2940   end
2941  end
2942 end
2943 for k=1,#t do
2944  local v=t[k]
2945  if depth>0 and type(v)=="table" then
2946   flattened(v,f,depth-1)
2947  else
2948   f[#f+1]=v
2949  end
2950 end
2951 return f
2952end
2953table.flattened=flattened
2954local function collapsed(t,f,h)
2955 if f==nil then
2956  f={}
2957  h={}
2958 end
2959 for k=1,#t do
2960  local v=t[k]
2961  if type(v)=="table" then
2962   collapsed(v,f,h)
2963  elseif not h[v] then
2964   f[#f+1]=v
2965   h[v]=true
2966  end
2967 end
2968 return f
2969end
2970local function collapsedhash(t,h)
2971 if h==nil then
2972  h={}
2973 end
2974 for k=1,#t do
2975  local v=t[k]
2976  if type(v)=="table" then
2977   collapsedhash(v,h)
2978  else
2979   h[v]=true
2980  end
2981 end
2982 return h
2983end
2984table.collapsed=collapsed  
2985table.collapsedhash=collapsedhash
2986local function unnest(t,f) 
2987 if not f then    
2988  f={}   
2989 end
2990 for i=1,#t do
2991  local v=t[i]
2992  if type(v)=="table" then
2993   if type(v[1])=="table" then
2994    unnest(v,f)
2995   else
2996    f[#f+1]=v
2997   end
2998  else
2999   f[#f+1]=v
3000  end
3001 end
3002 return f
3003end
3004function table.unnest(t) 
3005 return unnest(t)
3006end
3007local function are_equal(a,b,n,m) 
3008 if a==b then
3009  return true
3010 elseif a and b and #a==#b then
3011  if not n then
3012   n=1
3013  end
3014  if not m then
3015   m=#a
3016  end
3017  for i=n,m do
3018   local ai,bi=a[i],b[i]
3019   if ai==bi then
3020   elseif type(ai)=="table" and type(bi)=="table" then
3021    if not are_equal(ai,bi) then
3022     return false
3023    end
3024   else
3025    return false
3026   end
3027  end
3028  return true
3029 else
3030  return false
3031 end
3032end
3033local function identical(a,b) 
3034 if a~=b then
3035  for ka,va in next,a do
3036   local vb=b[ka]
3037   if va==vb then
3038   elseif type(va)=="table" and  type(vb)=="table" then
3039    if not identical(va,vb) then
3040     return false
3041    end
3042   else
3043    return false
3044   end
3045  end
3046 end
3047 return true
3048end
3049table.identical=identical
3050table.are_equal=are_equal
3051local function sparse(old,nest,keeptables)
3052 local new={}
3053 for k,v in next,old do
3054  if not (v=="" or v==false) then
3055   if nest and type(v)=="table" then
3056    v=sparse(v,nest)
3057    if keeptables or next(v)~=nil then
3058     new[k]=v
3059    end
3060   else
3061    new[k]=v
3062   end
3063  end
3064 end
3065 return new
3066end
3067table.sparse=sparse
3068function table.compact(t)
3069 return sparse(t,true,true)
3070end
3071function table.contains(t,v)
3072 if t then
3073  for i=1,#t do
3074   if t[i]==v then
3075    return i
3076   end
3077  end
3078 end
3079 return false
3080end
3081function table.count(t)
3082 local n=0
3083 for k,v in next,t do
3084  n=n+1
3085 end
3086 return n
3087end
3088function table.swapped(t,s) 
3089 local n={}
3090 if s then
3091  for k,v in next,s do
3092   n[k]=v
3093  end
3094 end
3095 for k,v in next,t do
3096  n[v]=k
3097 end
3098 return n
3099end
3100function table.hashed(t) 
3101 for i=1,#t do
3102  t[t[i]]=i
3103 end
3104 return t
3105end
3106function table.mirrored(t) 
3107 local n={}
3108 for k,v in next,t do
3109  n[v]=k
3110  n[k]=v
3111 end
3112 return n
3113end
3114function table.reversed(t)
3115 if t then
3116  local tt={}
3117  local tn=#t
3118  if tn>0 then
3119   local ttn=0
3120   for i=tn,1,-1 do
3121    ttn=ttn+1
3122    tt[ttn]=t[i]
3123   end
3124  end
3125  return tt
3126 end
3127end
3128function table.reverse(t) 
3129 if t then
3130  local n=#t
3131  local m=n+1
3132  for i=1,floor(n/2) do 
3133   local j=m-i
3134   t[i],t[j]=t[j],t[i]
3135  end
3136  return t
3137 end
3138end
3139local function sequenced(t,sep,simple)
3140 if not t then
3141  return ""
3142 elseif type(t)~="table" then
3143  return t 
3144 end
3145 local n=#t
3146 local s={}
3147 if n>0 then
3148  for i=1,n do
3149   local v=t[i]
3150   if type(v)=="table" then
3151    s[i]="{"..sequenced(v,sep,simple).."}"
3152   else
3153    s[i]=tostring(t[i])
3154   end
3155  end
3156 else
3157  n=0
3158  for k,v in sortedhash(t) do
3159   if simple then
3160    if v==true then
3161     n=n+1
3162     s[n]=k
3163    elseif v and v~="" then
3164     n=n+1
3165     if type(v)=="table" then
3166      s[n]=k.."={"..sequenced(v,sep,simple).."}"
3167     else
3168      s[n]=k.."="..tostring(v)
3169     end
3170    end
3171   else
3172    n=n+1
3173    if type(v)=="table" then
3174     s[n]=k.."={"..sequenced(v,sep,simple).."}"
3175    else
3176     s[n]=k.."="..tostring(v)
3177    end
3178   end
3179  end
3180 end
3181 if sep==true then
3182  return "{ "..concat(s,", ").." }"
3183 else
3184  return concat(s,sep or " | ")
3185 end
3186end
3187table.sequenced=sequenced
3188function table.print(t,...)
3189 if type(t)~="table" then
3190  print(tostring(t))
3191 else
3192  serialize(print,t,...)
3193 end
3194end
3195if setinspector then
3196 setinspector("table",function(v) if type(v)=="table" then serialize(print,v,"table") return true end end)
3197end
3198function table.sub(t,i,j)
3199 return { unpack(t,i,j) }
3200end
3201function table.is_empty(t)
3202 return not t or next(t)==nil
3203end
3204function table.has_one_entry(t)
3205 return t and next(t,next(t))==nil
3206end
3207function table.loweredkeys(t) 
3208 local l={}
3209 for k,v in next,t do
3210  l[lower(k)]=v
3211 end
3212 return l
3213end
3214function table.unique(old)
3215 local hash={}
3216 local new={}
3217 local n=0
3218 for i=1,#old do
3219  local oi=old[i]
3220  if not hash[oi] then
3221   n=n+1
3222   new[n]=oi
3223   hash[oi]=true
3224  end
3225 end
3226 return new
3227end
3228function table.sorted(t,...)
3229 sort(t,...)
3230 return t 
3231end
3232function table.values(t,s) 
3233 if t then
3234  local values={}
3235  local keys={}
3236  local v=0
3237  for key,value in next,t do
3238   if not keys[value] then
3239    v=v+1
3240    values[v]=value
3241    keys[k]=key
3242   end
3243  end
3244  if s then
3245   sort(values)
3246  end
3247  return values
3248 else
3249  return {}
3250 end
3251end
3252function table.filtered(t,pattern,sort,cmp)
3253 if t and type(pattern)=="string" then
3254  if sort then
3255   local s
3256   if cmp then
3257    s=sortedhashkeys(t,function(a,b) return cmp(t,a,b) end)
3258   else
3259    s=sortedkeys(t) 
3260   end
3261   local n=0
3262   local m=#s
3263   local function kv(s)
3264    while n<m do
3265     n=n+1
3266     local k=s[n]
3267     if find(k,pattern) then
3268      return k,t[k]
3269     end
3270    end
3271   end
3272   return kv,s
3273  else
3274   local n=next(t)
3275   local function iterator()
3276    while n~=nil do
3277     local k=n
3278     n=next(t,k)
3279     if find(k,pattern) then
3280      return k,t[k]
3281     end
3282    end
3283   end
3284   return iterator,t
3285  end
3286 else
3287  return nothing
3288 end
3289end
3290if not table.move then
3291 function table.move(a1,f,e,t,a2)
3292  if a2 and a1~=a2 then
3293   for i=f,e do
3294    a2[t]=a1[i]
3295    t=t+1
3296   end
3297   return a2
3298  else
3299   t=t+e-f
3300   for i=e,f,-1 do
3301    a1[t]=a1[i]
3302    t=t-1
3303   end
3304   return a1
3305  end
3306 end
3307end
3308
3309
3310end -- of closure
3311
3312do -- create closure to overcome 200 locals limit
3313
3314package.loaded["l-io"] = package.loaded["l-io"] or true
3315
3316-- original size: 11988, stripped down to: 6430
3317
3318if not modules then modules={} end modules ['l-io']={
3319 version=1.001,
3320 comment="companion to luat-lib.mkiv",
3321 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
3322 copyright="PRAGMA ADE / ConTeXt Development Team",
3323 license="see context related readme files"
3324}
3325local io=io
3326local open,flush,write,read=io.open,io.flush,io.write,io.read
3327local byte,find,gsub,format=string.byte,string.find,string.gsub,string.format
3328local concat=table.concat
3329local type=type
3330if string.find(os.getenv("PATH") or "",";",1,true) then
3331 io.fileseparator,io.pathseparator="\\",";"
3332else
3333 io.fileseparator,io.pathseparator="/",":"
3334end
3335local large=0x01000000 
3336local medium=0x00100000 
3337local small=0x00020000
3338local function readall(f)
3339 local size=f:seek("end")
3340 if size>0 then
3341  f:seek("set",0)
3342  return f:read(size)
3343 else
3344  return ""
3345 end
3346end
3347io.readall=readall
3348function io.loaddata(filename,textmode) 
3349 local f=open(filename,(textmode and 'r') or 'rb')
3350 if f then
3351  local size=f:seek("end")
3352  local data=nil
3353  if size>0 then
3354   f:seek("set",0)
3355   data=f:read(size)
3356  end
3357  f:close()
3358  return data
3359 end
3360end
3361function io.copydata(source,target,action)
3362 local f=open(source,"rb")
3363 if f then
3364  local g=open(target,"wb")
3365  if g then
3366   local size=f:seek("end")
3367   if size>0 then
3368    f:seek("set",0)
3369    local data=f:read(size)
3370    if action then
3371     data=action(data)
3372    end
3373    if data then
3374     g:write(data)
3375    end
3376   end
3377   g:close()
3378  end
3379  f:close()
3380  flush()
3381 end
3382end
3383function io.savedata(filename,data,joiner,append)
3384 local f=open(filename,append and "ab" or "wb")
3385 if f then
3386  if append and joiner and f:seek("end")>0 then
3387   f:write(joiner)
3388  end
3389  if type(data)=="table" then
3390   f:write(concat(data,joiner or ""))
3391  elseif type(data)=="function" then
3392   data(f)
3393  else
3394   f:write(data or "")
3395  end
3396  f:close()
3397  flush()
3398  return true
3399 else
3400  return false
3401 end
3402end
3403if fio and fio.readline then
3404 local readline=fio.readline
3405 function io.loadlines(filename,n) 
3406  local f=open(filename,'r')
3407  if not f then
3408  elseif n then
3409   local lines={}
3410   for i=1,n do
3411    local line=readline(f)
3412    if line then
3413     lines[i]=line
3414    else
3415     break
3416    end
3417   end
3418   f:close()
3419   lines=concat(lines,"\n")
3420   if #lines>0 then
3421    return lines
3422   end
3423  else
3424   local line=readline(f)
3425   f:close()
3426   if line and #line>0 then
3427    return line
3428   end
3429  end
3430 end
3431else
3432 function io.loadlines(filename,n) 
3433  local f=open(filename,'r')
3434  if not f then
3435  elseif n then
3436   local lines={}
3437   for i=1,n do
3438    local line=f:read("*lines")
3439    if line then
3440     lines[i]=line
3441    else
3442     break
3443    end
3444   end
3445   f:close()
3446   lines=concat(lines,"\n")
3447   if #lines>0 then
3448    return lines
3449   end
3450  else
3451   local line=f:read("*line") or ""
3452   f:close()
3453   if #line>0 then
3454    return line
3455   end
3456  end
3457 end
3458end
3459function io.loadchunk(filename,n)
3460 local f=open(filename,'rb')
3461 if f then
3462  local data=f:read(n or 1024)
3463  f:close()
3464  if #data>0 then
3465   return data
3466  end
3467 end
3468end
3469function io.exists(filename)
3470 local f=open(filename)
3471 if f==nil then
3472  return false
3473 else
3474  f:close()
3475  return true
3476 end
3477end
3478function io.size(filename)
3479 local f=open(filename)
3480 if f==nil then
3481  return 0
3482 else
3483  local s=f:seek("end")
3484  f:close()
3485  return s
3486 end
3487end
3488local function noflines(f)
3489 if type(f)=="string" then
3490  local f=open(filename)
3491  if f then
3492   local n=f and noflines(f) or 0
3493   f:close()
3494   return n
3495  else
3496   return 0
3497  end
3498 else
3499  local n=0
3500  for _ in f:lines() do
3501   n=n+1
3502  end
3503  f:seek('set',0)
3504  return n
3505 end
3506end
3507io.noflines=noflines
3508local nextchar={
3509 [ 4]=function(f)
3510  return f:read(1,1,1,1)
3511 end,
3512 [ 2]=function(f)
3513  return f:read(1,1)
3514 end,
3515 [ 1]=function(f)
3516  return f:read(1)
3517 end,
3518 [-2]=function(f)
3519  local a,b=f:read(1,1)
3520  return b,a
3521 end,
3522 [-4]=function(f)
3523  local a,b,c,d=f:read(1,1,1,1)
3524  return d,c,b,a
3525 end
3526}
3527function io.characters(f,n)
3528 if f then
3529  return nextchar[n or 1],f
3530 end
3531end
3532local nextbyte={
3533 [4]=function(f)
3534  local a,b,c,d=f:read(1,1,1,1)
3535  if d then
3536   return byte(a),byte(b),byte(c),byte(d)
3537  end
3538 end,
3539 [3]=function(f)
3540  local a,b,c=f:read(1,1,1)
3541  if b then
3542   return byte(a),byte(b),byte(c)
3543  end
3544 end,
3545 [2]=function(f)
3546  local a,b=f:read(1,1)
3547  if b then
3548   return byte(a),byte(b)
3549  end
3550 end,
3551 [1]=function (f)
3552  local a=f:read(1)
3553  if a then
3554   return byte(a)
3555  end
3556 end,
3557 [-2]=function (f)
3558  local a,b=f:read(1,1)
3559  if b then
3560   return byte(b),byte(a)
3561  end
3562 end,
3563 [-3]=function(f)
3564  local a,b,c=f:read(1,1,1)
3565  if b then
3566   return byte(c),byte(b),byte(a)
3567  end
3568 end,
3569 [-4]=function(f)
3570  local a,b,c,d=f:read(1,1,1,1)
3571  if d then
3572   return byte(d),byte(c),byte(b),byte(a)
3573  end
3574 end
3575}
3576function io.bytes(f,n)
3577 if f then
3578  return nextbyte[n or 1],f
3579 else
3580  return nil,nil
3581 end
3582end
3583function io.ask(question,default,options)
3584 while true do
3585  write(question)
3586  if options then
3587   write(format(" [%s]",concat(options,"|")))
3588  end
3589  if default then
3590   write(format(" [%s]",default))
3591  end
3592  write(format(" "))
3593  flush()
3594  local answer=read()
3595  answer=gsub(answer,"^%s*(.*)%s*$","%1")
3596  if answer=="" and default then
3597   return default
3598  elseif not options then
3599   return answer
3600  else
3601   for k=1,#options do
3602    if options[k]==answer then
3603     return answer
3604    end
3605   end
3606   local pattern="^"..answer
3607   for k=1,#options do
3608    local v=options[k]
3609    if find(v,pattern) then
3610     return v
3611    end
3612   end
3613  end
3614 end
3615end
3616local function readnumber(f,n,m) 
3617 if m then
3618  f:seek("set",n)
3619  n=m
3620 end
3621 if n==1 then
3622  return byte(f:read(1))
3623 elseif n==2 then
3624  local a,b=byte(f:read(2),1,2)
3625  return 0x100*a+b
3626 elseif n==3 then
3627  local a,b,c=byte(f:read(3),1,3)
3628  return 0x10000*a+0x100*b+c
3629 elseif n==4 then
3630  local a,b,c,d=byte(f:read(4),1,4)
3631  return 0x1000000*a+0x10000*b+0x100*c+d
3632 elseif n==8 then
3633  local a,b=readnumber(f,4),readnumber(f,4)
3634  return 0x100*a+b
3635 elseif n==12 then
3636  local a,b,c=readnumber(f,4),readnumber(f,4),readnumber(f,4)
3637  return 0x10000*a+0x100*b+c
3638 elseif n==-2 then
3639  local b,a=byte(f:read(2),1,2)
3640  return 0x100*a+b
3641 elseif n==-3 then
3642  local c,b,a=byte(f:read(3),1,3)
3643  return 0x10000*a+0x100*b+c
3644 elseif n==-4 then
3645  local d,c,b,a=byte(f:read(4),1,4)
3646  return 0x1000000*a+0x10000*b+0x100*c+d
3647 elseif n==-8 then
3648  local h,g,f,e,d,c,b,a=byte(f:read(8),1,8)
3649  return 0x100000000000000*a+0x1000000000000*b+0x10000000000*c+0x100000000*d+0x1000000*e+0x10000*f+0x100*g+h
3650 else
3651  return 0
3652 end
3653end
3654io.readnumber=readnumber
3655function io.readstring(f,n,m)
3656 if m then
3657  f:seek("set",n)
3658  n=m
3659 end
3660 local str=gsub(f:read(n),"\000","")
3661 return str
3662end
3663
3664
3665end -- of closure
3666
3667do -- create closure to overcome 200 locals limit
3668
3669package.loaded["l-number"] = package.loaded["l-number"] or true
3670
3671-- original size: 4588, stripped down to: 2159
3672
3673if not modules then modules={} end modules ['l-number']={
3674 version=1.001,
3675 comment="companion to luat-lib.mkxl",
3676 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
3677 copyright="PRAGMA ADE / ConTeXt Development Team",
3678 license="see context related readme files"
3679}
3680local tostring,tonumber=tostring,tonumber
3681local format,match,rep=string.format,string.match,string.rep
3682local concat,insert=table.concat,table.insert
3683local lpegmatch=lpeg.match
3684local floor=math.floor
3685number=number or {}
3686local number=number
3687if bit32 then
3688 local bextract=bit32.extract
3689 local t={
3690  "0","0","0","0","0","0","0","0",
3691  "0","0","0","0","0","0","0","0",
3692  "0","0","0","0","0","0","0","0",
3693  "0","0","0","0","0","0","0","0",
3694 }
3695 function number.tobitstring(b,m,w)
3696  if not w then
3697   w=32
3698  end
3699  local n=w
3700  for i=0,w-1 do
3701   local v=bextract(b,i)
3702   local k=w-i
3703   if v==1 then
3704    n=k
3705    t[k]="1"
3706   else
3707    t[k]="0"
3708   end
3709  end
3710  if w then
3711   return concat(t,"",1,w)
3712  elseif m then
3713   m=33-m*8
3714   if m<1 then
3715    m=1
3716   end
3717   return concat(t,"",1,m)
3718  elseif n<8 then
3719   return concat(t)
3720  elseif n<16 then
3721   return concat(t,"",9)
3722  elseif n<24 then
3723   return concat(t,"",17)
3724  else
3725   return concat(t,"",25)
3726  end
3727 end
3728else
3729 function number.tobitstring(n,m)
3730  if n>0 then
3731   local t={}
3732   while n>0 do
3733    insert(t,1,n%2>0 and 1 or 0)
3734    n=floor(n/2)
3735   end
3736   local nn=8-#t%8
3737   if nn>0 and nn<8 then
3738    for i=1,nn do
3739     insert(t,1,0)
3740    end
3741   end
3742   if m then
3743    m=m*8-#t
3744    if m>0 then
3745     insert(t,1,rep("0",m))
3746    end
3747   end
3748   return concat(t)
3749  elseif m then
3750   rep("00000000",m)
3751  else
3752   return "00000000"
3753  end
3754 end
3755end
3756function number.valid(str,default)
3757 return tonumber(str) or default or nil
3758end
3759function number.toevenhex(n)
3760 local s=format("%X",n)
3761 if #s%2==0 then
3762  return s
3763 else
3764  return "0"..s
3765 end
3766end
3767function number.bytetodecimal(b)
3768 local d=floor(b*100/255+0.5)
3769 if d>100 then
3770  return 100
3771 elseif d<-100 then
3772  return -100
3773 else
3774  return d
3775 end
3776end
3777function number.decimaltobyte(d)
3778 local b=floor(d*255/100+0.5)
3779 if b>255 then
3780  return 255
3781 elseif b<-255 then
3782  return -255
3783 else
3784  return b
3785 end
3786end
3787function number.idiv(i,d)
3788 return floor(i/d) 
3789end
3790
3791
3792end -- of closure
3793
3794do -- create closure to overcome 200 locals limit
3795
3796package.loaded["l-set"] = package.loaded["l-set"] or true
3797
3798-- original size: 1923, stripped down to: 1044
3799
3800if not modules then modules={} end modules ['l-set']={
3801 version=1.001,
3802 comment="companion to luat-lib.mkiv",
3803 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
3804 copyright="PRAGMA ADE / ConTeXt Development Team",
3805 license="see context related readme files"
3806}
3807set=set or {}
3808local nums={}
3809local tabs={}
3810local concat=table.concat
3811local next,type=next,type
3812set.create=table.tohash
3813function set.tonumber(t)
3814 if next(t) then
3815  local s=""
3816  for k,v in next,t do
3817   if v then
3818    s=s.." "..k
3819   end
3820  end
3821  local n=nums[s]
3822  if not n then
3823   n=#tabs+1
3824   tabs[n]=t
3825   nums[s]=n
3826  end
3827  return n
3828 else
3829  return 0
3830 end
3831end
3832function set.totable(n)
3833 if n==0 then
3834  return {}
3835 else
3836  return tabs[n] or {}
3837 end
3838end
3839function set.tolist(n)
3840 if n==0 or not tabs[n] then
3841  return ""
3842 else
3843  local t,n={},0
3844  for k,v in next,tabs[n] do
3845   if v then
3846    n=n+1
3847    t[n]=k
3848   end
3849  end
3850  return concat(t," ")
3851 end
3852end
3853function set.contains(n,s)
3854 if type(n)=="table" then
3855  return n[s]
3856 elseif n==0 then
3857  return false
3858 else
3859  local t=tabs[n]
3860  return t and t[s]
3861 end
3862end
3863
3864
3865end -- of closure
3866
3867do -- create closure to overcome 200 locals limit
3868
3869package.loaded["l-os"] = package.loaded["l-os"] or true
3870
3871-- original size: 20690, stripped down to: 10794
3872
3873if not modules then modules={} end modules ['l-os']={
3874 version=1.001,
3875 comment="companion to luat-lib.mkiv",
3876 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
3877 copyright="PRAGMA ADE / ConTeXt Development Team",
3878 license="see context related readme files"
3879}
3880local os=os
3881local date,time,difftime=os.date,os.time,os.difftime
3882local find,format,gsub,upper,gmatch=string.find,string.format,string.gsub,string.upper,string.gmatch
3883local concat=table.concat
3884local random,ceil,randomseed,modf=math.random,math.ceil,math.randomseed,math.modf
3885local type,setmetatable,tonumber,tostring=type,setmetatable,tonumber,tostring
3886do
3887 local selfdir=os.selfdir
3888 if selfdir=="" then
3889  selfdir=nil
3890 end
3891 if not selfdir then
3892  if arg then
3893   for i=1,#arg do
3894    local a=arg[i]
3895    if find(a,"^%-%-[c:]*texmfbinpath=") then
3896     selfdir=gsub(a,"^.-=","")
3897     break
3898    end
3899   end
3900  end
3901  if not selfdir then
3902   selfdir=os.selfbin or "luatex"
3903   if find(selfdir,"[/\\]") then
3904    selfdir=gsub(selfdir,"[/\\][^/\\]*$","")
3905   elseif os.getenv then
3906    local path=os.getenv("PATH")
3907    local name=gsub(selfdir,"^.*[/\\][^/\\]","")
3908    local patt="[^:]+"
3909    if os.type=="windows" then
3910     patt="[^;]+"
3911     name=name..".exe"
3912    end
3913    local isfile
3914    if lfs then
3915     local attributes=lfs.attributes
3916     isfile=function(name)
3917      local a=attributes(name,"mode")
3918      return a=="file" or a=="link" or nil
3919     end
3920    else
3921     local open=io.open
3922     isfile=function(name)
3923      local f=open(name)
3924      if f then
3925       f:close()
3926       return true
3927      end
3928     end
3929    end
3930    for p in gmatch(path,patt) do
3931     if isfile(p.."/"..name) then
3932      selfdir=p
3933      break
3934     end
3935    end
3936   end
3937  end
3938  os.selfdir=selfdir or "."
3939 end
3940end
3941math.initialseed=tonumber(string.sub(string.reverse(tostring(ceil(socket and socket.gettime()*10000 or time()))),1,6))
3942randomseed(math.initialseed)
3943if not os.__getenv__ then
3944 os.__getenv__=os.getenv
3945 os.__setenv__=os.setenv
3946 if os.env then
3947  local osgetenv=os.getenv
3948  local ossetenv=os.setenv
3949  local osenv=os.env   local _=osenv.PATH 
3950  function os.setenv(k,v)
3951   if v==nil then
3952    v=""
3953   end
3954   local K=upper(k)
3955   osenv[K]=v
3956   if type(v)=="table" then
3957    v=concat(v,";") 
3958   end
3959   ossetenv(K,v)
3960  end
3961  function os.getenv(k)
3962   local K=upper(k)
3963   local v=osenv[K] or osenv[k] or osgetenv(K) or osgetenv(k)
3964   if v=="" then
3965    return nil
3966   else
3967    return v
3968   end
3969  end
3970 else
3971  local ossetenv=os.setenv
3972  local osgetenv=os.getenv
3973  local osenv={}
3974  function os.setenv(k,v)
3975   if v==nil then
3976    v=""
3977   end
3978   local K=upper(k)
3979   osenv[K]=v
3980  end
3981  function os.getenv(k)
3982   local K=upper(k) 
3983   local v=osenv[K] or osgetenv(K) or osgetenv(k)
3984   if v=="" then
3985    return nil
3986   else
3987    return v
3988   end
3989  end
3990  local function __index(t,k)
3991   return os.getenv(k)
3992  end
3993  local function __newindex(t,k,v)
3994   os.setenv(k,v)
3995  end
3996  os.env={}
3997  setmetatable(os.env,{ __index=__index,__newindex=__newindex } )
3998 end
3999end
4000if not io.fileseparator then
4001 if find(os.getenv("PATH"),";",1,true) then
4002  io.fileseparator,io.pathseparator,os.type="\\",";",os.type or "windows"
4003 else
4004  io.fileseparator,io.pathseparator,os.type="/",":",os.type or "unix"
4005 end
4006end
4007os.type=os.type or (io.pathseparator==";"    and "windows") or "unix"
4008os.name=os.name or (os.type=="windows" and "mswin"  ) or "linux"
4009if os.type=="windows" then
4010 os.libsuffix,os.binsuffix,os.binsuffixes='dll','exe',{ 'exe','cmd','bat' }
4011elseif os.name=="macosx" then
4012 os.libsuffix,os.binsuffix,os.binsuffixes='dylib','',{ '' }
4013else
4014 os.libsuffix,os.binsuffix,os.binsuffixes='so','',{ '' }
4015end
4016do
4017 local execute=os.execute
4018 local iopopen=io.popen
4019 local ostype=os.type
4020 local function resultof(command)
4021  local handle=iopopen(command,ostype=="windows" and "rb" or "r")
4022  if handle then
4023   local result=handle:read("*all") or ""
4024   handle:close()
4025   return result
4026  else
4027   return ""
4028  end
4029 end
4030 os.resultof=resultof
4031 function os.pipeto(command)
4032  return iopopen(command,"w") 
4033 end
4034 local launchers={
4035  windows="start %s",
4036  macosx="open %s",
4037  unix="xdg-open %s &> /dev/null &",
4038 }
4039 function os.launch(str)
4040  local command=format(launchers[os.name] or launchers.unix,str)
4041  execute(command)
4042 end
4043end
4044do
4045 local gettimeofday=os.gettimeofday or os.clock
4046 os.gettimeofday=gettimeofday
4047 local startuptime=gettimeofday()
4048 function os.runtime()
4049  return gettimeofday()-startuptime
4050 end
4051end
4052do
4053 local name=os.name or "linux"
4054 local platform=os.getenv("MTX_PLATFORM") or ""
4055 local architecture=os.uname and os.uname().machine 
4056 local bits=os.getenv("MTX_BITS") or find(platform,"64") and 64 or 32
4057 if platform~="" then
4058 elseif os.type=="windows" then
4059  architecture=string.lower(architecture or os.getenv("PROCESSOR_ARCHITECTURE") or "")
4060  if architecture=="x86_64" then
4061   bits,platform=64,"win64"
4062  elseif find(architecture,"amd64") then
4063   bits,platform=64,"win64"
4064  elseif find(architecture,"arm64") then
4065   bits,platform=64,"windows-arm64"
4066  elseif find(architecture,"arm32") then
4067   bits,platform=32,"windows-arm32"
4068  else
4069   bits,platform=32,"mswin"
4070  end
4071 elseif name=="linux" then
4072  architecture=architecture or os.getenv("HOSTTYPE") or resultof("uname -m") or ""
4073  local musl=find(os.selfdir or "","linuxmusl")
4074  if find(architecture,"x86_64") then
4075   bits,platform=64,musl and "linuxmusl-64" or "linux-64"
4076  elseif find(architecture,"ppc") then
4077   bits,platform=32,"linux-ppc" 
4078  else
4079   bits,platform=32,musl and "linuxmusl" or "linux"
4080  end
4081 elseif name=="macosx" then
4082  architecture=architecture or resultof("echo $HOSTTYPE") or ""
4083  if architecture=="" then
4084   bits,platform=64,"osx-intel"
4085  elseif find(architecture,"i386") then
4086   bits,platform=64,"osx-intel"
4087  elseif find(architecture,"x86_64") then
4088   bits,platform=64,"osx-64"
4089  elseif find(architecture,"arm64") then
4090   bits,platform=64,"osx-arm"
4091  else
4092   bits,platform=32,"osx-ppc"
4093  end
4094 elseif name=="sunos" then
4095  architecture=architecture or resultof("uname -m") or ""
4096  if find(architecture,"sparc") then
4097   bits,platform=32,"solaris-sparc"
4098  else 
4099   bits,platform=32,"solaris-intel"
4100  end
4101 elseif name=="freebsd" then
4102  architecture=architecture or os.getenv("MACHTYPE") or resultof("uname -m") or ""
4103  if find(architecture,"amd64") or find(architecture,"AMD64") then
4104   bits,platform=64,"freebsd-amd64"
4105  else
4106   bits,platform=32,"freebsd"
4107  end
4108 elseif name=="kfreebsd" then
4109  architecture=architecture or os.getenv("HOSTTYPE") or resultof("uname -m") or ""
4110  if architecture=="x86_64" then
4111   bits,platform=64,"kfreebsd-amd64"
4112  else
4113   bits,platform=32,"kfreebsd-i386"
4114  end
4115 else
4116  architecture=architecture or resultof("uname -m") or ""
4117  if find(architecture,"aarch64") then
4118   bits,platform="linux-aarch64"
4119  elseif find(architecture,"armv7l") then
4120   bits,platform=32,"linux-armhf"
4121  elseif find(architecture,"mips64") or find(architecture,"mips64el") then
4122   bits,platform=64,"linux-mipsel"
4123  elseif find(architecture,"mipsel") or find(architecture,"mips") then
4124   bits,platform=32,"linux-mipsel"
4125  else
4126   bits,platform=64,"linux-64" 
4127  end
4128 end
4129 os.setenv("MTX_PLATFORM",platform)
4130 os.setenv("MTX_BITS",bits)
4131 os.platform=platform
4132 os.bits=bits
4133 os.newline=name=="windows" and "\013\010" or "\010" 
4134end
4135do
4136 local t={ 8,9,"a","b" }
4137 function os.uuid()
4138  return format("%04x%04x-4%03x-%s%03x-%04x-%04x%04x%04x",
4139   random(0xFFFF),random(0xFFFF),
4140   random(0x0FFF),
4141   t[ceil(random(4))] or 8,random(0x0FFF),
4142   random(0xFFFF),
4143   random(0xFFFF),random(0xFFFF),random(0xFFFF)
4144  )
4145 end
4146end
4147do
4148 local hour,min
4149 function os.timezone(difference)
4150  if not hour then
4151   local current=time()
4152   local utcdate=date("!*t",current)
4153   local localdate=date("*t",current)
4154   localdate.isdst=false
4155   local timediff=difftime(time(localdate),time(utcdate))
4156   hour,min=modf(timediff/3600)
4157   min=min*60
4158  end
4159  if difference then
4160   return hour,min
4161  else
4162   return format("%+03d:%02d",hour,min) 
4163  end
4164 end
4165 local timeformat=format("%%s%s",os.timezone())
4166 local dateformat="%Y-%m-%d %H:%M:%S"
4167 local lasttime=nil
4168 local lastdate=nil
4169 function os.fulltime(t,default)
4170  t=t and tonumber(t) or 0
4171  if t>0 then
4172  elseif default then
4173   return default
4174  else
4175   t=time()
4176  end
4177  if t~=lasttime then
4178   lasttime=t
4179   lastdate=format(timeformat,date(dateformat))
4180  end
4181  return lastdate
4182 end
4183 local dateformat="%Y-%m-%d %H:%M:%S"
4184 local lasttime=nil
4185 local lastdate=nil
4186 function os.localtime(t,default)
4187  t=t and tonumber(t) or 0
4188  if t>0 then
4189  elseif default then
4190   return default
4191  else
4192   t=time()
4193  end
4194  if t~=lasttime then
4195   lasttime=t
4196   lastdate=date(dateformat,t)
4197  end
4198  return lastdate
4199 end
4200 function os.converttime(t,default)
4201  local t=tonumber(t)
4202  if t and t>0 then
4203   return date(dateformat,t)
4204  else
4205   return default or "-"
4206  end
4207 end
4208 function os.today()
4209  return date("!*t")
4210 end
4211 function os.now()
4212  return date("!%Y-%m-%d %H:%M:%S")
4213 end
4214end
4215do
4216 local cache={}
4217 local function which(filename)
4218  local fullname=cache[filename]
4219  if fullname==nil then
4220   local suffix=file.suffix(filename)
4221   local suffixes=suffix=="" and os.binsuffixes or { suffix }
4222   for directory in gmatch(os.getenv("PATH"),"[^"..io.pathseparator.."]+") do
4223    local df=file.join(directory,filename)
4224    for i=1,#suffixes do
4225     local dfs=file.addsuffix(df,suffixes[i])
4226     if io.exists(dfs) then
4227      fullname=dfs
4228      break
4229     end
4230    end
4231   end
4232   if not fullname then
4233    fullname=false
4234   end
4235   cache[filename]=fullname
4236  end
4237  return fullname
4238 end
4239 os.which=which
4240 os.where=which
4241end
4242if not os.sleep then
4243 local socket=socket
4244 function os.sleep(n)
4245  if not socket then
4246   socket=require("socket")
4247  end
4248  socket.sleep(n)
4249 end
4250end
4251do
4252 local function isleapyear(year)
4253  return (year%4==0) and (year%100~=0 or year%400==0)
4254 end
4255 os.isleapyear=isleapyear
4256 local days={ 31,28,31,30,31,30,31,31,30,31,30,31 }
4257 local function nofdays(year,month,day)
4258  if not month then
4259   return isleapyear(year) and 365 or 364
4260  elseif not day then
4261   return month==2 and isleapyear(year) and 29 or days[month]
4262  else
4263   for i=1,month-1 do
4264    day=day+days[i]
4265   end
4266   if month>2 and isleapyear(year) then
4267    day=day+1
4268   end
4269   return day
4270  end
4271 end
4272 os.nofdays=nofdays
4273 function os.weekday(day,month,year)
4274  return date("%w",time { year=year,month=month,day=day })+1
4275 end
4276 function os.validdate(year,month,day)
4277  if month<1 then
4278   month=1
4279  elseif month>12 then
4280   month=12
4281  end
4282  if day<1 then
4283   day=1
4284  else
4285   local max=nofdays(year,month)
4286   if day>max then
4287    day=max
4288   end
4289  end
4290  return year,month,day
4291 end
4292 function os.date(fmt,...)
4293  if not fmt then
4294   fmt="%Y-%m-%d %H:%M"
4295  end
4296  return date(fmt,...)
4297 end
4298end
4299do
4300 local osexit=os.exit
4301 local exitcode=nil
4302 function os.setexitcode(code)
4303  exitcode=code
4304 end
4305 function os.exit(c)
4306  if exitcode~=nil then
4307   return osexit(exitcode)
4308  end
4309  if c~=nil then
4310   return osexit(c)
4311  end
4312  return osexit()
4313 end
4314end
4315
4316
4317end -- of closure
4318
4319do -- create closure to overcome 200 locals limit
4320
4321package.loaded["l-file"] = package.loaded["l-file"] or true
4322
4323-- original size: 22637, stripped down to: 10595
4324
4325if not modules then modules={} end modules ['l-file']={
4326 version=1.001,
4327 comment="companion to luat-lib.mkiv",
4328 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
4329 copyright="PRAGMA ADE / ConTeXt Development Team",
4330 license="see context related readme files"
4331}
4332file=file or {}
4333local file=file
4334if not lfs then
4335 lfs=optionalrequire("lfs")
4336end
4337local insert,concat=table.insert,table.concat
4338local match,find,gmatch=string.match,string.find,string.gmatch
4339local lpegmatch=lpeg.match
4340local getcurrentdir,attributes=lfs.currentdir,lfs.attributes
4341local checkedsplit=string.checkedsplit
4342local P,R,S,C,Cs,Cp,Cc,Ct=lpeg.P,lpeg.R,lpeg.S,lpeg.C,lpeg.Cs,lpeg.Cp,lpeg.Cc,lpeg.Ct
4343local attributes=lfs.attributes
4344function lfs.isdir(name)
4345 if name then
4346  return attributes(name,"mode")=="directory"
4347 end
4348end
4349function lfs.isfile(name)
4350 if name then
4351  local a=attributes(name,"mode")
4352  return a=="file" or a=="link" or nil
4353 end
4354end
4355function lfs.isfound(name)
4356 if name then
4357  local a=attributes(name,"mode")
4358  return (a=="file" or a=="link") and name or nil
4359 end
4360end
4361function lfs.modification(name)
4362 return name and attributes(name,"modification") or nil
4363end
4364if sandbox then
4365 sandbox.redefine(lfs.isfile,"lfs.isfile")
4366 sandbox.redefine(lfs.isdir,"lfs.isdir")
4367 sandbox.redefine(lfs.isfound,"lfs.isfound")
4368end
4369local colon=P(":")
4370local period=P(".")
4371local periods=P("..")
4372local fwslash=P("/")
4373local bwslash=P("\\")
4374local slashes=S("\\/")
4375local noperiod=1-period
4376local noslashes=1-slashes
4377local name=noperiod^1
4378local suffix=period/""*(1-period-slashes)^1*-1
4379local pattern=C((1-(slashes^1*noslashes^1*-1))^1)*P(1) 
4380local function pathpart(name,default)
4381 return name and lpegmatch(pattern,name) or default or ""
4382end
4383local pattern=(noslashes^0*slashes)^1*C(noslashes^1)*-1
4384local function basename(name)
4385 return name and lpegmatch(pattern,name) or name
4386end
4387local pattern=(noslashes^0*slashes^1)^0*Cs((1-suffix)^1)*suffix^0
4388local function nameonly(name)
4389 return name and lpegmatch(pattern,name) or name
4390end
4391local pattern=(noslashes^0*slashes)^0*(noperiod^1*period)^1*C(noperiod^1)*-1
4392local function suffixonly(name)
4393 return name and lpegmatch(pattern,name) or ""
4394end
4395local pattern=(noslashes^0*slashes)^0*noperiod^1*((period*C(noperiod^1))^1)*-1+Cc("")
4396local function suffixesonly(name)
4397 if name then
4398  return lpegmatch(pattern,name)
4399 else
4400  return ""
4401 end
4402end
4403file.pathpart=pathpart
4404file.basename=basename
4405file.nameonly=nameonly
4406file.suffixonly=suffixonly
4407file.suffix=suffixonly
4408file.suffixesonly=suffixesonly
4409file.suffixes=suffixesonly
4410file.dirname=pathpart   
4411file.extname=suffixonly
4412local drive=C(R("az","AZ"))*colon
4413local path=C((noslashes^0*slashes)^0)
4414local suffix=period*C(P(1-period)^0*P(-1))
4415local base=C((1-suffix)^0)
4416local rest=C(P(1)^0)
4417drive=drive+Cc("")
4418path=path+Cc("")
4419base=base+Cc("")
4420suffix=suffix+Cc("")
4421local pattern_a=drive*path*base*suffix
4422local pattern_b=path*base*suffix
4423local pattern_c=C(drive*path)*C(base*suffix) 
4424local pattern_d=path*rest
4425function file.splitname(str,splitdrive)
4426 if not str then
4427 elseif splitdrive then
4428  return lpegmatch(pattern_a,str) 
4429 else
4430  return lpegmatch(pattern_b,str) 
4431 end
4432end
4433function file.splitbase(str)
4434 if str then
4435  return lpegmatch(pattern_d,str) 
4436 else
4437  return "",str 
4438 end
4439end
4440function file.nametotable(str,splitdrive)
4441 if str then
4442  local path,drive,subpath,name,base,suffix=lpegmatch(pattern_c,str)
4443  if splitdrive then
4444   return {
4445    path=path,
4446    drive=drive,
4447    subpath=subpath,
4448    name=name,
4449    base=base,
4450    suffix=suffix,
4451   }
4452  else
4453   return {
4454    path=path,
4455    name=name,
4456    base=base,
4457    suffix=suffix,
4458   }
4459  end
4460 end
4461end
4462local pattern=Cs(((period*(1-period-slashes)^1*-1)/""+1)^1)
4463function file.removesuffix(name)
4464 return name and lpegmatch(pattern,name)
4465end
4466local suffix=period/""*(1-period-slashes)^1*-1
4467local pattern=Cs((noslashes^0*slashes^1)^0*((1-suffix)^1))*Cs(suffix)
4468function file.addsuffix(filename,suffix,criterium)
4469 if not filename or not suffix or suffix=="" then
4470  return filename
4471 elseif criterium==true then
4472  return filename.."."..suffix
4473 elseif not criterium then
4474  local n,s=lpegmatch(pattern,filename)
4475  if not s or s=="" then
4476   return filename.."."..suffix
4477  else
4478   return filename
4479  end
4480 else
4481  local n,s=lpegmatch(pattern,filename)
4482  if s and s~="" then
4483   local t=type(criterium)
4484   if t=="table" then
4485    for i=1,#criterium do
4486     if s==criterium[i] then
4487      return filename
4488     end
4489    end
4490   elseif t=="string" then
4491    if s==criterium then
4492     return filename
4493    end
4494   end
4495  end
4496  return (n or filename).."."..suffix
4497 end
4498end
4499local suffix=period*(1-period-slashes)^1*-1
4500local pattern=Cs((1-suffix)^0)
4501function file.replacesuffix(name,suffix)
4502 if name and suffix and suffix~="" then
4503  return lpegmatch(pattern,name).."."..suffix
4504 else
4505  return name
4506 end
4507end
4508local reslasher=lpeg.replacer(P("\\"),"/")
4509function file.reslash(str)
4510 return str and lpegmatch(reslasher,str)
4511end
4512if lfs.isreadablefile and lfs.iswritablefile then
4513 file.is_readable=lfs.isreadablefile
4514 file.is_writable=lfs.iswritablefile
4515else
4516 function file.is_writable(name)
4517  if not name then
4518  elseif lfs.isdir(name) then
4519   name=name.."/m_t_x_t_e_s_t.tmp"
4520   local f=io.open(name,"wb")
4521   if f then
4522    f:close()
4523    os.remove(name)
4524    return true
4525   end
4526  elseif lfs.isfile(name) then
4527   local f=io.open(name,"ab")
4528   if f then
4529    f:close()
4530    return true
4531   end
4532  else
4533   local f=io.open(name,"ab")
4534   if f then
4535    f:close()
4536    os.remove(name)
4537    return true
4538   end
4539  end
4540  return false
4541 end
4542 local readable=P("r")*Cc(true)
4543 function file.is_readable(name)
4544  if name then
4545   local a=attributes(name)
4546   return a and lpegmatch(readable,a.permissions) or false
4547  else
4548   return false
4549  end
4550 end
4551end
4552file.isreadable=file.is_readable 
4553file.iswritable=file.is_writable 
4554function file.size(name)
4555 if name then
4556  local a=attributes(name)
4557  return a and a.size or 0
4558 else
4559  return 0
4560 end
4561end
4562function file.splitpath(str,separator) 
4563 return str and checkedsplit(lpegmatch(reslasher,str),separator or io.pathseparator)
4564end
4565function file.joinpath(tab,separator) 
4566 return tab and concat(tab,separator or io.pathseparator) 
4567end
4568local someslash=S("\\/")
4569local stripper=Cs(P(fwslash)^0/""*reslasher)
4570local isnetwork=someslash*someslash*(1-someslash)+(1-fwslash-colon)^1*colon
4571local isroot=fwslash^1*-1
4572local hasroot=fwslash^1
4573local reslasher=lpeg.replacer(S("\\/"),"/")
4574local deslasher=lpeg.replacer(S("\\/")^1,"/")
4575function file.join(one,two,three,...)
4576 if not two then
4577  return one=="" and one or lpegmatch(reslasher,one)
4578 end
4579 if not one or one=="" then
4580  return lpegmatch(stripper,three and concat({ two,three,... },"/") or two)
4581 end
4582 if lpegmatch(isnetwork,one) then
4583  local one=lpegmatch(reslasher,one)
4584  local two=lpegmatch(deslasher,three and concat({ two,three,... },"/") or two)
4585  if lpegmatch(hasroot,two) then
4586   return one..two
4587  else
4588   return one.."/"..two
4589  end
4590 elseif lpegmatch(isroot,one) then
4591  local two=lpegmatch(deslasher,three and concat({ two,three,... },"/") or two)
4592  if lpegmatch(hasroot,two) then
4593   return two
4594  else
4595   return "/"..two
4596  end
4597 else
4598  return lpegmatch(deslasher,concat({  one,two,three,... },"/"))
4599 end
4600end
4601local drivespec=R("az","AZ")^1*colon
4602local anchors=fwslash+drivespec
4603local untouched=periods+(1-period)^1*P(-1)
4604local mswindrive=Cs(drivespec*(bwslash/"/"+fwslash)^0)
4605local mswinuncpath=(bwslash+fwslash)*(bwslash+fwslash)*Cc("//")
4606local splitstarter=(mswindrive+mswinuncpath+Cc(false))*Ct(lpeg.splitat(S("/\\")^1))
4607local absolute=fwslash
4608function file.collapsepath(str,anchor) 
4609 if not str then
4610  return
4611 end
4612 if anchor==true and not lpegmatch(anchors,str) then
4613  str=getcurrentdir().."/"..str
4614 end
4615 if str=="" or str=="." then
4616  return "."
4617 elseif lpegmatch(untouched,str) then
4618  return lpegmatch(reslasher,str)
4619 end
4620 local starter,oldelements=lpegmatch(splitstarter,str)
4621 local newelements={}
4622 local i=#oldelements
4623 while i>0 do
4624  local element=oldelements[i]
4625  if element=='.' then
4626  elseif element=='..' then
4627   local n=i-1
4628   while n>0 do
4629    local element=oldelements[n]
4630    if element~='..' and element~='.' then
4631     oldelements[n]='.'
4632     break
4633    else
4634     n=n-1
4635    end
4636    end
4637   if n<1 then
4638      insert(newelements,1,'..')
4639   end
4640  elseif element~="" then
4641   insert(newelements,1,element)
4642  end
4643  i=i-1
4644 end
4645 if #newelements==0 then
4646  return starter or "."
4647 elseif starter then
4648  return starter..concat(newelements,'/')
4649 elseif lpegmatch(absolute,str) then
4650  return "/"..concat(newelements,'/')
4651 else
4652  newelements=concat(newelements,'/')
4653  if anchor=="." and find(str,"^%./") then
4654   return "./"..newelements
4655  else
4656   return newelements
4657  end
4658 end
4659end
4660local validchars=R("az","09","AZ","--","..")
4661local pattern_a=lpeg.replacer(1-validchars)
4662local pattern_a=Cs((validchars+P(1)/"-")^1)
4663local whatever=P("-")^0/""
4664local pattern_b=Cs(whatever*(1-whatever*-1)^1)
4665function file.robustname(str,strict)
4666 if str then
4667  str=lpegmatch(pattern_a,str) or str
4668  if strict then
4669   return lpegmatch(pattern_b,str) or str 
4670  else
4671   return str
4672  end
4673 end
4674end
4675local loaddata=io.loaddata
4676local savedata=io.savedata
4677file.readdata=loaddata
4678file.savedata=savedata
4679function file.copy(oldname,newname)
4680 if oldname and newname then
4681  local data=loaddata(oldname)
4682  if data and data~="" then
4683   savedata(newname,data)
4684  end
4685 end
4686end
4687local letter=R("az","AZ")+S("_-+")
4688local separator=P("://")
4689local qualified=period^0*fwslash+letter*colon+letter^1*separator+letter^1*fwslash
4690local rootbased=fwslash+letter*colon
4691lpeg.patterns.qualified=qualified
4692lpeg.patterns.rootbased=rootbased
4693function file.is_qualified_path(filename)
4694 return filename and lpegmatch(qualified,filename)~=nil
4695end
4696function file.is_rootbased_path(filename)
4697 return filename and lpegmatch(rootbased,filename)~=nil
4698end
4699function file.strip(name,dir)
4700 if name then
4701  local b,a=match(name,"^(.-)"..dir.."(.*)$")
4702  return a~="" and a or name
4703 end
4704end
4705function lfs.mkdirs(path)
4706 local full=""
4707 for sub in gmatch(path,"(/*[^\\/]+)") do 
4708  full=full..sub
4709  lfs.mkdir(full)
4710 end
4711end
4712function file.withinbase(path) 
4713 local l=0
4714 if not find(path,"^/") then
4715  path="/"..path
4716 end
4717 for dir in gmatch(path,"/([^/]+)") do
4718  if dir==".." then
4719   l=l-1
4720  elseif dir~="." then
4721   l=l+1
4722  end
4723  if l<0 then
4724   return false
4725  end
4726 end
4727 return true
4728end
4729do
4730 local symlinktarget=lfs.symlinktarget  
4731 local symlinkattributes=lfs.symlinkattributes 
4732 if symlinktarget then
4733  function lfs.readlink(name)
4734   local target=symlinktarget(name)
4735   return name~=target and name or nil
4736  end
4737 elseif symlinkattributes then
4738  function lfs.readlink(name)
4739   return symlinkattributes(name,"target") or nil
4740  end
4741 else
4742  function lfs.readlink(name)
4743   return nil
4744  end
4745 end
4746end
4747
4748
4749end -- of closure
4750
4751do -- create closure to overcome 200 locals limit
4752
4753package.loaded["l-gzip"] = package.loaded["l-gzip"] or true
4754
4755-- original size: 268, stripped down to: 216
4756
4757if not modules then modules={} end modules ['l-gzip']={
4758 version=1.001,
4759 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
4760 copyright="PRAGMA ADE / ConTeXt Development Team",
4761 license="see context related readme files"
4762}
4763
4764
4765end -- of closure
4766
4767do -- create closure to overcome 200 locals limit
4768
4769package.loaded["l-md5"] = package.loaded["l-md5"] or true
4770
4771-- original size: 3414, stripped down to: 2307
4772
4773if not modules then modules={} end modules ['l-md5']={
4774 version=1.001,
4775 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
4776 copyright="PRAGMA ADE / ConTeXt Development Team",
4777 license="see context related readme files"
4778}
4779if not md5 then
4780 md5=optionalrequire("md5")
4781end
4782if not md5 then
4783 md5={
4784  sum=function(str) print("error: md5 is not loaded (sum     ignored)") return str end,
4785  sumhexa=function(str) print("error: md5 is not loaded (sumhexa ignored)") return str end,
4786 }
4787end
4788local md5,file=md5,file
4789local gsub=string.gsub
4790local modification,isfile,touch=lfs.modification,lfs.isfile,lfs.touch
4791local loaddata,savedata=io.loaddata,io.savedata
4792do
4793 local patterns=lpeg and lpeg.patterns
4794 if patterns then
4795  local bytestoHEX=patterns.bytestoHEX
4796  local bytestohex=patterns.bytestohex
4797  local bytestodec=patterns.bytestodec
4798  local lpegmatch=lpeg.match
4799  local md5sum=md5.sum
4800  if not md5.HEX then function md5.HEX(str) if str then return lpegmatch(bytestoHEX,md5sum(str)) end end end
4801  if not md5.hex then function md5.hex(str) if str then return lpegmatch(bytestohex,md5sum(str)) end end end
4802  if not md5.dec then function md5.dec(str) if str then return lpegmatch(bytestodec,md5sum(str)) end end end
4803  md5.sumhexa=md5.hex
4804  md5.sumHEXA=md5.HEX
4805 end
4806end
4807local md5HEX=md5.HEX
4808function file.needsupdating(oldname,newname,threshold) 
4809 local oldtime=modification(oldname)
4810 if oldtime then
4811  local newtime=modification(newname)
4812  if not newtime then
4813   return true 
4814  elseif newtime>=oldtime then
4815   return false 
4816  elseif oldtime-newtime<(threshold or 1) then
4817   return false 
4818  else
4819   return true 
4820  end
4821 else
4822  return false 
4823 end
4824end
4825file.needs_updating=file.needsupdating
4826function file.syncmtimes(oldname,newname)
4827 local oldtime=modification(oldname)
4828 if oldtime and isfile(newname) then
4829  touch(newname,oldtime,oldtime)
4830 end
4831end
4832local function checksum(name)
4833 if md5 then
4834  local data=loaddata(name)
4835  if data then
4836   return md5HEX(data)
4837  end
4838 end
4839 return nil
4840end
4841file.checksum=checksum
4842function file.loadchecksum(name)
4843 if md5 then
4844  local data=loaddata(name..".md5")
4845  return data and (gsub(data,"%s",""))
4846 end
4847 return nil
4848end
4849function file.savechecksum(name,checksum)
4850 if not checksum then checksum=checksum(name) end
4851 if checksum then
4852  savedata(name..".md5",checksum)
4853  return checksum
4854 end
4855 return nil
4856end
4857
4858
4859end -- of closure
4860
4861do -- create closure to overcome 200 locals limit
4862
4863package.loaded["l-sha"] = package.loaded["l-sha"] or true
4864
4865-- original size: 1085, stripped down to: 969
4866
4867if not modules then modules={} end modules ['l-sha']={
4868 version=1.001,
4869 comment="companion to luat-lib.mkiv",
4870 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
4871 copyright="PRAGMA ADE / ConTeXt Development Team",
4872 license="see context related readme files"
4873}
4874if sha2 then
4875 local lpegmatch=lpeg.match
4876 local lpegpatterns=lpeg.patterns
4877 local bytestohex=lpegpatterns.bytestohex
4878 local bytestoHEX=lpegpatterns.bytestoHEX
4879 local digest256=sha2.digest256
4880 local digest384=sha2.digest384
4881 local digest512=sha2.digest512
4882 sha2.hash256=function(str) return lpegmatch(bytestohex,digest256(str)) end
4883 sha2.hash384=function(str) return lpegmatch(bytestohex,digest384(str)) end
4884 sha2.hash512=function(str) return lpegmatch(bytestohex,digest512(str)) end
4885 sha2.HASH256=function(str) return lpegmatch(bytestoHEX,digest256(str)) end
4886 sha2.HASH384=function(str) return lpegmatch(bytestoHEX,digest384(str)) end
4887 sha2.HASH512=function(str) return lpegmatch(bytestoHEX,digest512(str)) end
4888end
4889
4890
4891end -- of closure
4892
4893do -- create closure to overcome 200 locals limit
4894
4895package.loaded["l-url"] = package.loaded["l-url"] or true
4896
4897-- original size: 14713, stripped down to: 6981
4898
4899if not modules then modules={} end modules ['l-url']={
4900 version=1.001,
4901 comment="companion to luat-lib.mkiv",
4902 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
4903 copyright="PRAGMA ADE / ConTeXt Development Team",
4904 license="see context related readme files"
4905}
4906local char,format,byte=string.char,string.format,string.byte
4907local concat=table.concat
4908local tonumber,type,next=tonumber,type,next
4909local P,C,R,S,Cs,Cc,Ct,Cf,Cg,V=lpeg.P,lpeg.C,lpeg.R,lpeg.S,lpeg.Cs,lpeg.Cc,lpeg.Ct,lpeg.Cf,lpeg.Cg,lpeg.V
4910local lpegmatch,lpegpatterns,replacer=lpeg.match,lpeg.patterns,lpeg.replacer
4911local sortedhash=table.sortedhash
4912url=url or {}
4913local url=url
4914local unescapes={}
4915local escapes={}
4916setmetatable(unescapes,{ __index=function(t,k)
4917 local v=char(tonumber(k,16))
4918 t[k]=v
4919 return v
4920end })
4921setmetatable(escapes,{ __index=function(t,k)
4922 local v=format("%%%02X",byte(k))
4923 t[k]=v
4924 return v
4925end })
4926local colon=P(":")
4927local qmark=P("?")
4928local hash=P("#")
4929local slash=P("/")
4930local atsign=P("@")
4931local percent=P("%")
4932local endofstring=P(-1)
4933local hexdigit=R("09","AF","af")
4934local plus=P("+")
4935local nothing=Cc("")
4936local okay=R("09","AZ","az")+S("-_.,:=+*~!'()@&$")
4937local escapedchar=(percent*C(hexdigit*hexdigit))/unescapes
4938local unescapedchar=P(1)/escapes
4939local escaped=(plus/" ")+escapedchar 
4940local noslash=P("/")/""
4941local plustospace=P("+")/" "
4942local decoder=Cs((
4943     plustospace+escapedchar+P("\r\n")/"\n"+P(1)
4944    )^0 )
4945local encoder=Cs((
4946     R("09","AZ","az")^1+S("-./_")^1+P(" ")/"+"+P("\n")/"\r\n"+unescapedchar
4947    )^0 )
4948lpegpatterns.urldecoder=decoder
4949lpegpatterns.urlencoder=encoder
4950function url.decode  (str) return str and lpegmatch(decoder,str) or str end
4951function url.encode  (str) return str and lpegmatch(encoder,str) or str end
4952function url.unescape(str) return str and lpegmatch(unescaper,str) or str end
4953local schemestr=Cs((escaped+(1-colon-slash-qmark-hash))^2)
4954local authoritystr=Cs((escaped+(1-   slash-qmark-hash))^0)
4955local pathstr=Cs((escaped+(1-   qmark-hash))^0)
4956local querystr=Cs(((1-      hash))^0)
4957local fragmentstr=Cs((escaped+(1-     endofstring))^0)
4958local scheme=schemestr*colon+nothing
4959local authority=slash*slash*authoritystr+nothing
4960local path=slash*pathstr+nothing
4961local query=qmark*querystr+nothing
4962local fragment=hash*fragmentstr+nothing
4963local validurl=scheme*authority*path*query*fragment
4964local parser=Ct(validurl)
4965lpegpatterns.url=validurl
4966lpegpatterns.urlsplitter=parser
4967local escaper=Cs((R("09","AZ","az")^1+P(" ")/"%%20"+S("-./_:")^1+P(1)/escapes)^0) 
4968local unescaper=Cs((escapedchar+1)^0)
4969local getcleaner=Cs((P("+++")/"%%2B"+P("+")/"%%20"+P(1))^1)
4970lpegpatterns.urlunescaped=escapedchar
4971lpegpatterns.urlescaper=escaper
4972lpegpatterns.urlunescaper=unescaper
4973lpegpatterns.urlgetcleaner=getcleaner
4974function url.unescapeget(str)
4975 return lpegmatch(getcleaner,str)
4976end
4977local function split(str)
4978 return (type(str)=="string" and lpegmatch(parser,str)) or str
4979end
4980local isscheme=schemestr*colon*slash*slash 
4981local function hasscheme(str)
4982 if str then
4983  local scheme=lpegmatch(isscheme,str) 
4984  return scheme~="" and scheme or false
4985 else
4986  return false
4987 end
4988end
4989local rootletter=R("az","AZ")+S("_-+")
4990local separator=P("://")
4991local qualified=P(".")^0*P("/")+rootletter*P(":")+rootletter^1*separator+rootletter^1*P("/")
4992local rootbased=P("/")+rootletter*P(":")
4993local barswapper=replacer("|",":")
4994local backslashswapper=replacer("\\","/")
4995local equal=P("=")
4996local amp=P("&")
4997local key=Cs(((plustospace+escapedchar+1)-equal     )^0)
4998local value=Cs(((plustospace+escapedchar+1)-amp-endofstring)^0)
4999local splitquery=Cf (Ct("")*P { "sequence",
5000 sequence=V("pair")*(amp*V("pair"))^0,
5001 pair=Cg(key*equal*value),
5002},rawset)
5003local userpart=(1-atsign-colon)^1
5004local serverpart=(1-colon)^1
5005local splitauthority=((Cs(userpart)*colon*Cs(userpart)+Cs(userpart)*Cc(nil))*atsign+Cc(nil)*Cc(nil))*Cs(serverpart)*(colon*(serverpart/tonumber)+Cc(nil))
5006local function hashed(str) 
5007 if not str or str=="" then
5008  return {
5009   scheme="invalid",
5010   original=str,
5011  }
5012 end
5013 local detailed=split(str)
5014 local rawscheme=""
5015 local rawquery=""
5016 local somescheme=false
5017 local somequery=false
5018 if detailed then
5019  rawscheme=detailed[1]
5020  rawquery=detailed[4]
5021  somescheme=rawscheme~=""
5022  somequery=rawquery~=""
5023 end
5024 if not somescheme and not somequery then
5025  return {
5026   scheme="file",
5027   authority="",
5028   path=str,
5029   query="",
5030   fragment="",
5031   original=str,
5032   noscheme=true,
5033   filename=str,
5034  }
5035 end
5036 local authority=detailed[2]
5037 local path=detailed[3]
5038 local filename  
5039 local username  
5040 local password  
5041 local host   
5042 local port   
5043 if authority~="" then
5044  username,password,host,port=lpegmatch(splitauthority,authority)
5045 end
5046 if authority=="" then
5047  filename=path
5048 elseif path=="" then
5049  filename=""
5050 else
5051  filename=authority.."/"..path
5052 end
5053 return {
5054  scheme=rawscheme,
5055  authority=authority,
5056  path=path,
5057  query=lpegmatch(unescaper,rawquery),
5058  queries=lpegmatch(splitquery,rawquery),
5059  fragment=detailed[5],
5060  original=str,
5061  noscheme=false,
5062  filename=filename,
5063  host=host,
5064  port=port,
5065 }
5066end
5067url.split=split
5068url.hasscheme=hasscheme
5069url.hashed=hashed
5070function url.addscheme(str,scheme) 
5071 if hasscheme(str) then
5072  return str
5073 elseif not scheme then
5074  return "file:///"..str
5075 else
5076  return scheme..":///"..str
5077 end
5078end
5079function url.construct(hash) 
5080 local result,r={},0
5081 local scheme=hash.scheme
5082 local authority=hash.authority
5083 local path=hash.path
5084 local queries=hash.queries
5085 local fragment=hash.fragment
5086 if scheme and scheme~="" then
5087  r=r+1;result[r]=lpegmatch(escaper,scheme)
5088  r=r+1;result[r]="://"
5089 end
5090 if authority and authority~="" then
5091  r=r+1;result[r]=lpegmatch(escaper,authority)
5092 end
5093 if path and path~="" then
5094  r=r+1;result[r]="/"
5095  r=r+1;result[r]=lpegmatch(escaper,path)
5096 end
5097 if queries then
5098  local done=false
5099  for k,v in sortedhash(queries) do
5100   r=r+1;result[r]=done and "&" or "?"
5101   r=r+1;result[r]=lpegmatch(escaper,k) 
5102   r=r+1;result[r]="="
5103   r=r+1;result[r]=lpegmatch(escaper,v) 
5104   done=true
5105  end
5106 end
5107 if fragment and fragment~="" then
5108  r=r+1;result[r]="#"
5109  r=r+1;result[r]=lpegmatch(escaper,fragment)
5110 end
5111 return concat(result)
5112end
5113local pattern=Cs(slash^-1/""*R("az","AZ")*((S(":|")/":")+P(":"))*slash*P(1)^0)
5114function url.filename(filename)
5115 local spec=hashed(filename)
5116 local path=spec.path
5117 return (spec.scheme=="file" and path and lpegmatch(pattern,path)) or filename
5118end
5119local function escapestring(str)
5120 return lpegmatch(escaper,str)
5121end
5122url.escape=escapestring
5123function url.query(str)
5124 if type(str)=="string" then
5125  return lpegmatch(splitquery,str) or ""
5126 else
5127  return str
5128 end
5129end
5130function url.toquery(data)
5131 local td=type(data)
5132 if td=="string" then
5133  return #str and escape(data) or nil 
5134 elseif td=="table" then
5135  if next(data) then
5136   local t={}
5137   for k,v in next,data do
5138    t[#t+1]=format("%s=%s",k,escapestring(v))
5139   end
5140   return concat(t,"&")
5141  end
5142 else
5143 end
5144end
5145local pattern=Cs(noslash^0*(1-noslash*P(-1))^0)
5146function url.barepath(path)
5147 if not path or path=="" then
5148  return ""
5149 else
5150  return lpegmatch(pattern,path)
5151 end
5152end
5153
5154
5155end -- of closure
5156
5157do -- create closure to overcome 200 locals limit
5158
5159package.loaded["l-dir"] = package.loaded["l-dir"] or true
5160
5161-- original size: 19139, stripped down to: 11345
5162
5163if not modules then modules={} end modules ['l-dir']={
5164 version=1.001,
5165 comment="companion to luat-lib.mkiv",
5166 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
5167 copyright="PRAGMA ADE / ConTeXt Development Team",
5168 license="see context related readme files"
5169}
5170local type,select=type,select
5171local find,gmatch,match,gsub,sub=string.find,string.gmatch,string.match,string.gsub,string.sub
5172local concat,insert,remove,unpack=table.concat,table.insert,table.remove,table.unpack
5173local lpegmatch=lpeg.match
5174local P,S,R,C,Cc,Cs,Ct,Cv,V=lpeg.P,lpeg.S,lpeg.R,lpeg.C,lpeg.Cc,lpeg.Cs,lpeg.Ct,lpeg.Cv,lpeg.V
5175dir=dir or {}
5176local dir=dir
5177local lfs=lfs
5178local attributes=lfs.attributes
5179local scandir=lfs.dir
5180local isdir=lfs.isdir  
5181local isfile=lfs.isfile 
5182local currentdir=lfs.currentdir
5183local chdir=lfs.chdir
5184local mkdir=lfs.mkdir
5185local onwindows=os.type=="windows" or find(os.getenv("PATH"),";",1,true)
5186if onwindows then
5187 local tricky=S("/\\")*P(-1)
5188 isdir=function(name)
5189  if lpegmatch(tricky,name) then
5190   return attributes(name,"mode")=="directory"
5191  else
5192   return attributes(name.."/.","mode")=="directory"
5193  end
5194 end
5195 isfile=function(name)
5196  return attributes(name,"mode")=="file"
5197 end
5198 lfs.isdir=isdir
5199 lfs.isfile=isfile
5200else
5201 isdir=function(name)
5202  return attributes(name,"mode")=="directory"
5203 end
5204 isfile=function(name)
5205  return attributes(name,"mode")=="file"
5206 end
5207 lfs.isdir=isdir
5208 lfs.isfile=isfile
5209end
5210local isreadable=file.isreadable
5211local walkdir=function(p,...)
5212 if isreadable(p.."/.") then
5213  return scandir(p,...)
5214 else
5215  return function() end
5216 end
5217end
5218lfs.walkdir=walkdir
5219function dir.current()
5220 return (gsub(currentdir(),"\\","/"))
5221end
5222local function glob_pattern_function(path,patt,recurse,action)
5223 if isdir(path) then
5224  local usedpath
5225  if path=="/" then
5226   usedpath="/."
5227  elseif not find(path,"/$") then
5228   usedpath=path.."/."
5229   path=path.."/"
5230  else
5231   usedpath=path
5232  end
5233  local dirs
5234  local nofdirs=0
5235  for name,mode,size,time in walkdir(usedpath) do
5236   if name~="." and name~=".." then
5237    local full=path..name
5238    if mode==nil then
5239     mode=attributes(full,'mode')
5240    end
5241    if mode=='file' then
5242     if not patt or find(full,patt) then
5243      action(full,size,time)
5244     end
5245    elseif recurse and mode=="directory" then
5246     if dirs then
5247      nofdirs=nofdirs+1
5248      dirs[nofdirs]=full
5249     else
5250      nofdirs=1
5251      dirs={ full }
5252     end
5253    end
5254   end
5255  end
5256  if dirs then
5257   for i=1,nofdirs do
5258    glob_pattern_function(dirs[i],patt,recurse,action)
5259   end
5260  end
5261 end
5262end
5263local function glob_pattern_table(path,patt,recurse,result)
5264 if not result then
5265  result={}
5266 end
5267 local usedpath
5268 if path=="/" then
5269  usedpath="/."
5270 elseif not find(path,"/$") then
5271  usedpath=path.."/."
5272  path=path.."/"
5273 else
5274  usedpath=path
5275 end
5276 local dirs
5277 local nofdirs=0
5278 local noffiles=#result
5279 for name,mode in walkdir(usedpath) do
5280  if name~="." and name~=".." then
5281   local full=path..name
5282   if mode==nil then
5283    mode=attributes(full,'mode')
5284   end
5285   if mode=='file' then
5286    if not patt or find(full,patt) then
5287     noffiles=noffiles+1
5288     result[noffiles]=full
5289    end
5290   elseif recurse and mode=="directory" then
5291    if dirs then
5292     nofdirs=nofdirs+1
5293     dirs[nofdirs]=full
5294    else
5295     nofdirs=1
5296     dirs={ full }
5297    end
5298   end
5299  end
5300 end
5301 if dirs then
5302  for i=1,nofdirs do
5303   glob_pattern_table(dirs[i],patt,recurse,result)
5304  end
5305 end
5306 return result
5307end
5308local function globpattern(path,patt,recurse,method)
5309 local kind=type(method)
5310 if patt and sub(patt,1,-3)==path then
5311  patt=false
5312 end
5313 local okay=isdir(path)
5314 if kind=="function" then
5315  return okay and glob_pattern_function(path,patt,recurse,method) or {}
5316 elseif kind=="table" then
5317  return okay and glob_pattern_table(path,patt,recurse,method) or method
5318 else
5319  return okay and glob_pattern_table(path,patt,recurse,{}) or {}
5320 end
5321end
5322dir.globpattern=globpattern
5323local function collectpattern(path,patt,recurse,result)
5324 local ok,scanner
5325 result=result or {}
5326 if path=="/" then
5327  ok,scanner,first=xpcall(function() return walkdir(path..".") end,function() end) 
5328 else
5329  ok,scanner,first=xpcall(function() return walkdir(path)   end,function() end) 
5330 end
5331 if ok and type(scanner)=="function" then
5332  if not find(path,"/$") then
5333   path=path..'/'
5334  end
5335  for name in scanner,first do 
5336   if name=="." then
5337   elseif name==".." then
5338   else
5339    local full=path..name
5340    local attr=attributes(full)
5341    local mode=attr.mode
5342    if mode=='file' then
5343     if find(full,patt) then
5344      result[name]=attr
5345     end
5346    elseif recurse and mode=="directory" then
5347     attr.list=collectpattern(full,patt,recurse)
5348     result[name]=attr
5349    end
5350   end
5351  end
5352 end
5353 return result
5354end
5355dir.collectpattern=collectpattern
5356local separator,pattern
5357if onwindows then 
5358 local slash=S("/\\")/"/"
5359 pattern={
5360  (Cs(P(".")+slash^1)+Cs(R("az","AZ")*P(":")*slash^0)+Cc("./"))*V(2)*V(3),
5361  Cs(((1-S("*?/\\"))^0*slash)^0),
5362  Cs(P(1)^0)
5363 }
5364else
5365 pattern={
5366  (C(P(".")+P("/")^1)+Cc("./"))*V(2)*V(3),
5367  C(((1-S("*?/"))^0*P("/"))^0),
5368  C(P(1)^0)
5369 }
5370end
5371local filter=Cs ((
5372 P("**")/".*"+P("*")/"[^/]*"+P("?")/"[^/]"+P(".")/"%%."+P("+")/"%%+"+P("-")/"%%-"+P(1)
5373)^0 )
5374local function glob(str,t)
5375 if type(t)=="function" then
5376  if type(str)=="table" then
5377   for s=1,#str do
5378    glob(str[s],t)
5379   end
5380  elseif isfile(str) then
5381   t(str)
5382  else
5383   local root,path,base=lpegmatch(pattern,str) 
5384   if root and path and base then
5385    local recurse=find(base,"**",1,true) 
5386    local start=root..path
5387    local result=lpegmatch(filter,start..base)
5388    globpattern(start,result,recurse,t)
5389   end
5390  end
5391 else
5392  if type(str)=="table" then
5393   local t=t or {}
5394   for s=1,#str do
5395    glob(str[s],t)
5396   end
5397   return t
5398  elseif isfile(str) then
5399   if t then
5400    t[#t+1]=str
5401    return t
5402   else
5403    return { str }
5404   end
5405  else
5406   local root,path,base=lpegmatch(pattern,str) 
5407   if root and path and base then
5408    local recurse=find(base,"**",1,true) 
5409    local start=root..path
5410    local result=lpegmatch(filter,start..base)
5411    return globpattern(start,result,recurse,t)
5412   else
5413    return {}
5414   end
5415  end
5416 end
5417end
5418dir.glob=glob
5419local function globfiles(path,recurse,func,files) 
5420 if type(func)=="string" then
5421  local s=func
5422  func=function(name) return find(name,s) end
5423 end
5424 files=files or {}
5425 local noffiles=#files
5426 for name,mode in walkdir(path) do
5427  if find(name,"^%.") then
5428  else
5429   if mode==nil then
5430    mode=attributes(name,'mode')
5431   end
5432   if mode=="directory" then
5433    if recurse then
5434     globfiles(path.."/"..name,recurse,func,files)
5435    end
5436   elseif mode=="file" then
5437    if not func or func(name) then
5438     noffiles=noffiles+1
5439     files[noffiles]=path.."/"..name
5440    end
5441   end
5442  end
5443 end
5444 return files
5445end
5446dir.globfiles=globfiles
5447local function globdirs(path,recurse,func,files) 
5448 if type(func)=="string" then
5449  local s=func
5450  func=function(name) return find(name,s) end
5451 end
5452 files=files or {}
5453 local noffiles=#files
5454 for name,mode in walkdir(path) do
5455  if find(name,"^%.") then
5456  else
5457   if mode==nil then
5458    mode=attributes(name,'mode')
5459   end
5460   if mode=="directory" then
5461    if not func or func(name) then
5462     noffiles=noffiles+1
5463     files[noffiles]=path.."/"..name
5464     if recurse then
5465      globdirs(path.."/"..name,recurse,func,files)
5466     end
5467    end
5468   end
5469  end
5470 end
5471 return files
5472end
5473dir.globdirs=globdirs
5474function dir.ls(pattern)
5475 return concat(glob(pattern),"\n")
5476end
5477local make_indeed=true 
5478if onwindows then
5479 function dir.mkdirs(...)
5480  local n=select("#",...)
5481  local str
5482  if n==1 then
5483   str=select(1,...)
5484   if isdir(str) then
5485    return str,true
5486   end
5487  else
5488   str=""
5489   for i=1,n do
5490    local s=select(i,...)
5491    if s=="" then
5492    elseif str=="" then
5493     str=s
5494    else
5495     str=str.."/"..s
5496    end
5497   end
5498  end
5499  local pth=""
5500  local drive=false
5501  local first,middle,last=match(str,"^(//)(//*)(.*)$")
5502  if first then
5503  else
5504   first,last=match(str,"^(//)/*(.-)$")
5505   if first then
5506    middle,last=match(str,"([^/]+)/+(.-)$")
5507    if middle then
5508     pth="//"..middle
5509    else
5510     pth="//"..last
5511     last=""
5512    end
5513   else
5514    first,middle,last=match(str,"^([a-zA-Z]:)(/*)(.-)$")
5515    if first then
5516     pth,drive=first..middle,true
5517    else
5518     middle,last=match(str,"^(/*)(.-)$")
5519     if not middle then
5520      last=str
5521     end
5522    end
5523   end
5524  end
5525  for s in gmatch(last,"[^/]+") do
5526   if pth=="" then
5527    pth=s
5528   elseif drive then
5529    pth,drive=pth..s,false
5530   else
5531    pth=pth.."/"..s
5532   end
5533   if make_indeed and not isdir(pth) then
5534    mkdir(pth)
5535   end
5536  end
5537  return pth,(isdir(pth)==true)
5538 end
5539else
5540 function dir.mkdirs(...)
5541  local n=select("#",...)
5542  local str,pth
5543  if n==1 then
5544   str=select(1,...)
5545   if isdir(str) then
5546    return str,true
5547   end
5548  else
5549   str=""
5550   for i=1,n do
5551    local s=select(i,...)
5552    if s and s~="" then 
5553     if str~="" then
5554      str=str.."/"..s
5555     else
5556      str=s
5557     end
5558    end
5559   end
5560  end
5561  str=gsub(str,"/+","/")
5562  if find(str,"^/") then
5563   pth="/"
5564   for s in gmatch(str,"[^/]+") do
5565    local first=(pth=="/")
5566    if first then
5567     pth=pth..s
5568    else
5569     pth=pth.."/"..s
5570    end
5571    if make_indeed and not first and not isdir(pth) then
5572     mkdir(pth)
5573    end
5574   end
5575  else
5576   pth="."
5577   for s in gmatch(str,"[^/]+") do
5578    pth=pth.."/"..s
5579    if make_indeed and not isdir(pth) then
5580     mkdir(pth)
5581    end
5582   end
5583  end
5584  return pth,(isdir(pth)==true)
5585 end
5586end
5587dir.makedirs=dir.mkdirs
5588do
5589 local chdir=sandbox and sandbox.original(chdir) or chdir
5590 if onwindows then
5591  local xcurrentdir=dir.current
5592  function dir.expandname(str) 
5593   local first,nothing,last=match(str,"^(//)(//*)(.*)$")
5594   if first then
5595    first=xcurrentdir().."/" 
5596   end
5597   if not first then
5598    first,last=match(str,"^(//)/*(.*)$")
5599   end
5600   if not first then
5601    first,last=match(str,"^([a-zA-Z]:)(.*)$")
5602    if first and not find(last,"^/") then
5603     local d=currentdir() 
5604     if chdir(first) then
5605      first=xcurrentdir() 
5606     end
5607     chdir(d)
5608    end
5609   end
5610   if not first then
5611    first,last=xcurrentdir(),str
5612   end
5613   last=gsub(last,"//","/")
5614   last=gsub(last,"/%./","/")
5615   last=gsub(last,"^/*","")
5616   first=gsub(first,"/*$","")
5617   if last=="" or last=="." then
5618    return first
5619   else
5620    return first.."/"..last
5621   end
5622  end
5623 else
5624  function dir.expandname(str) 
5625   if not find(str,"^/") then
5626    str=currentdir().."/"..str
5627   end
5628   str=gsub(str,"//","/")
5629   str=gsub(str,"/%./","/")
5630   str=gsub(str,"(.)/%.$","%1")
5631   return str
5632  end
5633 end
5634 function dir.expandlink(dir,report)
5635  local curdir=currentdir()
5636  local trace=type(report)=="function"
5637  if chdir(dir) then
5638   local newdir=currentdir()
5639   if newdir~=dir and trace then
5640    report("following symlink %a to %a",dir,newdir)
5641   end
5642   chdir(curdir)
5643   return newdir
5644  else
5645   if trace then
5646    report("unable to check path %a",dir)
5647   end
5648   return dir
5649  end
5650 end
5651end
5652file.expandname=dir.expandname 
5653local stack={}
5654function dir.push(newdir)
5655 local curdir=currentdir()
5656 insert(stack,curdir)
5657 if newdir and newdir~="" and chdir(newdir) then
5658  return newdir
5659 else
5660  return curdir
5661 end
5662end
5663function dir.pop()
5664 local d=remove(stack)
5665 if d then
5666  chdir(d)
5667 end
5668 return d
5669end
5670local function found(...) 
5671 for i=1,select("#",...) do
5672  local path=select(i,...)
5673  local kind=type(path)
5674  if kind=="string" then
5675   if isdir(path) then
5676    return path
5677   end
5678  elseif kind=="table" then
5679   local path=found(unpack(path))
5680   if path then
5681    return path
5682   end
5683  end
5684 end
5685end
5686dir.found=found
5687
5688
5689end -- of closure
5690
5691do -- create closure to overcome 200 locals limit
5692
5693package.loaded["l-boolean"] = package.loaded["l-boolean"] or true
5694
5695-- original size: 1850, stripped down to: 1498
5696
5697if not modules then modules={} end modules ['l-boolean']={
5698 version=1.001,
5699 comment="companion to luat-lib.mkiv",
5700 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
5701 copyright="PRAGMA ADE / ConTeXt Development Team",
5702 license="see context related readme files"
5703}
5704local type,tonumber=type,tonumber
5705boolean=boolean or {}
5706local boolean=boolean
5707function boolean.tonumber(b)
5708 if b then return 1 else return 0 end 
5709end
5710function toboolean(str,tolerant) 
5711 if  str==nil then
5712  return false
5713 elseif str==false then
5714  return false
5715 elseif str==true then
5716  return true
5717 elseif str=="true" then
5718  return true
5719 elseif str=="false" then
5720  return false
5721 elseif not tolerant then
5722  return false
5723 elseif str==0 then
5724  return false
5725 elseif (tonumber(str) or 0)>0 then
5726  return true
5727 else
5728  return str=="yes" or str=="on" or str=="t"
5729 end
5730end
5731string.toboolean=toboolean
5732function string.booleanstring(str)
5733 if str=="0" then
5734  return false
5735 elseif str=="1" then
5736  return true
5737 elseif str=="" then
5738  return false
5739 elseif str=="false" then
5740  return false
5741 elseif str=="true" then
5742  return true
5743 elseif (tonumber(str) or 0)>0 then
5744  return true
5745 else
5746  return str=="yes" or str=="on" or str=="t"
5747 end
5748end
5749function string.is_boolean(str,default,strict)
5750 if type(str)=="string" then
5751  if str=="true" or str=="yes" or str=="on" or str=="t" or (not strict and str=="1") then
5752   return true
5753  elseif str=="false" or str=="no" or str=="off" or str=="f" or (not strict and str=="0") then
5754   return false
5755  end
5756 end
5757 return default
5758end
5759
5760
5761end -- of closure
5762
5763do -- create closure to overcome 200 locals limit
5764
5765package.loaded["l-unicode"] = package.loaded["l-unicode"] or true
5766
5767-- original size: 41303, stripped down to: 17277
5768
5769if not modules then modules={} end modules ['l-unicode']={
5770 version=1.001,
5771 optimize=true,
5772 comment="companion to luat-lib.mkiv",
5773 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
5774 copyright="PRAGMA ADE / ConTeXt Development Team",
5775 license="see context related readme files"
5776}
5777utf=utf or {}
5778unicode=nil
5779if not string.utfcharacters then
5780 local gmatch=string.gmatch
5781 function string.characters(str)
5782  return gmatch(str,".[\128-\191]*")
5783 end
5784end
5785utf.characters=string.utfcharacters
5786local type=type
5787local char,byte,format,sub,gmatch=string.char,string.byte,string.format,string.sub,string.gmatch
5788local concat=table.concat
5789local P,C,R,Cs,Ct,Cmt,Cc,Carg,Cp=lpeg.P,lpeg.C,lpeg.R,lpeg.Cs,lpeg.Ct,lpeg.Cmt,lpeg.Cc,lpeg.Carg,lpeg.Cp
5790local lpegmatch=lpeg.match
5791local patterns=lpeg.patterns
5792local tabletopattern=lpeg.utfchartabletopattern
5793local bytepairs=string.bytepairs
5794local finder=lpeg.finder
5795local replacer=lpeg.replacer
5796local p_utftype=patterns.utftype
5797local p_utfstricttype=patterns.utfstricttype
5798local p_utfoffset=patterns.utfoffset
5799local p_utf8character=patterns.utf8character
5800local p_utf8char=patterns.utf8char
5801local p_utf8byte=patterns.utf8byte
5802local p_utfbom=patterns.utfbom
5803local p_newline=patterns.newline
5804local p_whitespace=patterns.whitespace
5805if not utf.char then
5806 utf.char=string.utfcharacter or (utf8 and utf8.char)
5807 if not utf.char then
5808  local char=string.char
5809  if bit32 then
5810   local rshift=bit32.rshift
5811   function utf.char(n)
5812    if n<0x80 then
5813     return char(n)
5814    elseif n<0x800 then
5815     return char(
5816      0xC0+rshift(n,6),
5817      0x80+(n%0x40)
5818     )
5819    elseif n<0x10000 then
5820     return char(
5821      0xE0+rshift(n,12),
5822      0x80+(rshift(n,6)%0x40),
5823      0x80+(n%0x40)
5824     )
5825    elseif n<0x200000 then
5826     return char(
5827      0xF0+rshift(n,18),
5828      0x80+(rshift(n,12)%0x40),
5829      0x80+(rshift(n,6)%0x40),
5830      0x80+(n%0x40)
5831     )
5832    else
5833     return ""
5834    end
5835   end
5836  else
5837   local floor=math.floor
5838   function utf.char(n)
5839    if n<0x80 then
5840     return char(n)
5841    elseif n<0x800 then
5842     return char(
5843      0xC0+floor(n/0x40),
5844      0x80+(n%0x40)
5845     )
5846    elseif n<0x10000 then
5847     return char(
5848      0xE0+floor(n/0x1000),
5849      0x80+(floor(n/0x40)%0x40),
5850      0x80+(n%0x40)
5851     )
5852    elseif n<0x200000 then
5853     return char(
5854      0xF0+floor(n/0x40000),
5855      0x80+(floor(n/0x1000)%0x40),
5856      0x80+(floor(n/0x40)%0x40),
5857      0x80+(n%0x40)
5858     )
5859    else
5860     return ""
5861    end
5862   end
5863  end
5864 end
5865end
5866if not utf.byte then
5867 utf.byte=string.utfvalue or (utf8 and utf8.codepoint)
5868 if not utf.byte then
5869  function utf.byte(c)
5870   return lpegmatch(p_utf8byte,c)
5871  end
5872 end
5873end
5874local utfchar,utfbyte=utf.char,utf.byte
5875function utf.filetype(data)
5876 return data and lpegmatch(p_utftype,data) or "unknown"
5877end
5878local toentities=Cs (
5879 (
5880  patterns.utf8one+(
5881    patterns.utf8two+patterns.utf8three+patterns.utf8four
5882   )/function(s) local b=utfbyte(s) if b<127 then return s else return format("&#%X;",b) end end
5883 )^0
5884)
5885patterns.toentities=toentities
5886function utf.toentities(str)
5887 return lpegmatch(toentities,str)
5888end
5889local one=P(1)
5890local two=C(1)*C(1)
5891local four=C(R(utfchar(0xD8),utfchar(0xFF)))*C(1)*C(1)*C(1)
5892local pattern=P("\254\255")*Cs((
5893     four/function(a,b,c,d)
5894        local ab=0xFF*byte(a)+byte(b)
5895        local cd=0xFF*byte(c)+byte(d)
5896        return utfchar((ab-0xD800)*0x400+(cd-0xDC00)+0x10000)
5897       end+two/function(a,b)
5898        return utfchar(byte(a)*256+byte(b))
5899       end+one
5900    )^1 )+P("\255\254")*Cs((
5901     four/function(b,a,d,c)
5902        local ab=0xFF*byte(a)+byte(b)
5903        local cd=0xFF*byte(c)+byte(d)
5904        return utfchar((ab-0xD800)*0x400+(cd-0xDC00)+0x10000)
5905       end+two/function(b,a)
5906        return utfchar(byte(a)*256+byte(b))
5907       end+one
5908    )^1 )
5909function string.toutf(s) 
5910 return lpegmatch(pattern,s) or s 
5911end
5912local validatedutf=Cs (
5913 (
5914  patterns.utf8one+patterns.utf8two+patterns.utf8three+patterns.utf8four+P(1)/"�"
5915 )^0
5916)
5917patterns.validatedutf=validatedutf
5918function utf.is_valid(str)
5919 return type(str)=="string" and lpegmatch(validatedutf,str) or false
5920end
5921if not utf.len then
5922 utf.len=string.utflength or (utf8 and utf8.len)
5923 if not utf.len then
5924  local n,f=0,1
5925  local utfcharcounter=patterns.utfbom^-1*Cmt (
5926   Cc(1)*patterns.utf8one^1+Cc(2)*patterns.utf8two^1+Cc(3)*patterns.utf8three^1+Cc(4)*patterns.utf8four^1,
5927   function(_,t,d) 
5928    n=n+(t-f)/d
5929    f=t
5930    return true
5931   end
5932  )^0
5933  function utf.len(str)
5934   n,f=0,1
5935   lpegmatch(utfcharcounter,str or "")
5936   return n
5937  end
5938 end
5939end
5940utf.length=utf.len
5941if not utf.sub then
5942 local utflength=utf.length
5943 local b,e,n,first,last=0,0,0,0,0
5944 local function slide_zero(s,p)
5945  n=n+1
5946  if n>=last then
5947   e=p-1
5948  else
5949   return p
5950  end
5951 end
5952 local function slide_one(s,p)
5953  n=n+1
5954  if n==first then
5955   b=p
5956  end
5957  if n>=last then
5958   e=p-1
5959  else
5960   return p
5961  end
5962 end
5963 local function slide_two(s,p)
5964  n=n+1
5965  if n==first then
5966   b=p
5967  else
5968   return true
5969  end
5970 end
5971 local pattern_zero=Cmt(p_utf8character,slide_zero)^0
5972 local pattern_one=Cmt(p_utf8character,slide_one )^0
5973 local pattern_two=Cmt(p_utf8character,slide_two )^0
5974 local pattern_first=C(p_utf8character)
5975 function utf.sub(str,start,stop)
5976  if not start then
5977   return str
5978  end
5979  if start==0 then
5980   start=1
5981  end
5982  if not stop then
5983   if start<0 then
5984    local l=utflength(str) 
5985    start=l+start
5986   else
5987    start=start-1
5988   end
5989   b,n,first=0,0,start
5990   lpegmatch(pattern_two,str)
5991   if n>=first then
5992    return sub(str,b)
5993   else
5994    return ""
5995   end
5996  end
5997  if start<0 or stop<0 then
5998   local l=utf.length(str)
5999   if start<0 then
6000    start=l+start
6001    if start<=0 then
6002     start=1
6003    else
6004     start=start+1
6005    end
6006   end
6007   if stop<0 then
6008    stop=l+stop
6009    if stop==0 then
6010     stop=1
6011    else
6012     stop=stop+1
6013    end
6014   end
6015  end
6016  if start==1 and stop==1 then
6017   return lpegmatch(pattern_first,str) or ""
6018  elseif start>stop then
6019   return ""
6020  elseif start>1 then
6021   b,e,n,first,last=0,0,0,start-1,stop
6022   lpegmatch(pattern_one,str)
6023   if n>=first and e==0 then
6024    e=#str
6025   end
6026   return sub(str,b,e)
6027  else
6028   b,e,n,last=1,0,0,stop
6029   lpegmatch(pattern_zero,str)
6030   if e==0 then
6031    e=#str
6032   end
6033   return sub(str,b,e)
6034  end
6035 end
6036end
6037function utf.remapper(mapping,option,action) 
6038 local variant=type(mapping)
6039 if variant=="table" then
6040  action=action or mapping
6041  if option=="dynamic" then
6042   local pattern=false
6043   table.setmetatablenewindex(mapping,function(t,k,v) rawset(t,k,v) pattern=false end)
6044   return function(str)
6045    if not str or str=="" then
6046     return ""
6047    else
6048     if not pattern then
6049      pattern=Cs((tabletopattern(mapping)/action+p_utf8character)^0)
6050     end
6051     return lpegmatch(pattern,str)
6052    end
6053   end
6054  elseif option=="pattern" then
6055   return Cs((tabletopattern(mapping)/action+p_utf8character)^0)
6056  else
6057   local pattern=Cs((tabletopattern(mapping)/action+p_utf8character)^0)
6058   return function(str)
6059    if not str or str=="" then
6060     return ""
6061    else
6062     return lpegmatch(pattern,str)
6063    end
6064   end,pattern
6065  end
6066 elseif variant=="function" then
6067  if option=="pattern" then
6068   return Cs((p_utf8character/mapping+p_utf8character)^0)
6069  else
6070   local pattern=Cs((p_utf8character/mapping+p_utf8character)^0)
6071   return function(str)
6072    if not str or str=="" then
6073     return ""
6074    else
6075     return lpegmatch(pattern,str)
6076    end
6077   end,pattern
6078  end
6079 else
6080  return function(str)
6081   return str or ""
6082  end
6083 end
6084end
6085function utf.replacer(t) 
6086 local r=replacer(t,false,false,true)
6087 return function(str)
6088  return lpegmatch(r,str)
6089 end
6090end
6091function utf.subtituter(t) 
6092 local f=finder  (t)
6093 local r=replacer(t,false,false,true)
6094 return function(str)
6095  local i=lpegmatch(f,str)
6096  if not i then
6097   return str
6098  elseif i>#str then
6099   return str
6100  else
6101   return lpegmatch(r,str)
6102  end
6103 end
6104end
6105local utflinesplitter=p_utfbom^-1*lpeg.tsplitat(p_newline)
6106local utfcharsplitter_ows=p_utfbom^-1*Ct(C(p_utf8character)^0)
6107local utfcharsplitter_iws=p_utfbom^-1*Ct((p_whitespace^1+C(p_utf8character))^0)
6108local utfcharsplitter_raw=Ct(C(p_utf8character)^0)
6109patterns.utflinesplitter=utflinesplitter
6110function utf.splitlines(str)
6111 return lpegmatch(utflinesplitter,str or "")
6112end
6113function utf.split(str,ignorewhitespace) 
6114 if ignorewhitespace then
6115  return lpegmatch(utfcharsplitter_iws,str or "")
6116 else
6117  return lpegmatch(utfcharsplitter_ows,str or "")
6118 end
6119end
6120function utf.totable(str) 
6121 return lpegmatch(utfcharsplitter_raw,str)
6122end
6123function utf.magic(f) 
6124 local str=f:read(4) or ""
6125 local off=lpegmatch(p_utfoffset,str)
6126 if off<4 then
6127  f:seek('set',off)
6128 end
6129 return lpegmatch(p_utftype,str)
6130end
6131local utf16_to_utf8_be,utf16_to_utf8_le
6132local utf32_to_utf8_be,utf32_to_utf8_le
6133local utf_16_be_getbom=patterns.utfbom_16_be^-1
6134local utf_16_le_getbom=patterns.utfbom_16_le^-1
6135local utf_32_be_getbom=patterns.utfbom_32_be^-1
6136local utf_32_le_getbom=patterns.utfbom_32_le^-1
6137local utf_16_be_linesplitter=utf_16_be_getbom*lpeg.tsplitat(patterns.utf_16_be_nl)
6138local utf_16_le_linesplitter=utf_16_le_getbom*lpeg.tsplitat(patterns.utf_16_le_nl)
6139local utf_32_be_linesplitter=utf_32_be_getbom*lpeg.tsplitat(patterns.utf_32_be_nl)
6140local utf_32_le_linesplitter=utf_32_le_getbom*lpeg.tsplitat(patterns.utf_32_le_nl)
6141local more=0
6142local p_utf16_to_utf8_be=C(1)*C(1)/function(left,right)
6143 local now=256*byte(left)+byte(right)
6144 if more>0 then
6145  now=(more-0xD800)*0x400+(now-0xDC00)+0x10000
6146  more=0
6147  return utfchar(now)
6148 elseif now>=0xD800 and now<=0xDBFF then
6149  more=now
6150  return "" 
6151 else
6152  return utfchar(now)
6153 end
6154end
6155local p_utf16_to_utf8_le=C(1)*C(1)/function(right,left)
6156 local now=256*byte(left)+byte(right)
6157 if more>0 then
6158  now=(more-0xD800)*0x400+(now-0xDC00)+0x10000
6159  more=0
6160  return utfchar(now)
6161 elseif now>=0xD800 and now<=0xDBFF then
6162  more=now
6163  return "" 
6164 else
6165  return utfchar(now)
6166 end
6167end
6168local p_utf32_to_utf8_be=C(1)*C(1)*C(1)*C(1)/function(a,b,c,d)
6169 return utfchar(256*256*256*byte(a)+256*256*byte(b)+256*byte(c)+byte(d))
6170end
6171local p_utf32_to_utf8_le=C(1)*C(1)*C(1)*C(1)/function(a,b,c,d)
6172 return utfchar(256*256*256*byte(d)+256*256*byte(c)+256*byte(b)+byte(a))
6173end
6174p_utf16_to_utf8_be=P(true)/function() more=0 end*utf_16_be_getbom*Cs(p_utf16_to_utf8_be^0)
6175p_utf16_to_utf8_le=P(true)/function() more=0 end*utf_16_le_getbom*Cs(p_utf16_to_utf8_le^0)
6176p_utf32_to_utf8_be=P(true)/function() more=0 end*utf_32_be_getbom*Cs(p_utf32_to_utf8_be^0)
6177p_utf32_to_utf8_le=P(true)/function() more=0 end*utf_32_le_getbom*Cs(p_utf32_to_utf8_le^0)
6178patterns.utf16_to_utf8_be=p_utf16_to_utf8_be
6179patterns.utf16_to_utf8_le=p_utf16_to_utf8_le
6180patterns.utf32_to_utf8_be=p_utf32_to_utf8_be
6181patterns.utf32_to_utf8_le=p_utf32_to_utf8_le
6182utf16_to_utf8_be=function(s)
6183 if s and s~="" then
6184  return lpegmatch(p_utf16_to_utf8_be,s)
6185 else
6186  return s
6187 end
6188end
6189local utf16_to_utf8_be_t=function(t)
6190 if not t then
6191  return nil
6192 elseif type(t)=="string" then
6193  t=lpegmatch(utf_16_be_linesplitter,t)
6194 end
6195 for i=1,#t do
6196  local s=t[i]
6197  if s~="" then
6198   t[i]=lpegmatch(p_utf16_to_utf8_be,s)
6199  end
6200 end
6201 return t
6202end
6203utf16_to_utf8_le=function(s)
6204 if s and s~="" then
6205  return lpegmatch(p_utf16_to_utf8_le,s)
6206 else
6207  return s
6208 end
6209end
6210local utf16_to_utf8_le_t=function(t)
6211 if not t then
6212  return nil
6213 elseif type(t)=="string" then
6214  t=lpegmatch(utf_16_le_linesplitter,t)
6215 end
6216 for i=1,#t do
6217  local s=t[i]
6218  if s~="" then
6219   t[i]=lpegmatch(p_utf16_to_utf8_le,s)
6220  end
6221 end
6222 return t
6223end
6224utf32_to_utf8_be=function(s)
6225 if s and s~="" then
6226  return lpegmatch(p_utf32_to_utf8_be,s)
6227 else
6228  return s
6229 end
6230end
6231local utf32_to_utf8_be_t=function(t)
6232 if not t then
6233  return nil
6234 elseif type(t)=="string" then
6235  t=lpegmatch(utf_32_be_linesplitter,t)
6236 end
6237 for i=1,#t do
6238  local s=t[i]
6239  if s~="" then
6240   t[i]=lpegmatch(p_utf32_to_utf8_be,s)
6241  end
6242 end
6243 return t
6244end
6245utf32_to_utf8_le=function(s)
6246 if s and s~="" then
6247  return lpegmatch(p_utf32_to_utf8_le,s)
6248 else
6249  return s
6250 end
6251end
6252local utf32_to_utf8_le_t=function(t)
6253 if not t then
6254  return nil
6255 elseif type(t)=="string" then
6256  t=lpegmatch(utf_32_le_linesplitter,t)
6257 end
6258 for i=1,#t do
6259  local s=t[i]
6260  if s~="" then
6261   t[i]=lpegmatch(p_utf32_to_utf8_le,s)
6262  end
6263 end
6264 return t
6265end
6266utf.utf16_to_utf8_le_t=utf16_to_utf8_le_t
6267utf.utf16_to_utf8_be_t=utf16_to_utf8_be_t
6268utf.utf32_to_utf8_le_t=utf32_to_utf8_le_t
6269utf.utf32_to_utf8_be_t=utf32_to_utf8_be_t
6270utf.utf16_to_utf8_le=utf16_to_utf8_le
6271utf.utf16_to_utf8_be=utf16_to_utf8_be
6272utf.utf32_to_utf8_le=utf32_to_utf8_le
6273utf.utf32_to_utf8_be=utf32_to_utf8_be
6274function utf.utf8_to_utf8_t(t)
6275 return type(t)=="string" and lpegmatch(utflinesplitter,t) or t
6276end
6277function utf.utf16_to_utf8_t(t,endian)
6278 return endian and utf16_to_utf8_be_t(t) or utf16_to_utf8_le_t(t) or t
6279end
6280function utf.utf32_to_utf8_t(t,endian)
6281 return endian and utf32_to_utf8_be_t(t) or utf32_to_utf8_le_t(t) or t
6282end
6283if bit32 then
6284 local rshift=bit32.rshift
6285 local function little(b)
6286  if b<0x10000 then
6287   return char(b%256,rshift(b,8))
6288  else
6289   b=b-0x10000
6290   local b1=rshift(b,10)+0xD800
6291   local b2=b%1024+0xDC00
6292   return char(b1%256,rshift(b1,8),b2%256,rshift(b2,8))
6293  end
6294 end
6295 local function big(b)
6296  if b<0x10000 then
6297   return char(rshift(b,8),b%256)
6298  else
6299   b=b-0x10000
6300   local b1=rshift(b,10)+0xD800
6301   local b2=b%1024+0xDC00
6302   return char(rshift(b1,8),b1%256,rshift(b2,8),b2%256)
6303  end
6304 end
6305 local l_remap=Cs((p_utf8byte/little+P(1)/"")^0)
6306 local b_remap=Cs((p_utf8byte/big+P(1)/"")^0)
6307 local function utf8_to_utf16_be(str,nobom)
6308  if nobom then
6309   return lpegmatch(b_remap,str)
6310  else
6311   return char(254,255)..lpegmatch(b_remap,str)
6312  end
6313 end
6314 local function utf8_to_utf16_le(str,nobom)
6315  if nobom then
6316   return lpegmatch(l_remap,str)
6317  else
6318   return char(255,254)..lpegmatch(l_remap,str)
6319  end
6320 end
6321 utf.utf8_to_utf16_be=utf8_to_utf16_be
6322 utf.utf8_to_utf16_le=utf8_to_utf16_le
6323 function utf.utf8_to_utf16(str,littleendian,nobom)
6324  if littleendian then
6325   return utf8_to_utf16_le(str,nobom)
6326  else
6327   return utf8_to_utf16_be(str,nobom)
6328  end
6329 end
6330end
6331local pattern=Cs (
6332 (p_utf8byte/function(unicode    ) return format("0x%04X",unicode) end)*(p_utf8byte*Carg(1)/function(unicode,separator) return format("%s0x%04X",separator,unicode) end)^0
6333)
6334function utf.tocodes(str,separator)
6335 return lpegmatch(pattern,str,1,separator or " ")
6336end
6337function utf.ustring(s)
6338 return format("U+%05X",type(s)=="number" and s or utfbyte(s))
6339end
6340function utf.xstring(s)
6341 return format("0x%05X",type(s)=="number" and s or utfbyte(s))
6342end
6343function utf.toeight(str)
6344 if not str or str=="" then
6345  return nil
6346 end
6347 local utftype=lpegmatch(p_utfstricttype,str)
6348 if utftype=="utf-8" then
6349  return sub(str,4)      
6350 elseif utftype=="utf-16-be" then
6351  return utf16_to_utf8_be(str) 
6352 elseif utftype=="utf-16-le" then
6353  return utf16_to_utf8_le(str) 
6354 else
6355  return str
6356 end
6357end
6358do
6359 local p_nany=p_utf8character/""
6360 local cache={}
6361 function utf.count(str,what)
6362  if type(what)=="string" then
6363   local p=cache[what]
6364   if not p then
6365    p=Cs((P(what)/" "+p_nany)^0)
6366    cache[p]=p
6367   end
6368   return #lpegmatch(p,str)
6369  else 
6370   return #lpegmatch(Cs((P(what)/" "+p_nany)^0),str)
6371  end
6372 end
6373end
6374if not string.utfvalues then
6375 local find=string.find
6376 local dummy=function()
6377 end
6378 function string.utfvalues(str)
6379  local n=#str
6380  if n==0 then
6381   return dummy
6382  elseif n==1 then
6383   return function() return utfbyte(str) end
6384  else
6385   local p=1
6386   return function()
6387     local b,e=find(str,".[\128-\191]*",p)
6388     if b then
6389      p=e+1
6390      return utfbyte(sub(str,b,e))
6391     end
6392   end
6393  end
6394 end
6395end
6396utf.values=string.utfvalues
6397function utf.chrlen(u) 
6398 return
6399  (u<0x80 and 1) or
6400  (u<0xE0 and 2) or
6401  (u<0xF0 and 3) or
6402  (u<0xF8 and 4) or
6403  (u<0xFC and 5) or
6404  (u<0xFE and 6) or 0
6405end
6406if bit32 then
6407 local extract=bit32.extract
6408 local char=string.char
6409 function utf.toutf32string(n)
6410  if n<=0xFF then
6411   return
6412    char(n).."\000\000\000"
6413  elseif n<=0xFFFF then
6414   return
6415    char(extract(n,0,8))..char(extract(n,8,8)).."\000\000"
6416  elseif n<=0xFFFFFF then
6417   return
6418    char(extract(n,0,8))..char(extract(n,8,8))..char(extract(n,16,8)).."\000"
6419  else
6420   return
6421    char(extract(n,0,8))..char(extract(n,8,8))..char(extract(n,16,8))..char(extract(n,24,8))
6422  end
6423 end
6424end
6425local len=utf.len
6426local rep=rep
6427function string.utfpadd(s,n)
6428 if n and n~=0 then
6429  local l=len(s)
6430  if n>0 then
6431   local d=n-l
6432   if d>0 then
6433    return rep(c or " ",d)..s
6434   end
6435  else
6436   local d=- n-l
6437   if d>0 then
6438    return s..rep(c or " ",d)
6439   end
6440  end
6441 end
6442 return s
6443end
6444do
6445 local utfcharacters=utf.characters or string.utfcharacters
6446 local utfchar=utf.char    or string.utfcharacter
6447 lpeg.UP=P
6448 if utfcharacters then
6449  function lpeg.US(str)
6450   local p=P(false)
6451   for uc in utfcharacters(str) do
6452    p=p+P(uc)
6453   end
6454   return p
6455  end
6456 else
6457  function lpeg.US(str)
6458   local p=P(false)
6459   local f=function(uc)
6460    p=p+P(uc)
6461   end
6462   lpegmatch((p_utf8char/f)^0,str)
6463   return p
6464  end
6465 end
6466 local range=p_utf8byte*p_utf8byte+Cc(false) 
6467 function lpeg.UR(str,more)
6468  local first,last
6469  if type(str)=="number" then
6470   first=str
6471   last=more or first
6472  else
6473   first,last=lpegmatch(range,str)
6474   if not last then
6475    return P(str)
6476   end
6477  end
6478  if first==last then
6479   return P(str)
6480  end
6481  if not utfchar then
6482   utfchar=utf.char 
6483  end
6484  if utfchar and (last-first<8) then 
6485   local p=P(false)
6486   for i=first,last do
6487    p=p+P(utfchar(i))
6488   end
6489   return p 
6490  else
6491   local f=function(b)
6492    return b>=first and b<=last
6493   end
6494   return p_utf8byte/f 
6495  end
6496 end
6497end
6498
6499
6500end -- of closure
6501
6502do -- create closure to overcome 200 locals limit
6503
6504package.loaded["l-math"] = package.loaded["l-math"] or true
6505
6506-- original size: 2679, stripped down to: 1909
6507
6508if not modules then modules={} end modules ['l-math']={
6509 version=1.001,
6510 comment="companion to luat-lib.mkiv",
6511 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
6512 copyright="PRAGMA ADE / ConTeXt Development Team",
6513 license="see context related readme files"
6514}
6515if not math.ceiling then
6516 math.ceiling=math.ceil
6517end
6518if not math.round then
6519 if xmath then
6520  math.round=xmath.round
6521 else
6522  local floor=math.floor
6523  function math.round(x)
6524   return x<0 and -floor(-x+0.5) or floor(x+0.5)
6525  end
6526 end
6527end
6528if not math.div then
6529 local floor=math.floor
6530 function math.div(n,m) return floor(n/m) end
6531end
6532if not math.mod then
6533 function math.mod(n,m) return n%m end
6534end
6535if not math.sind then
6536 local sin,cos,tan=math.sin,math.cos,math.tan
6537 local pipi=2*math.pi/360
6538 function math.sind(d) return sin(d*pipi) end
6539 function math.cosd(d) return cos(d*pipi) end
6540 function math.tand(d) return tan(d*pipi) end
6541end
6542if not math.odd then
6543 function math.odd (n) return n%2~=0 end
6544 function math.even(n) return n%2==0 end
6545end
6546if not math.cosh then
6547 local exp=math.exp
6548 function math.cosh(x)
6549  local xx=exp(x)
6550  return (xx+1/xx)/2
6551 end
6552 function math.sinh(x)
6553  local xx=exp(x)
6554  return (xx-1/xx)/2
6555 end
6556 function math.tanh(x)
6557  local xx=exp(x)
6558  return (xx-1/xx)/(xx+1/xx)
6559 end
6560end
6561if not math.pow then
6562 function math.pow(x,y)
6563  return x^y
6564 end
6565end
6566if not math.atan2 then
6567 math.atan2=math.atan
6568end
6569if not math.ldexp then
6570 function math.ldexp(x,e)
6571  return x*2.0^e
6572 end
6573end
6574if not math.log10 then
6575 local log=math.log
6576 function math.log10(x)
6577  return log(x,10)
6578 end
6579end
6580if not math.type then
6581 function math.type()
6582  return "float"
6583 end
6584end
6585if not math.tointeger then
6586 math.mininteger=-0x4FFFFFFFFFFF
6587 math.maxinteger=0x4FFFFFFFFFFF
6588 local floor=math.floor
6589 function math.tointeger(n)
6590  local f=floor(n)
6591  return f==n and f or nil
6592 end
6593end
6594if not math.ult then
6595 local floor=math.floor
6596 function math.ult(m,n)
6597  return floor(m)<floor(n) 
6598 end
6599end
6600
6601
6602end -- of closure
6603
6604do -- create closure to overcome 200 locals limit
6605
6606package.loaded["util-str"] = package.loaded["util-str"] or true
6607
6608-- original size: 46975, stripped down to: 24530
6609
6610if not modules then modules={} end modules ['util-str']={
6611 version=1.001,
6612 comment="companion to luat-lib.mkiv",
6613 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
6614 copyright="PRAGMA ADE / ConTeXt Development Team",
6615 license="see context related readme files"
6616}
6617utilities=utilities or {}
6618utilities.strings=utilities.strings or {}
6619local strings=utilities.strings
6620local format,gsub,rep,sub,find,char=string.format,string.gsub,string.rep,string.sub,string.find,string.char
6621local load,dump=load,string.dump
6622local tonumber,type,tostring,next,setmetatable=tonumber,type,tostring,next,setmetatable
6623local unpack,concat=table.unpack,table.concat
6624local P,V,C,S,R,Ct,Cs,Cp,Carg,Cc=lpeg.P,lpeg.V,lpeg.C,lpeg.S,lpeg.R,lpeg.Ct,lpeg.Cs,lpeg.Cp,lpeg.Carg,lpeg.Cc
6625local patterns,lpegmatch=lpeg.patterns,lpeg.match
6626local tsplitat=lpeg.tsplitat
6627local utfchar,utfbyte,utflen=utf.char,utf.byte,utf.len
6628local loadstripped=function(str,shortcuts)
6629 if shortcuts then
6630  return load(dump(load(str),true),nil,nil,shortcuts)
6631 else
6632  return load(dump(load(str),true))
6633 end
6634end
6635if not number then number={} end 
6636local stripzero=patterns.stripzero
6637local stripzeros=patterns.stripzeros
6638local newline=patterns.newline
6639local endofstring=patterns.endofstring
6640local anything=patterns.anything
6641local whitespace=patterns.whitespace
6642local space=patterns.space
6643local spacer=patterns.spacer
6644local spaceortab=patterns.spaceortab
6645local digit=patterns.digit
6646local sign=patterns.sign
6647local period=patterns.period
6648local ptf=1/65536
6649local bpf=(7200/7227)/65536
6650local function points(n)
6651 if n==0 then
6652  return "0pt"
6653 end
6654 n=tonumber(n)
6655 if not n or n==0 then
6656  return "0pt"
6657 end
6658 n=n*ptf
6659 if n%1==0 then
6660  return format("%ipt",n)
6661 else
6662  return lpegmatch(stripzeros,format("%.5fpt",n)) 
6663 end
6664end
6665local function nupoints(n)
6666 if n==0 then
6667  return "0"
6668 end
6669 n=tonumber(n)
6670 if not n or n==0 then
6671  return "0"
6672 end
6673 n=n*ptf
6674 if n%1==0 then
6675  return format("%i",n)
6676 else
6677  return format("%.5f",n) 
6678 end
6679end
6680local function basepoints(n)
6681 if n==0 then
6682  return "0bp"
6683 end
6684 n=tonumber(n)
6685 if not n or n==0 then
6686  return "0bp"
6687 end
6688 n=n*bpf
6689 if n%1==0 then
6690  return format("%ibp",n)
6691 else
6692  return lpegmatch(stripzeros,format("%.5fbp",n)) 
6693 end
6694end
6695local function nubasepoints(n)
6696 if n==0 then
6697  return "0"
6698 end
6699 n=tonumber(n)
6700 if not n or n==0 then
6701  return "0"
6702 end
6703 n=n*bpf
6704 if n%1==0 then
6705  return format("%i",n)
6706 else
6707  return format("%.5f",n) 
6708 end
6709end
6710number.points=points
6711number.nupoints=nupoints
6712number.basepoints=basepoints
6713number.nubasepoints=nubasepoints
6714local rubish=spaceortab^0*newline
6715local anyrubish=spaceortab+newline
6716local stripped=(spaceortab^1/"")*newline
6717local leading=rubish^0/""
6718local trailing=(anyrubish^1*endofstring)/""
6719local redundant=rubish^3/"\n"
6720local pattern=Cs(leading*(trailing+redundant+stripped+anything)^0)
6721function strings.collapsecrlf(str)
6722 return lpegmatch(pattern,str)
6723end
6724local repeaters={} 
6725function strings.newrepeater(str,offset)
6726 offset=offset or 0
6727 local s=repeaters[str]
6728 if not s then
6729  s={}
6730  repeaters[str]=s
6731 end
6732 local t=s[offset]
6733 if t then
6734  return t
6735 end
6736 t={}
6737 setmetatable(t,{ __index=function(t,k)
6738  if not k then
6739   return ""
6740  end
6741  local n=k+offset
6742  local s=n>0 and rep(str,n) or ""
6743  t[k]=s
6744  return s
6745 end })
6746 s[offset]=t
6747 return t
6748end
6749local extra,tab,start=0,0,4,0
6750local nspaces=strings.newrepeater(" ")
6751string.nspaces=nspaces
6752local pattern=Carg(1)/function(t)
6753  extra,tab,start=0,t or 7,1
6754 end*Cs((
6755   Cp()*patterns.tab/function(position)
6756    local current=(position-start+1)+extra
6757    local spaces=tab-(current-1)%tab
6758    if spaces>0 then
6759     extra=extra+spaces-1
6760     return nspaces[spaces] 
6761    else
6762     return ""
6763    end
6764   end+newline*Cp()/function(position)
6765    extra,start=0,position
6766   end+anything
6767  )^1)
6768function strings.tabtospace(str,tab)
6769 return lpegmatch(pattern,str,1,tab or 7)
6770end
6771function string.utfpadding(s,n)
6772 if not n or n==0 then
6773  return ""
6774 end
6775 local l=utflen(s)
6776 if n>0 then
6777  return nspaces[n-l]
6778 else
6779  return nspaces[-n-l]
6780 end
6781end
6782local optionalspace=spacer^0
6783local nospace=optionalspace/""
6784local endofline=nospace*newline
6785local stripend=(whitespace^1*endofstring)/""
6786local normalline=(nospace*((1-optionalspace*(newline+endofstring))^1)*nospace)
6787local stripempty=endofline^1/""
6788local normalempty=endofline^1
6789local singleempty=endofline*(endofline^0/"")
6790local doubleempty=endofline*endofline^-1*(endofline^0/"")
6791local stripstart=stripempty^0
6792local intospace=whitespace^1/" "
6793local noleading=whitespace^1/""
6794local notrailing=noleading*endofstring
6795local p_prune_normal=Cs (stripstart*(stripend+normalline+normalempty )^0 )
6796local p_prune_collapse=Cs (stripstart*(stripend+normalline+doubleempty )^0 )
6797local p_prune_noempty=Cs (stripstart*(stripend+normalline+singleempty )^0 )
6798local p_prune_intospace=Cs (noleading*(notrailing+intospace+1     )^0 )
6799local p_retain_normal=Cs ((normalline+normalempty )^0 )
6800local p_retain_collapse=Cs ((normalline+doubleempty )^0 )
6801local p_retain_noempty=Cs ((normalline+singleempty )^0 )
6802local p_collapse_all=Cs (stripstart*(stripend+((whitespace+newline)^1/" ")+1)^0 )
6803local striplinepatterns={
6804 ["prune"]=p_prune_normal,
6805 ["prune and collapse"]=p_prune_collapse,
6806 ["prune and no empty"]=p_prune_noempty,
6807 ["prune and to space"]=p_prune_intospace,
6808 ["retain"]=p_retain_normal,
6809 ["retain and collapse"]=p_retain_collapse,
6810 ["retain and no empty"]=p_retain_noempty,
6811 ["collapse all"]=p_collapse_all,
6812 ["collapse"]=patterns.collapser,
6813}
6814setmetatable(striplinepatterns,{ __index=function(t,k) return p_prune_collapse end })
6815strings.striplinepatterns=striplinepatterns
6816function strings.striplines(str,how)
6817 return str and lpegmatch(striplinepatterns[how],str) or str
6818end
6819function strings.collapse(str) 
6820 return str and lpegmatch(p_prune_intospace,str) or str
6821end
6822strings.striplong=strings.striplines
6823function strings.nice(str)
6824 str=gsub(str,"[:%-+_]+"," ") 
6825 return str
6826end
6827local n=0
6828local sequenced=table.sequenced
6829function string.autodouble(s,sep)
6830 if s==nil then
6831  return '""'
6832 end
6833 local t=type(s)
6834 if t=="number" then
6835  return tostring(s) 
6836 end
6837 if t=="table" then
6838  return ('"'..sequenced(s,sep or ",")..'"')
6839 end
6840 return ('"'..tostring(s)..'"')
6841end
6842function string.autosingle(s,sep)
6843 if s==nil then
6844  return "''"
6845 end
6846 local t=type(s)
6847 if t=="number" then
6848  return tostring(s) 
6849 end
6850 if t=="table" then
6851  return ("'"..sequenced(s,sep or ",").."'")
6852 end
6853 return ("'"..tostring(s).."'")
6854end
6855local tracedchars={ [0]=
6856 "[null]","[soh]","[stx]","[etx]","[eot]","[enq]","[ack]","[bel]",
6857 "[bs]","[ht]","[lf]","[vt]","[ff]","[cr]","[so]","[si]",
6858 "[dle]","[dc1]","[dc2]","[dc3]","[dc4]","[nak]","[syn]","[etb]",
6859 "[can]","[em]","[sub]","[esc]","[fs]","[gs]","[rs]","[us]",
6860 "[space]",
6861}
6862string.tracedchars=tracedchars
6863strings.tracers=tracedchars
6864function string.tracedchar(b)
6865 if type(b)=="number" then
6866  return tracedchars[b] or (utfchar(b).." (U+"..format("%05X",b)..")")
6867 else
6868  local c=utfbyte(b)
6869  return tracedchars[c] or (b.." (U+"..(c and format("%05X",c) or "?????")..")")
6870 end
6871end
6872function number.signed(i)
6873 if i>0 then
6874  return "+",i
6875 else
6876  return "-",-i
6877 end
6878end
6879local two=digit*digit
6880local three=two*digit
6881local prefix=(Carg(1)*three)^1
6882local splitter=Cs (
6883 (((1-(three^1*period))^1+C(three))*prefix+C((1-period)^1))*(anything/""*Carg(2))*C(2)
6884)
6885local splitter3=Cs (
6886 three*prefix*endofstring+two*prefix*endofstring+digit*prefix*endofstring+three+two+digit
6887)
6888patterns.formattednumber=splitter
6889function number.formatted(n,sep1,sep2)
6890 if sep1==false then
6891  if type(n)=="number" then
6892   n=tostring(n)
6893  end
6894  return lpegmatch(splitter3,n,1,sep2 or ".")
6895 else
6896  if type(n)=="number" then
6897   n=format("%0.2f",n)
6898  end
6899  if sep1==true then
6900   return lpegmatch(splitter,n,1,".",",")
6901  elseif sep1=="." then
6902   return lpegmatch(splitter,n,1,sep1,sep2 or ",")
6903  elseif sep1=="," then
6904   return lpegmatch(splitter,n,1,sep1,sep2 or ".")
6905  else
6906   return lpegmatch(splitter,n,1,sep1 or ",",sep2 or ".")
6907  end
6908 end
6909end
6910local p=Cs(
6911  P("-")^0*(P("0")^1/"")^0*(1-period)^0*(period*P("0")^1*endofstring/""+period^0)*P(1-P("0")^1*endofstring)^0
6912 )
6913function number.compactfloat(n,fmt)
6914 if n==0 then
6915  return "0"
6916 elseif n==1 then
6917  return "1"
6918 end
6919 n=lpegmatch(p,format(fmt or "%0.3f",n))
6920 if n=="." or n=="" or n=="-" then
6921  return "0"
6922 end
6923 return n
6924end
6925local zero=P("0")^1/""
6926local plus=P("+")/""
6927local minus=P("-")
6928local separator=period
6929local trailing=zero^1*#S("eE")
6930local exponent=(S("eE")*(plus+Cs((minus*zero^0*endofstring)/"")+minus)*zero^0*(endofstring*Cc("0")+anything^1))
6931local pattern_a=Cs(minus^0*digit^1*(separator/""*trailing+separator*(trailing+digit)^0)*exponent)
6932local pattern_b=Cs((exponent+anything)^0)
6933function number.sparseexponent(f,n)
6934 if not n then
6935  n=f
6936  f="%e"
6937 end
6938 local tn=type(n)
6939 if tn=="string" then 
6940  local m=tonumber(n)
6941  if m then
6942   return lpegmatch((f=="%e" or f=="%E") and pattern_a or pattern_b,format(f,m))
6943  end
6944 elseif tn=="number" then
6945  return lpegmatch((f=="%e" or f=="%E") and pattern_a or pattern_b,format(f,n))
6946 end
6947 return tostring(n)
6948end
6949local hf={}
6950local hs={}
6951setmetatable(hf,{ __index=function(t,k)
6952 local v="%."..k.."f"
6953 t[k]=v
6954 return v
6955end } )
6956setmetatable(hs,{ __index=function(t,k)
6957 local v="%"..k.."s"
6958 t[k]=v
6959 return v
6960end } )
6961function number.formattedfloat(n,b,a)
6962 local s=format(hf[a],n)
6963 local l=(b or 0)+(a or 0)+1
6964 if #s<l then
6965  return format(hs[l],s)
6966 else
6967  return s
6968 end
6969end
6970local template=[[
6971%s
6972%s
6973return function(%s) return %s end
6974]]
6975local pattern=Cs(Cc('"')*(
6976 (1-S('"\\\n\r'))^1+P('"')/'\\"'+P('\\')/'\\\\'+P('\n')/'\\n'+P('\r')/'\\r'
6977)^0*Cc('"'))
6978patterns.escapedquotes=pattern
6979function string.escapedquotes(s)
6980 return lpegmatch(pattern,s)
6981end
6982local pattern=(1-P("\\"))^1;pattern=Cs (
6983 pattern*((P("\\")/""*(digit^-3/function(s) return char(tonumber(s)) end))+pattern )^1
6984)
6985patterns.unescapedquotes=pattern
6986function string.unescapedquotes(s)
6987 return lpegmatch(pattern,s) or s
6988end
6989string.texnewlines=lpeg.replacer(patterns.newline,"\r",true)
6990local preamble=""
6991local environment={
6992 global=global or _G,
6993 lpeg=lpeg,
6994 type=type,
6995 tostring=tostring,
6996 tonumber=tonumber,
6997 format=string.format,
6998 concat=table.concat,
6999 signed=number.signed,
7000 points=number.points,
7001 nupoints=number.nupoints,
7002 basepoints=number.basepoints,
7003 nubasepoints=number.nubasepoints,
7004 utfchar=utf.char,
7005 utfbyte=utf.byte,
7006 lpegmatch=lpeg.match,
7007 nspaces=string.nspaces,
7008 utfpadding=string.utfpadding,
7009 tracedchar=string.tracedchar,
7010 autosingle=string.autosingle,
7011 autodouble=string.autodouble,
7012 sequenced=table.sequenced,
7013 formattednumber=number.formatted,
7014 sparseexponent=number.sparseexponent,
7015 formattedfloat=number.formattedfloat,
7016 stripzero=patterns.stripzero,
7017 stripzeros=patterns.stripzeros,
7018 escapedquotes=string.escapedquotes,
7019 FORMAT=string.f6,
7020}
7021local arguments={ "a1" } 
7022setmetatable(arguments,{ __index=function(t,k)
7023  local v=t[k-1]..",a"..k
7024  t[k]=v
7025  return v
7026 end
7027})
7028local prefix_any=C((sign+space+period+digit)^0)
7029local prefix_sub=(C((sign+digit)^0)+Cc(0))*period*(C((sign+digit)^0)+Cc(0))
7030local prefix_tab=P("{")*C((1-P("}"))^0)*P("}")+C((1-R("az","AZ","09","%%"))^0)
7031local format_s=function(f)
7032 n=n+1
7033 if f and f~="" then
7034  return format("format('%%%ss',a%s)",f,n)
7035 else 
7036  return format("(a%s or '')",n) 
7037 end
7038end
7039local format_S=function(f) 
7040 n=n+1
7041 if f and f~="" then
7042  return format("format('%%%ss',tostring(a%s))",f,n)
7043 else
7044  return format("tostring(a%s)",n)
7045 end
7046end
7047local format_right=function(f)
7048 n=n+1
7049 f=tonumber(f)
7050 if not f or f==0 then
7051  return format("(a%s or '')",n)
7052 elseif f>0 then
7053  return format("utfpadding(a%s,%i)..a%s",n,f,n)
7054 else
7055  return format("a%s..utfpadding(a%s,%i)",n,n,f)
7056 end
7057end
7058local format_left=function(f)
7059 n=n+1
7060 f=tonumber(f)
7061 if not f or f==0 then
7062  return format("(a%s or '')",n)
7063 end
7064 if f<0 then
7065  return format("utfpadding(a%s,%i)..a%s",n,-f,n)
7066 else
7067  return format("a%s..utfpadding(a%s,%i)",n,n,-f)
7068 end
7069end
7070local format_q=JITSUPPORTED and function()
7071 n=n+1
7072 return format("(a%s ~= nil and format('%%q',tostring(a%s)) or '')",n,n)
7073end or function()
7074 n=n+1
7075 return format("(a%s ~= nil and format('%%q',a%s) or '')",n,n)
7076end
7077local format_Q=function() 
7078 n=n+1
7079 return format("escapedquotes(tostring(a%s))",n)
7080end
7081local format_i=function(f)
7082 n=n+1
7083 if f and f~="" then
7084  return format("format('%%%si',a%s)",f,n)
7085 else
7086  return format("format('%%i',a%s)",n) 
7087 end
7088end
7089local format_d=format_i
7090local format_I=function(f)
7091 n=n+1
7092 return format("format('%%s%%%si',signed(a%s))",f,n)
7093end
7094local format_f=function(f)
7095 n=n+1
7096 return format("format('%%%sf',a%s)",f,n)
7097end
7098local format_F=function(f) 
7099 n=n+1
7100 if not f or f=="" then
7101  return format("(((a%s > -0.0000000005 and a%s < 0.0000000005) and '0') or format((a%s %% 1 == 0) and '%%i' or '%%.9f',a%s))",n,n,n,n)
7102 else
7103  return format("format((a%s %% 1 == 0) and '%%i' or '%%%sf',a%s)",n,f,n)
7104 end
7105end
7106local format_k=function(b,a) 
7107 n=n+1
7108 return format("formattedfloat(a%s,%s,%s)",n,b or 0,a or 0)
7109end
7110local format_g=function(f)
7111 n=n+1
7112 return format("format('%%%sg',a%s)",f,n)
7113end
7114local format_G=function(f)
7115 n=n+1
7116 return format("format('%%%sG',a%s)",f,n)
7117end
7118local format_e=function(f)
7119 n=n+1
7120 return format("format('%%%se',a%s)",f,n)
7121end
7122local format_E=function(f)
7123 n=n+1
7124 return format("format('%%%sE',a%s)",f,n)
7125end
7126local format_j=function(f)
7127 n=n+1
7128 return format("sparseexponent('%%%se',a%s)",f,n)
7129end
7130local format_J=function(f)
7131 n=n+1
7132 return format("sparseexponent('%%%sE',a%s)",f,n)
7133end
7134local format_x=function(f)
7135 n=n+1
7136 return format("format('%%%sx',a%s)",f,n)
7137end
7138local format_X=function(f)
7139 n=n+1
7140 return format("format('%%%sX',a%s)",f,n)
7141end
7142local format_o=function(f)
7143 n=n+1
7144 return format("format('%%%so',a%s)",f,n)
7145end
7146local format_c=function()
7147 n=n+1
7148 return format("utfchar(a%s)",n)
7149end
7150local format_C=function()
7151 n=n+1
7152 return format("tracedchar(a%s)",n)
7153end
7154local format_r=function(f)
7155 n=n+1
7156 return format("format('%%%s.0f',a%s)",f,n)
7157end
7158local format_h=function(f)
7159 n=n+1
7160 if f=="-" then
7161  f=sub(f,2)
7162  return format("format('%%%sx',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7163 else
7164  return format("format('0x%%%sx',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7165 end
7166end
7167local format_H=function(f)
7168 n=n+1
7169 if f=="-" then
7170  f=sub(f,2)
7171  return format("format('%%%sX',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7172 else
7173  return format("format('0x%%%sX',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7174 end
7175end
7176local format_u=function(f)
7177 n=n+1
7178 if f=="-" then
7179  f=sub(f,2)
7180  return format("format('%%%sx',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7181 else
7182  return format("format('u+%%%sx',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7183 end
7184end
7185local format_U=function(f)
7186 n=n+1
7187 if f=="-" then
7188  f=sub(f,2)
7189  return format("format('%%%sX',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7190 else
7191  return format("format('U+%%%sX',type(a%s) == 'number' and a%s or utfbyte(a%s))",f=="" and "05" or f,n,n,n)
7192 end
7193end
7194local format_p=function()
7195 n=n+1
7196 return format("points(a%s)",n)
7197end
7198local format_P=function()
7199 n=n+1
7200 return format("nupoints(a%s)",n)
7201end
7202local format_b=function()
7203 n=n+1
7204 return format("basepoints(a%s)",n)
7205end
7206local format_B=function()
7207 n=n+1
7208 return format("nubasepoints(a%s)",n)
7209end
7210local format_t=function(f)
7211 n=n+1
7212 if f and f~="" then
7213  return format("concat(a%s,%q)",n,f)
7214 else
7215  return format("concat(a%s)",n)
7216 end
7217end
7218local format_T=function(f)
7219 n=n+1
7220 if f and f~="" then
7221  return format("sequenced(a%s,%q)",n,f)
7222 else
7223  return format("sequenced(a%s)",n)
7224 end
7225end
7226local format_l=function()
7227 n=n+1
7228 return format("(a%s and 'true' or 'false')",n)
7229end
7230local format_L=function()
7231 n=n+1
7232 return format("(a%s and 'TRUE' or 'FALSE')",n)
7233end
7234local format_n=function() 
7235 n=n+1
7236 return format("((a%s %% 1 == 0) and format('%%i',a%s) or tostring(a%s))",n,n,n)
7237end
7238local format_N  if environment.FORMAT then
7239 format_N=function(f)
7240  n=n+1
7241  if not f or f=="" then
7242   return format("FORMAT(a%s,'%%.9f')",n)
7243  elseif f==".6" or f=="0.6" then
7244   return format("FORMAT(a%s)",n)
7245  else
7246   return format("FORMAT(a%s,'%%%sf')",n,f)
7247  end
7248 end
7249else
7250 format_N=function(f) 
7251  n=n+1
7252  if not f or f=="" then
7253   f=".9"
7254  end 
7255  return format("(((a%s %% 1 == 0) and format('%%i',a%s)) or lpegmatch(stripzero,format('%%%sf',a%s)))",n,n,f,n)
7256 end
7257end
7258local format_a=function(f)
7259 n=n+1
7260 if f and f~="" then
7261  return format("autosingle(a%s,%q)",n,f)
7262 else
7263  return format("autosingle(a%s)",n)
7264 end
7265end
7266local format_A=function(f)
7267 n=n+1
7268 if f and f~="" then
7269  return format("autodouble(a%s,%q)",n,f)
7270 else
7271  return format("autodouble(a%s)",n)
7272 end
7273end
7274local format_w=function(f) 
7275 n=n+1
7276 f=tonumber(f)
7277 if f then 
7278  return format("nspaces[%s+a%s]",f,n) 
7279 else
7280  return format("nspaces[a%s]",n) 
7281 end
7282end
7283local format_W=function(f) 
7284 return format("nspaces[%s]",tonumber(f) or 0)
7285end
7286local format_m=function(f)
7287 n=n+1
7288 if not f or f=="" then
7289  f=","
7290 end
7291 if f=="0" then
7292  return format([[formattednumber(a%s,false)]],n)
7293 else
7294  return format([[formattednumber(a%s,%q,".")]],n,f)
7295 end
7296end
7297local format_M=function(f)
7298 n=n+1
7299 if not f or f=="" then
7300  f="."
7301 end
7302 if f=="0" then
7303  return format([[formattednumber(a%s,false)]],n)
7304 else
7305  return format([[formattednumber(a%s,%q,",")]],n,f)
7306 end
7307end
7308local format_z=function(f)
7309 n=n+(tonumber(f) or 1)
7310 return "''" 
7311end
7312local format_rest=function(s)
7313 return format("%q",s) 
7314end
7315local format_extension=function(extensions,f,name)
7316 local extension=extensions[name] or "tostring(%s)"
7317 local f=tonumber(f) or 1
7318 local w=find(extension,"%.%.%.")
7319 if f==0 then
7320  if w then
7321   extension=gsub(extension,"%.%.%.","")
7322  end
7323  return extension
7324 elseif f==1 then
7325  if w then
7326   extension=gsub(extension,"%.%.%.","%%s")
7327  end
7328  n=n+1
7329  local a="a"..n
7330  return format(extension,a,a) 
7331 elseif f<0 then
7332  if w then
7333   extension=gsub(extension,"%.%.%.","")
7334   return extension
7335  else
7336   local a="a"..(n+f+1)
7337   return format(extension,a,a)
7338  end
7339 else
7340  if w then
7341   extension=gsub(extension,"%.%.%.",rep("%%s,",f-1).."%%s")
7342  end
7343  local t={}
7344  for i=1,f do
7345   n=n+1
7346   t[i]="a"..n
7347  end
7348  return format(extension,unpack(t))
7349 end
7350end
7351local builder=Cs { "start",
7352 start=(
7353  (
7354   P("%")/""*(
7355    V("!") 
7356+V("s")+V("q")+V("i")+V("d")+V("f")+V("F")+V("g")+V("G")+V("e")+V("E")+V("x")+V("X")+V("o")
7357+V("c")+V("C")+V("S") 
7358+V("Q") 
7359+V("n") 
7360+V("N") 
7361+V("k")
7362+V("r")+V("h")+V("H")+V("u")+V("U")+V("p")+V("P")+V("b")+V("B")+V("t")+V("T")+V("l")+V("L")+V("I")+V("w") 
7363+V("W") 
7364+V("a") 
7365+V("A") 
7366+V("j")+V("J") 
7367+V("m")+V("M") 
7368+V("z")
7369+V(">") 
7370+V("<")
7371   )+V("*")
7372  )*(endofstring+Carg(1))
7373 )^0,
7374 ["s"]=(prefix_any*P("s"))/format_s,
7375 ["q"]=(prefix_any*P("q"))/format_q,
7376 ["i"]=(prefix_any*P("i"))/format_i,
7377 ["d"]=(prefix_any*P("d"))/format_d,
7378 ["f"]=(prefix_any*P("f"))/format_f,
7379 ["F"]=(prefix_any*P("F"))/format_F,
7380 ["g"]=(prefix_any*P("g"))/format_g,
7381 ["G"]=(prefix_any*P("G"))/format_G,
7382 ["e"]=(prefix_any*P("e"))/format_e,
7383 ["E"]=(prefix_any*P("E"))/format_E,
7384 ["x"]=(prefix_any*P("x"))/format_x,
7385 ["X"]=(prefix_any*P("X"))/format_X,
7386 ["o"]=(prefix_any*P("o"))/format_o,
7387 ["S"]=(prefix_any*P("S"))/format_S,
7388 ["Q"]=(prefix_any*P("Q"))/format_Q,
7389 ["n"]=(prefix_any*P("n"))/format_n,
7390 ["N"]=(prefix_any*P("N"))/format_N,
7391 ["k"]=(prefix_sub*P("k"))/format_k,
7392 ["c"]=(prefix_any*P("c"))/format_c,
7393 ["C"]=(prefix_any*P("C"))/format_C,
7394 ["r"]=(prefix_any*P("r"))/format_r,
7395 ["h"]=(prefix_any*P("h"))/format_h,
7396 ["H"]=(prefix_any*P("H"))/format_H,
7397 ["u"]=(prefix_any*P("u"))/format_u,
7398 ["U"]=(prefix_any*P("U"))/format_U,
7399 ["p"]=(prefix_any*P("p"))/format_p,
7400 ["P"]=(prefix_any*P("P"))/format_P,
7401 ["b"]=(prefix_any*P("b"))/format_b,
7402 ["B"]=(prefix_any*P("B"))/format_B,
7403 ["t"]=(prefix_tab*P("t"))/format_t,
7404 ["T"]=(prefix_tab*P("T"))/format_T,
7405 ["l"]=(prefix_any*P("l"))/format_l,
7406 ["L"]=(prefix_any*P("L"))/format_L,
7407 ["I"]=(prefix_any*P("I"))/format_I,
7408 ["w"]=(prefix_any*P("w"))/format_w,
7409 ["W"]=(prefix_any*P("W"))/format_W,
7410 ["j"]=(prefix_any*P("j"))/format_j,
7411 ["J"]=(prefix_any*P("J"))/format_J,
7412 ["m"]=(prefix_any*P("m"))/format_m,
7413 ["M"]=(prefix_any*P("M"))/format_M,
7414 ["z"]=(prefix_any*P("z"))/format_z,
7415 ["a"]=(prefix_any*P("a"))/format_a,
7416 ["A"]=(prefix_any*P("A"))/format_A,
7417 ["<"]=(prefix_any*P("<"))/format_left,
7418 [">"]=(prefix_any*P(">"))/format_right,
7419 ["*"]=Cs(((1-P("%"))^1+P("%%")/"%%")^1)/format_rest,
7420 ["?"]=Cs(((1-P("%"))^1      )^1)/format_rest,
7421 ["!"]=Carg(2)*prefix_any*P("!")*C((1-P("!"))^1)*P("!")/format_extension,
7422}
7423local xx=setmetatable({},{ __index=function(t,k) local v=format("%02x",k) t[k]=v return v end })
7424local XX=setmetatable({},{ __index=function(t,k) local v=format("%02X",k) t[k]=v return v end })
7425local preset={
7426 ["%02x"]=function(n) return xx[n] end,
7427 ["%02X"]=function(n) return XX[n] end,
7428}
7429local direct=P("%")*(sign+space+period+digit)^0*S("sqidfgGeExXo")*endofstring/[[local format = string.format return function(str) return format("%0",str) end]]
7430local function make(t,str)
7431 local f=preset[str]
7432 if f then
7433  return f
7434 end
7435 local p=lpegmatch(direct,str)
7436 if p then
7437  f=loadstripped(p)()
7438 else
7439  n=0
7440  p=lpegmatch(builder,str,1,t._connector_,t._extensions_) 
7441  if n>0 then
7442   p=format(template,preamble,t._preamble_,arguments[n],p)
7443   f=loadstripped(p,t._environment_)() 
7444  else
7445   f=function() return str end
7446  end
7447 end
7448 t[str]=f
7449 return f
7450end
7451local function use(t,fmt,...)
7452 return t[fmt](...)
7453end
7454strings.formatters={}
7455function strings.formatters.new(noconcat)
7456 local e={} 
7457 for k,v in next,environment do
7458  e[k]=v
7459 end
7460 local t={
7461  _type_="formatter",
7462  _connector_=noconcat and "," or "..",
7463  _extensions_={},
7464  _preamble_="",
7465  _environment_=e,
7466 }
7467 setmetatable(t,{ __index=make,__call=use })
7468 return t
7469end
7470local formatters=strings.formatters.new() 
7471string.formatters=formatters 
7472string.formatter=function(str,...) return formatters[str](...) end 
7473local function add(t,name,template,preamble)
7474 if type(t)=="table" and t._type_=="formatter" then
7475  t._extensions_[name]=template or "%s"
7476  if type(preamble)=="string" then
7477   t._preamble_=preamble.."\n"..t._preamble_ 
7478  elseif type(preamble)=="table" then
7479   for k,v in next,preamble do
7480    t._environment_[k]=v
7481   end
7482  end
7483 end
7484end
7485strings.formatters.add=add
7486patterns.xmlescape=Cs((P("<")/"&lt;"+P(">")/"&gt;"+P("&")/"&amp;"+P('"')/"&quot;"+anything)^0)
7487patterns.texescape=Cs((C(S("#$%\\{}"))/"\\%1"+anything)^0)
7488patterns.ctxescape=Cs((C(S("#$%\\{}|"))/"\\%1"+anything)^0)
7489patterns.luaescape=Cs(((1-S('"\n'))^1+P('"')/'\\"'+P('\n')/'\\n"')^0) 
7490patterns.luaquoted=Cs(Cc('"')*((1-S('"\n'))^1+P('"')/'\\"'+P('\n')/'\\n"')^0*Cc('"'))
7491add(formatters,"xml",[[lpegmatch(xmlescape,%s)]],{ xmlescape=patterns.xmlescape })
7492add(formatters,"tex",[[lpegmatch(texescape,%s)]],{ texescape=patterns.texescape })
7493add(formatters,"lua",[[lpegmatch(luaescape,%s)]],{ luaescape=patterns.luaescape })
7494local dquote=patterns.dquote 
7495local equote=patterns.escaped+dquote/'\\"'+1
7496local cquote=Cc('"')
7497local pattern=Cs(dquote*(equote-P(-2))^0*dquote)     
7498+Cs(cquote*(equote-space)^0*space*equote^0*cquote) 
7499function string.optionalquoted(str)
7500 return lpegmatch(pattern,str) or str
7501end
7502local pattern=Cs((newline/(os.newline or "\r")+1)^0)
7503function string.replacenewlines(str)
7504 return lpegmatch(pattern,str)
7505end
7506function strings.newcollector()
7507 local result,r={},0
7508 return
7509  function(fmt,str,...) 
7510   r=r+1
7511   result[r]=str==nil and fmt or formatters[fmt](str,...)
7512  end,
7513  function(connector) 
7514   if result then
7515    local str=concat(result,connector)
7516    result,r={},0
7517    return str
7518   end
7519  end
7520end
7521local f_16_16=formatters["%0.5N"]
7522function number.to16dot16(n)
7523 return f_16_16(n/65536.0)
7524end
7525if not string.explode then
7526 local p_utf=patterns.utf8character
7527 local p_check=C(p_utf)*(P("+")*Cc(true))^0
7528 local p_split=Ct(C(p_utf)^0)
7529 local p_space=Ct((C(1-P(" ")^1)+P(" ")^1)^0)
7530 function string.explode(str,symbol)
7531  if symbol=="" then
7532   return lpegmatch(p_split,str)
7533  elseif symbol then
7534   local a,b=lpegmatch(p_check,symbol)
7535   if b then
7536    return lpegmatch(tsplitat(P(a)^1),str)
7537   else
7538    return lpegmatch(tsplitat(a),str)
7539   end
7540  else
7541   return lpegmatch(p_space,str)
7542  end
7543 end
7544end
7545do
7546 local p_whitespace=patterns.whitespace^1
7547 local cache=setmetatable({},{ __index=function(t,k)
7548  local p=tsplitat(p_whitespace*P(k)*p_whitespace)
7549  local v=function(s)
7550   return lpegmatch(p,s)
7551  end
7552  t[k]=v
7553  return v
7554 end })
7555 function string.wordsplitter(s)
7556  return cache[s]
7557 end
7558end
7559if CONTEXTLMTXMODE and CONTEXTLMTXMODE>0 then
7560 local t={
7561  ["#"]="#H",
7562  ["\n"]="#L",
7563  ['"']="#Q",
7564  ["\r"]="#R",
7565  [" "]="#S",
7566  ["\t"]="#T",
7567  ["\\"]="#X",
7568 }
7569 function string.texhashed(s)
7570  return (gsub(s,".",t))
7571 end
7572end
7573
7574
7575end -- of closure
7576
7577do -- create closure to overcome 200 locals limit
7578
7579package.loaded["util-tab"] = package.loaded["util-tab"] or true
7580
7581-- original size: 34169, stripped down to: 18433
7582
7583if not modules then modules={} end modules ['util-tab']={
7584 version=1.001,
7585 comment="companion to luat-lib.mkiv",
7586 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
7587 copyright="PRAGMA ADE / ConTeXt Development Team",
7588 license="see context related readme files"
7589}
7590utilities=utilities or {}
7591utilities.tables=utilities.tables or {}
7592local tables=utilities.tables
7593local format,gmatch,gsub,sub=string.format,string.gmatch,string.gsub,string.sub
7594local concat,insert,remove,sort=table.concat,table.insert,table.remove,table.sort
7595local setmetatable,getmetatable,tonumber,tostring,rawget=setmetatable,getmetatable,tonumber,tostring,rawget
7596local type,next,rawset,tonumber,tostring,load,select=type,next,rawset,tonumber,tostring,load,select
7597local lpegmatch,P,Cs,Cc=lpeg.match,lpeg.P,lpeg.Cs,lpeg.Cc
7598local sortedkeys,sortedpairs=table.sortedkeys,table.sortedpairs
7599local formatters=string.formatters
7600local utftoeight=utf.toeight
7601local splitter=lpeg.tsplitat(".")
7602function utilities.tables.definetable(target,nofirst,nolast) 
7603 local composed=nil
7604 local t={}
7605 local snippets=lpegmatch(splitter,target)
7606 for i=1,#snippets-(nolast and 1 or 0) do
7607  local name=snippets[i]
7608  if composed then
7609   composed=composed.."."..name
7610    t[#t+1]=formatters["if not %s then %s = { } end"](composed,composed)
7611  else
7612   composed=name
7613   if not nofirst then
7614    t[#t+1]=formatters["%s = %s or { }"](composed,composed)
7615   end
7616  end
7617 end
7618 if composed then
7619  if nolast then
7620   composed=composed.."."..snippets[#snippets]
7621  end
7622  return concat(t,"\n"),composed 
7623 else
7624  return "",target
7625 end
7626end
7627function tables.definedtable(...)
7628 local t=_G
7629 for i=1,select("#",...) do
7630  local li=select(i,...)
7631  local tl=t[li]
7632  if not tl then
7633   tl={}
7634   t[li]=tl
7635  end
7636  t=tl
7637 end
7638 return t
7639end
7640function tables.accesstable(target,root)
7641 local t=root or _G
7642 for name in gmatch(target,"([^%.]+)") do
7643  t=t[name]
7644  if not t then
7645   return
7646  end
7647 end
7648 return t
7649end
7650function tables.migratetable(target,v,root)
7651 local t=root or _G
7652 local names=lpegmatch(splitter,target)
7653 for i=1,#names-1 do
7654  local name=names[i]
7655  t[name]=t[name] or {}
7656  t=t[name]
7657  if not t then
7658   return
7659  end
7660 end
7661 t[names[#names]]=v
7662end
7663function tables.removevalue(t,value) 
7664 if value then
7665  for i=1,#t do
7666   if t[i]==value then
7667    remove(t,i)
7668   end
7669  end
7670 end
7671end
7672function tables.replacevalue(t,oldvalue,newvalue)
7673 if oldvalue and newvalue then
7674  for i=1,#t do
7675   if t[i]==oldvalue then
7676    t[i]=newvalue
7677   end
7678  end
7679 end
7680end
7681function tables.insertbeforevalue(t,value,extra)
7682 for i=1,#t do
7683  if t[i]==extra then
7684   remove(t,i)
7685  end
7686 end
7687 for i=1,#t do
7688  if t[i]==value then
7689   insert(t,i,extra)
7690   return
7691  end
7692 end
7693 insert(t,1,extra)
7694end
7695function tables.insertaftervalue(t,value,extra)
7696 for i=1,#t do
7697  if t[i]==extra then
7698   remove(t,i)
7699  end
7700 end
7701 for i=1,#t do
7702  if t[i]==value then
7703   insert(t,i+1,extra)
7704   return
7705  end
7706 end
7707 insert(t,#t+1,extra)
7708end
7709local escape=Cs(Cc('"')*((P('"')/'""'+P(1))^0)*Cc('"'))
7710function table.tocsv(t,specification)
7711 if t and #t>0 then
7712  local result={}
7713  local r={}
7714  specification=specification or {}
7715  local fields=specification.fields
7716  if type(fields)~="string" then
7717   fields=sortedkeys(t[1])
7718  end
7719  local separator=specification.separator or ","
7720  local noffields=#fields
7721  if specification.preamble==true then
7722   for f=1,noffields do
7723    r[f]=lpegmatch(escape,tostring(fields[f]))
7724   end
7725   result[1]=concat(r,separator)
7726  end
7727  for i=1,#t do
7728   local ti=t[i]
7729   for f=1,noffields do
7730    local field=ti[fields[f]]
7731    if type(field)=="string" then
7732     r[f]=lpegmatch(escape,field)
7733    else
7734     r[f]=tostring(field)
7735    end
7736   end
7737   result[i+1]=concat(r,separator)
7738  end
7739  return concat(result,"\n")
7740 else
7741  return ""
7742 end
7743end
7744local nspaces=utilities.strings.newrepeater(" ")
7745local function toxml(t,d,result,step)
7746 local r=#result
7747 for k,v in sortedpairs(t) do
7748  local s=nspaces[d] 
7749  local tk=type(k)
7750  local tv=type(v)
7751  if tv=="table" then
7752   if tk=="number" then
7753    r=r+1 result[r]=formatters["%s<entry n='%s'>"](s,k)
7754    r=toxml(v,d+step,result,step)
7755    r=r+1 result[r]=formatters["%s</entry>"](s,k)
7756   else
7757    r=r+1 result[r]=formatters["%s<%s>"](s,k)
7758    r=toxml(v,d+step,result,step)
7759    r=r+1 result[r]=formatters["%s</%s>"](s,k)
7760   end
7761  elseif tv=="string" then
7762   if tk=="number" then
7763    r=r+1 result[r]=formatters["%s<entry n='%s'>%!xml!</entry>"](s,k,v,k)
7764   else
7765    r=r+1 result[r]=formatters["%s<%s>%!xml!</%s>"](s,k,v,k)
7766   end
7767  elseif tk=="number" then
7768   r=r+1 result[r]=formatters["%s<entry n='%s'>%S</entry>"](s,k,v,k)
7769  else
7770   r=r+1 result[r]=formatters["%s<%s>%S</%s>"](s,k,v,k)
7771  end
7772 end
7773 return r
7774end
7775function table.toxml(t,specification)
7776 specification=specification or {}
7777 local name=specification.name
7778 local noroot=name==false
7779 local result=(specification.nobanner or noroot) and {} or { "<?xml version='1.0' standalone='yes' ?>" }
7780 local indent=specification.indent or 0
7781 local spaces=specification.spaces or 1
7782 if noroot then
7783  toxml(t,indent,result,spaces)
7784 else
7785  toxml({ [name or "data"]=t },indent,result,spaces)
7786 end
7787 return concat(result,"\n")
7788end
7789function tables.encapsulate(core,capsule,protect)
7790 if type(capsule)~="table" then
7791  protect=true
7792  capsule={}
7793 end
7794 for key,value in next,core do
7795  if capsule[key] then
7796   print(formatters["\ninvalid %s %a in %a"]("inheritance",key,core))
7797   os.exit()
7798  else
7799   capsule[key]=value
7800  end
7801 end
7802 if protect then
7803  for key,value in next,core do
7804   core[key]=nil
7805  end
7806  setmetatable(core,{
7807   __index=capsule,
7808   __newindex=function(t,key,value)
7809    if capsule[key] then
7810     print(formatters["\ninvalid %s %a' in %a"]("overload",key,core))
7811     os.exit()
7812    else
7813     rawset(t,key,value)
7814    end
7815   end
7816  } )
7817 end
7818end
7819if JITSUPPORTED then
7820 local f_hashed_string=formatters["[%Q]=%Q,"]
7821 local f_hashed_number=formatters["[%Q]=%s,"]
7822 local f_hashed_boolean=formatters["[%Q]=%l,"]
7823 local f_hashed_table=formatters["[%Q]="]
7824 local f_indexed_string=formatters["[%s]=%Q,"]
7825 local f_indexed_number=formatters["[%s]=%s,"]
7826 local f_indexed_boolean=formatters["[%s]=%l,"]
7827 local f_indexed_table=formatters["[%s]="]
7828 local f_ordered_string=formatters["%Q,"]
7829 local f_ordered_number=formatters["%s,"]
7830 local f_ordered_boolean=formatters["%l,"]
7831 function table.fastserialize(t,prefix)
7832  local r={ type(prefix)=="string" and prefix or "return" }
7833  local m=1
7834  local function fastserialize(t,outer) 
7835   local n=#t
7836   m=m+1
7837   r[m]="{"
7838   if n>0 then
7839    local v=t[0]
7840    if v then
7841     local tv=type(v)
7842     if tv=="string" then
7843      m=m+1 r[m]=f_indexed_string(0,v)
7844     elseif tv=="number" then
7845      m=m+1 r[m]=f_indexed_number(0,v)
7846     elseif tv=="table" then
7847      m=m+1 r[m]=f_indexed_table(0)
7848      fastserialize(v)
7849      m=m+1 r[m]=f_indexed_table(0)
7850     elseif tv=="boolean" then
7851      m=m+1 r[m]=f_indexed_boolean(0,v)
7852     end
7853    end
7854    for i=1,n do
7855     local v=t[i]
7856     local tv=type(v)
7857     if tv=="string" then
7858      m=m+1 r[m]=f_ordered_string(v)
7859     elseif tv=="number" then
7860      m=m+1 r[m]=f_ordered_number(v)
7861     elseif tv=="table" then
7862      fastserialize(v)
7863     elseif tv=="boolean" then
7864      m=m+1 r[m]=f_ordered_boolean(v)
7865     end
7866    end
7867   end
7868   for k,v in next,t do
7869    local tk=type(k)
7870    if tk=="number" then
7871     if k>n or k<0 then
7872      local tv=type(v)
7873      if tv=="string" then
7874       m=m+1 r[m]=f_indexed_string(k,v)
7875      elseif tv=="number" then
7876       m=m+1 r[m]=f_indexed_number(k,v)
7877      elseif tv=="table" then
7878       m=m+1 r[m]=f_indexed_table(k)
7879       fastserialize(v)
7880      elseif tv=="boolean" then
7881       m=m+1 r[m]=f_indexed_boolean(k,v)
7882      end
7883     end
7884    else
7885     local tv=type(v)
7886     if tv=="string" then
7887      m=m+1 r[m]=f_hashed_string(k,v)
7888     elseif tv=="number" then
7889      m=m+1 r[m]=f_hashed_number(k,v)
7890     elseif tv=="table" then
7891      m=m+1 r[m]=f_hashed_table(k)
7892      fastserialize(v)
7893     elseif tv=="boolean" then
7894      m=m+1 r[m]=f_hashed_boolean(k,v)
7895     end
7896    end
7897   end
7898   m=m+1
7899   if outer then
7900    r[m]="}"
7901   else
7902    r[m]="},"
7903   end
7904   return r
7905  end
7906  return concat(fastserialize(t,true))
7907 end
7908else
7909 function table.fastserialize(t,prefix) 
7910  local r={ type(prefix)=="string" and prefix or "return" }
7911  local m=1
7912  local function fastserialize(t,outer) 
7913   local n=#t
7914   m=m+1
7915   r[m]="{"
7916   if n>0 then
7917    local v=t[0]
7918    if v then
7919     m=m+1
7920     r[m]="[0]="
7921     if type(v)=="table" then
7922      fastserialize(v)
7923     else
7924      r[m]=format("%q,",v)
7925     end
7926    end
7927    for i=1,n do
7928     local v=t[i]
7929     m=m+1
7930     if type(v)=="table" then
7931      r[m]=format("[%i]=",i)
7932      fastserialize(v)
7933     else
7934      r[m]=format("[%i]=%q,",i,v)
7935     end
7936    end
7937   end
7938   for k,v in next,t do
7939    local tk=type(k)
7940    if tk=="number" then
7941     if k>n or k<0 then
7942      m=m+1
7943      if type(v)=="table" then
7944       r[m]=format("[%i]=",k)
7945       fastserialize(v)
7946      else
7947       r[m]=format("[%i]=%q,",k,v)
7948      end
7949     end
7950    else
7951     m=m+1
7952     if type(v)=="table" then
7953      r[m]=format("[%q]=",k)
7954      fastserialize(v)
7955     else
7956      r[m]=format("[%q]=%q,",k,v)
7957     end
7958    end
7959   end
7960   m=m+1
7961   if outer then
7962    r[m]="}"
7963   else
7964    r[m]="},"
7965   end
7966   return r
7967  end
7968  return concat(fastserialize(t,true))
7969 end
7970end
7971function table.deserialize(str)
7972 if not str or str=="" then
7973  return
7974 end
7975 local code=load(str)
7976 if not code then
7977  return
7978 end
7979 code=code()
7980 if not code then
7981  return
7982 end
7983 return code
7984end
7985function table.load(filename,loader)
7986 if filename then
7987  local t=(loader or io.loaddata)(filename)
7988  if t and t~="" then
7989   local t=utftoeight(t)
7990   t=load(t)
7991   if type(t)=="function" then
7992    t=t()
7993    if type(t)=="table" then
7994     return t
7995    end
7996   end
7997  end
7998 end
7999end
8000function table.save(filename,t,n,...)
8001 io.savedata(filename,table.serialize(t,n==nil and true or n,...)) 
8002end
8003local f_key_value=formatters["%s=%q"]
8004local f_add_table=formatters[" {%t},\n"]
8005local f_return_table=formatters["return {\n%t}"]
8006local function slowdrop(t) 
8007 local r={}
8008 local l={}
8009 for i=1,#t do
8010  local ti=t[i]
8011  local j=0
8012  for k,v in next,ti do
8013   j=j+1
8014   l[j]=f_key_value(k,v)
8015  end
8016  r[i]=f_add_table(l)
8017 end
8018 return f_return_table(r)
8019end
8020local function fastdrop(t)
8021 local r={ "return {\n" }
8022 local m=1
8023 for i=1,#t do
8024  local ti=t[i]
8025  m=m+1 r[m]=" {"
8026  for k,v in next,ti do
8027   m=m+1 r[m]=f_key_value(k,v)
8028  end
8029  m=m+1 r[m]="},\n"
8030 end
8031 m=m+1
8032 r[m]="}"
8033 return concat(r)
8034end
8035function table.drop(t,slow) 
8036 if #t==0 then
8037  return "return { }"
8038 elseif slow==true then
8039  return slowdrop(t) 
8040 else
8041  return fastdrop(t) 
8042 end
8043end
8044local selfmapper={ __index=function(t,k) t[k]=k return k end }
8045function table.twowaymapper(t) 
8046 if not t then     
8047  t={}       
8048 else        
8049  local zero=rawget(t,0)  
8050  for i=zero and 0 or 1,#t do
8051   local ti=t[i]    
8052   if ti then
8053    local i=tostring(i)
8054    t[i]=ti   
8055    t[ti]=i    
8056   end
8057  end
8058 end
8059 setmetatable(t,selfmapper)
8060 return t
8061end
8062local f_start_key_idx=formatters["%w{"]
8063local f_start_key_num=JITSUPPORTED and formatters["%w[%s]={"] or formatters["%w[%q]={"]
8064local f_start_key_str=formatters["%w[%q]={"]
8065local f_start_key_boo=formatters["%w[%l]={"]
8066local f_start_key_nop=formatters["%w{"]
8067local f_stop=formatters["%w},"]
8068local f_key_num_value_num=JITSUPPORTED and formatters["%w[%s]=%s,"] or formatters["%w[%s]=%q,"]
8069local f_key_str_value_num=JITSUPPORTED and formatters["%w[%Q]=%s,"] or formatters["%w[%Q]=%q,"]
8070local f_key_boo_value_num=JITSUPPORTED and formatters["%w[%l]=%s,"] or formatters["%w[%l]=%q,"]
8071local f_key_num_value_str=JITSUPPORTED and formatters["%w[%s]=%Q,"] or formatters["%w[%q]=%Q,"]
8072local f_key_str_value_str=formatters["%w[%Q]=%Q,"]
8073local f_key_boo_value_str=formatters["%w[%l]=%Q,"]
8074local f_key_num_value_boo=JITSUPPORTED and formatters["%w[%s]=%l,"] or formatters["%w[%q]=%l,"]
8075local f_key_str_value_boo=formatters["%w[%Q]=%l,"]
8076local f_key_boo_value_boo=formatters["%w[%l]=%l,"]
8077local f_key_num_value_not=JITSUPPORTED and formatters["%w[%s]={},"] or formatters["%w[%q]={},"]
8078local f_key_str_value_not=formatters["%w[%Q]={},"]
8079local f_key_boo_value_not=formatters["%w[%l]={},"]
8080local f_key_num_value_seq=JITSUPPORTED and formatters["%w[%s]={ %, t },"] or formatters["%w[%q]={ %, t },"]
8081local f_key_str_value_seq=formatters["%w[%Q]={ %, t },"]
8082local f_key_boo_value_seq=formatters["%w[%l]={ %, t },"]
8083local f_val_num=JITSUPPORTED and formatters["%w%s,"] or formatters["%w%q,"]
8084local f_val_str=formatters["%w%Q,"]
8085local f_val_boo=formatters["%w%l,"]
8086local f_val_not=formatters["%w{},"]
8087local f_val_seq=formatters["%w{ %, t },"]
8088local f_fin_seq=formatters[" %, t }"]
8089local f_table_return=formatters["return {"]
8090local f_table_name=formatters["%s={"]
8091local f_table_direct=formatters["{"]
8092local f_table_entry=formatters["[%Q]={"]
8093local f_table_finish=formatters["}"]
8094local spaces=utilities.strings.newrepeater(" ")
8095local original_serialize=table.serialize
8096local is_simple_table=table.is_simple_table
8097local function serialize(root,name,specification)
8098 if type(specification)=="table" then
8099  return original_serialize(root,name,specification) 
8100 end
8101 local t 
8102 local n=1
8103 local unknown=false
8104 local function do_serialize(root,name,depth,level,indexed)
8105  if level>0 then
8106   n=n+1
8107   if indexed then
8108    t[n]=f_start_key_idx(depth)
8109   else
8110    local tn=type(name)
8111    if tn=="number" then
8112     t[n]=f_start_key_num(depth,name)
8113    elseif tn=="string" then
8114     t[n]=f_start_key_str(depth,name)
8115    elseif tn=="boolean" then
8116     t[n]=f_start_key_boo(depth,name)
8117    else
8118     t[n]=f_start_key_nop(depth)
8119    end
8120   end
8121   depth=depth+1
8122  end
8123  if root and next(root)~=nil then
8124   local first=nil
8125   local last=#root
8126   if last>0 then
8127    for k=1,last do
8128     if rawget(root,k)==nil then
8129      last=k-1
8130      break
8131     end
8132    end
8133    if last>0 then
8134     first=1
8135    end
8136   end
8137   local sk=sortedkeys(root)
8138   for i=1,#sk do
8139    local k=sk[i]
8140    local v=root[k]
8141    local tv=type(v)
8142    local tk=type(k)
8143    if first and tk=="number" and k<=last and k>=first then
8144     if tv=="number" then
8145      n=n+1 t[n]=f_val_num(depth,v)
8146     elseif tv=="string" then
8147      n=n+1 t[n]=f_val_str(depth,v)
8148     elseif tv=="table" then
8149      if next(v)==nil then 
8150       n=n+1 t[n]=f_val_not(depth)
8151      else
8152       local st=is_simple_table(v)
8153       if st then
8154        n=n+1 t[n]=f_val_seq(depth,st)
8155       else
8156        do_serialize(v,k,depth,level+1,true)
8157       end
8158      end
8159     elseif tv=="boolean" then
8160      n=n+1 t[n]=f_val_boo(depth,v)
8161     elseif unknown then
8162      n=n+1 t[n]=f_val_str(depth,tostring(v))
8163     end
8164    elseif tv=="number" then
8165     if tk=="number" then
8166      n=n+1 t[n]=f_key_num_value_num(depth,k,v)
8167     elseif tk=="string" then
8168      n=n+1 t[n]=f_key_str_value_num(depth,k,v)
8169     elseif tk=="boolean" then
8170      n=n+1 t[n]=f_key_boo_value_num(depth,k,v)
8171     elseif unknown then
8172      n=n+1 t[n]=f_key_str_value_num(depth,tostring(k),v)
8173     end
8174    elseif tv=="string" then
8175     if tk=="number" then
8176      n=n+1 t[n]=f_key_num_value_str(depth,k,v)
8177     elseif tk=="string" then
8178      n=n+1 t[n]=f_key_str_value_str(depth,k,v)
8179     elseif tk=="boolean" then
8180      n=n+1 t[n]=f_key_boo_value_str(depth,k,v)
8181     elseif unknown then
8182      n=n+1 t[n]=f_key_str_value_str(depth,tostring(k),v)
8183     end
8184    elseif tv=="table" then
8185     if next(v)==nil then
8186      if tk=="number" then
8187       n=n+1 t[n]=f_key_num_value_not(depth,k)
8188      elseif tk=="string" then
8189       n=n+1 t[n]=f_key_str_value_not(depth,k)
8190      elseif tk=="boolean" then
8191       n=n+1 t[n]=f_key_boo_value_not(depth,k)
8192      elseif unknown then
8193       n=n+1 t[n]=f_key_str_value_not(depth,tostring(k))
8194      end
8195     else
8196      local st=is_simple_table(v)
8197      if not st then
8198       do_serialize(v,k,depth,level+1)
8199      elseif tk=="number" then
8200       n=n+1 t[n]=f_key_num_value_seq(depth,k,st)
8201      elseif tk=="string" then
8202       n=n+1 t[n]=f_key_str_value_seq(depth,k,st)
8203      elseif tk=="boolean" then
8204       n=n+1 t[n]=f_key_boo_value_seq(depth,k,st)
8205      elseif unknown then
8206       n=n+1 t[n]=f_key_str_value_seq(depth,tostring(k),st)
8207      end
8208     end
8209    elseif tv=="boolean" then
8210     if tk=="number" then
8211      n=n+1 t[n]=f_key_num_value_boo(depth,k,v)
8212     elseif tk=="string" then
8213      n=n+1 t[n]=f_key_str_value_boo(depth,k,v)
8214     elseif tk=="boolean" then
8215      n=n+1 t[n]=f_key_boo_value_boo(depth,k,v)
8216     elseif unknown then
8217      n=n+1 t[n]=f_key_str_value_boo(depth,tostring(k),v)
8218     end
8219    else
8220     if tk=="number" then
8221      n=n+1 t[n]=f_key_num_value_str(depth,k,tostring(v))
8222     elseif tk=="string" then
8223      n=n+1 t[n]=f_key_str_value_str(depth,k,tostring(v))
8224     elseif tk=="boolean" then
8225      n=n+1 t[n]=f_key_boo_value_str(depth,k,tostring(v))
8226     elseif unknown then
8227      n=n+1 t[n]=f_key_str_value_str(depth,tostring(k),tostring(v))
8228     end
8229    end
8230   end
8231  end
8232  if level>0 then
8233   n=n+1 t[n]=f_stop(depth-1)
8234  end
8235 end
8236 local tname=type(name)
8237 if tname=="string" then
8238  if name=="return" then
8239   t={ f_table_return() }
8240  else
8241   t={ f_table_name(name) }
8242  end
8243 elseif tname=="number" then
8244  t={ f_table_entry(name) }
8245 elseif tname=="boolean" then
8246  if name then
8247   t={ f_table_return() }
8248  else
8249   t={ f_table_direct() }
8250  end
8251 else
8252  t={ f_table_name("t") }
8253 end
8254 if root then
8255  if getmetatable(root) then 
8256   local dummy=root._w_h_a_t_e_v_e_r_ 
8257   root._w_h_a_t_e_v_e_r_=nil
8258  end
8259  if next(root)~=nil then
8260   local st=is_simple_table(root)
8261   if st then
8262    return t[1]..f_fin_seq(st) 
8263   else
8264    do_serialize(root,name,1,0)
8265   end
8266  end
8267 end
8268 n=n+1
8269 t[n]=f_table_finish()
8270 return concat(t,"\n")
8271end
8272table.serialize=serialize
8273if setinspector then
8274 setinspector("table",function(v)
8275  if type(v)=="table" then
8276   print(serialize(v,"table",{ metacheck=false }))
8277   return true
8278  end
8279 end)
8280end
8281local mt={
8282 __newindex=function(t,k,v)
8283  local n=t.last+1
8284  t.last=n
8285  t.list[n]=k
8286  t.hash[k]=v
8287 end,
8288 __index=function(t,k)
8289  return t.hash[k]
8290 end,
8291 __len=function(t)
8292  return t.last
8293 end,
8294}
8295function table.orderedhash()
8296 return setmetatable({ list={},hash={},last=0 },mt)
8297end
8298function table.ordered(t)
8299 local n=t.last
8300 if n>0 then
8301  local l=t.list
8302  local i=1
8303  local h=t.hash
8304  local f=function()
8305   if i<=n then
8306    local k=i
8307    local v=h[l[k]]
8308    i=i+1
8309    return k,v
8310   end
8311  end
8312  return f,1,h[l[1]]
8313 else
8314  return function() end
8315 end
8316end
8317function combine(target,source)
8318 if target then
8319  for k,v in next,source do
8320   if type(v)=="table" then
8321      target[k]=combine(target[k],source[k])
8322   else
8323      target[k]=v
8324   end
8325  end
8326  return target
8327 else
8328  return source
8329 end
8330end
8331table.combine=combine
8332
8333
8334end -- of closure
8335
8336do -- create closure to overcome 200 locals limit
8337
8338package.loaded["util-fil"] = package.loaded["util-fil"] or true
8339
8340-- original size: 11474, stripped down to: 8973
8341
8342if not modules then modules={} end modules ['util-fil']={
8343 version=1.001,
8344 optimize=true,
8345 comment="companion to luat-lib.mkiv",
8346 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
8347 copyright="PRAGMA ADE / ConTeXt Development Team",
8348 license="see context related readme files"
8349}
8350local tonumber=tonumber
8351local byte=string.byte
8352local char=string.char
8353utilities=utilities or {}
8354local files={}
8355utilities.files=files
8356local zerobased={}
8357function files.open(filename,zb)
8358 local f=io.open(filename,"rb")
8359 if f then
8360  zerobased[f]=zb or false
8361 end
8362 return f
8363end
8364function files.close(f)
8365 zerobased[f]=nil
8366 f:close()
8367end
8368function files.size(f)
8369 local current=f:seek()
8370 local size=f:seek("end")
8371 f:seek("set",current)
8372 return size
8373end
8374files.getsize=files.size
8375function files.setposition(f,n)
8376 if zerobased[f] then
8377  f:seek("set",n)
8378 else
8379  f:seek("set",n-1)
8380 end
8381end
8382function files.getposition(f)
8383 if zerobased[f] then
8384  return f:seek()
8385 else
8386  return f:seek()+1
8387 end
8388end
8389function files.look(f,n,chars)
8390 local p=f:seek()
8391 local s=f:read(n)
8392 f:seek("set",p)
8393 if chars then
8394  return s
8395 else
8396  return byte(s,1,#s)
8397 end
8398end
8399function files.skip(f,n)
8400 if n==1 then
8401  f:read(n)
8402 else
8403  f:seek("set",f:seek()+n)
8404 end
8405end
8406function files.readbyte(f)
8407 return byte(f:read(1))
8408end
8409function files.readbytes(f,n)
8410 return byte(f:read(n),1,n)
8411end
8412function files.readbytetable(f,n)
8413 local s=f:read(n or 1)
8414 return { byte(s,1,#s) } 
8415end
8416function files.readchar(f)
8417 return f:read(1)
8418end
8419function files.readstring(f,n)
8420 return f:read(n or 1)
8421end
8422function files.readinteger1(f)  
8423 local n=byte(f:read(1))
8424 if n>=0x80 then
8425  return n-0x100
8426 else
8427  return n
8428 end
8429end
8430files.readcardinal1=files.readbyte  
8431files.readcardinal=files.readcardinal1
8432files.readinteger=files.readinteger1
8433files.readsignedbyte=files.readinteger1
8434function files.readcardinal2(f)
8435 local a,b=byte(f:read(2),1,2)
8436 return 0x100*a+b
8437end
8438function files.readcardinal2le(f)
8439 local b,a=byte(f:read(2),1,2)
8440 return 0x100*a+b
8441end
8442function files.readinteger2(f)
8443 local a,b=byte(f:read(2),1,2)
8444 if a>=0x80 then
8445  return 0x100*a+b-0x10000
8446 else
8447  return 0x100*a+b
8448 end
8449end
8450function files.readinteger2le(f)
8451 local b,a=byte(f:read(2),1,2)
8452 if a>=0x80 then
8453  return 0x100*a+b-0x10000
8454 else
8455  return 0x100*a+b
8456 end
8457end
8458function files.readcardinal3(f)
8459 local a,b,c=byte(f:read(3),1,3)
8460 return 0x10000*a+0x100*b+c
8461end
8462function files.readcardinal3le(f)
8463 local c,b,a=byte(f:read(3),1,3)
8464 return 0x10000*a+0x100*b+c
8465end
8466function files.readinteger3(f)
8467 local a,b,c=byte(f:read(3),1,3)
8468 if a>=0x80 then
8469  return 0x10000*a+0x100*b+c-0x1000000
8470 else
8471  return 0x10000*a+0x100*b+c
8472 end
8473end
8474function files.readinteger3le(f)
8475 local c,b,a=byte(f:read(3),1,3)
8476 if a>=0x80 then
8477  return 0x10000*a+0x100*b+c-0x1000000
8478 else
8479  return 0x10000*a+0x100*b+c
8480 end
8481end
8482function files.readcardinal4(f)
8483 local a,b,c,d=byte(f:read(4),1,4)
8484 return 0x1000000*a+0x10000*b+0x100*c+d
8485end
8486function files.readcardinal4le(f)
8487 local d,c,b,a=byte(f:read(4),1,4)
8488 return 0x1000000*a+0x10000*b+0x100*c+d
8489end
8490function files.readinteger4(f)
8491 local a,b,c,d=byte(f:read(4),1,4)
8492 if a>=0x80 then
8493  return 0x1000000*a+0x10000*b+0x100*c+d-0x100000000
8494 else
8495  return 0x1000000*a+0x10000*b+0x100*c+d
8496 end
8497end
8498function files.readinteger4le(f)
8499 local d,c,b,a=byte(f:read(4),1,4)
8500 if a>=0x80 then
8501  return 0x1000000*a+0x10000*b+0x100*c+d-0x100000000
8502 else
8503  return 0x1000000*a+0x10000*b+0x100*c+d
8504 end
8505end
8506function files.readfixed2(f)
8507 local n1,n2=byte(f:read(2),1,2)
8508 if n1>=0x80 then
8509  n1=n1-0x100
8510 end
8511 return n1+n2/0xFF
8512end
8513function files.readfixed4(f)
8514 local a,b,c,d=byte(f:read(4),1,4)
8515 local n1=0x100*a+b
8516 local n2=0x100*c+d
8517 if n1>=0x8000 then
8518  n1=n1-0x10000
8519 end
8520 return n1+n2/0xFFFF
8521end
8522if bit32 then
8523 local extract=bit32.extract
8524 local band=bit32.band
8525 function files.read2dot14(f)
8526  local a,b=byte(f:read(2),1,2)
8527  if a>=0x80 then
8528   local n=-(0x100*a+b)
8529   return-(extract(n,14,2)+(band(n,0x3FFF)/16384.0))
8530  else
8531   local n=0x100*a+b
8532   return   (extract(n,14,2)+(band(n,0x3FFF)/16384.0))
8533  end
8534 end
8535end
8536function files.skipshort(f,n)
8537 f:read(2*(n or 1))
8538end
8539function files.skiplong(f,n)
8540 f:read(4*(n or 1))
8541end
8542if bit32 then
8543 local rshift=bit32.rshift
8544 function files.writecardinal2(f,n)
8545  local a=char(n%256)
8546  n=rshift(n,8)
8547  local b=char(n%256)
8548  f:write(b,a)
8549 end
8550 function files.writecardinal4(f,n)
8551  local a=char(n%256)
8552  n=rshift(n,8)
8553  local b=char(n%256)
8554  n=rshift(n,8)
8555  local c=char(n%256)
8556  n=rshift(n,8)
8557  local d=char(n%256)
8558  f:write(d,c,b,a)
8559 end
8560 function files.writecardinal2le(f,n)
8561  local a=char(n%256)
8562  n=rshift(n,8)
8563  local b=char(n%256)
8564  f:write(a,b)
8565 end
8566 function files.writecardinal4le(f,n)
8567  local a=char(n%256)
8568  n=rshift(n,8)
8569  local b=char(n%256)
8570  n=rshift(n,8)
8571  local c=char(n%256)
8572  n=rshift(n,8)
8573  local d=char(n%256)
8574  f:write(a,b,c,d)
8575 end
8576else
8577 local floor=math.floor
8578 function files.writecardinal2(f,n)
8579  local a=char(n%256)
8580  n=floor(n/256)
8581  local b=char(n%256)
8582  f:write(b,a)
8583 end
8584 function files.writecardinal4(f,n)
8585  local a=char(n%256)
8586  n=floor(n/256)
8587  local b=char(n%256)
8588  n=floor(n/256)
8589  local c=char(n%256)
8590  n=floor(n/256)
8591  local d=char(n%256)
8592  f:write(d,c,b,a)
8593 end
8594 function files.writecardinal2le(f,n)
8595  local a=char(n%256)
8596  n=floor(n/256)
8597  local b=char(n%256)
8598  f:write(a,b)
8599 end
8600 function files.writecardinal4le(f,n)
8601  local a=char(n%256)
8602  n=floor(n/256)
8603  local b=char(n%256)
8604  n=floor(n/256)
8605  local c=char(n%256)
8606  n=floor(n/256)
8607  local d=char(n%256)
8608  f:write(a,b,c,d)
8609 end
8610end
8611function files.writestring(f,s)
8612 f:write(char(byte(s,1,#s)))
8613end
8614function files.writebyte(f,b)
8615 f:write(char(b))
8616end
8617if fio and fio.readcardinal1 then
8618 files.readcardinal1=fio.readcardinal1
8619 files.readcardinal2=fio.readcardinal2
8620 files.readcardinal3=fio.readcardinal3
8621 files.readcardinal4=fio.readcardinal4
8622 files.readcardinal1le=fio.readcardinal1le or files.readcardinal1le
8623 files.readcardinal2le=fio.readcardinal2le or files.readcardinal2le
8624 files.readcardinal3le=fio.readcardinal3le or files.readcardinal3le
8625 files.readcardinal4le=fio.readcardinal4le or files.readcardinal4le
8626 files.readinteger1=fio.readinteger1
8627 files.readinteger2=fio.readinteger2
8628 files.readinteger3=fio.readinteger3
8629 files.readinteger4=fio.readinteger4
8630 files.readinteger1le=fio.readinteger1le or files.readinteger1le
8631 files.readinteger2le=fio.readinteger2le or files.readinteger2le
8632 files.readinteger3le=fio.readinteger3le or files.readinteger3le
8633 files.readinteger4le=fio.readinteger4le or files.readinteger4le
8634 files.readfixed2=fio.readfixed2
8635 files.readfixed4=fio.readfixed4
8636 files.read2dot14=fio.read2dot14
8637 files.setposition=fio.setposition
8638 files.getposition=fio.getposition
8639 files.readbyte=files.readcardinal1
8640 files.readsignedbyte=files.readinteger1
8641 files.readcardinal=files.readcardinal1
8642 files.readinteger=files.readinteger1
8643 local skipposition=fio.skipposition
8644 files.skipposition=skipposition
8645 files.readbytes=fio.readbytes
8646 files.readbytetable=fio.readbytetable
8647 function files.skipshort(f,n)
8648  skipposition(f,2*(n or 1))
8649 end
8650 function files.skiplong(f,n)
8651  skipposition(f,4*(n or 1))
8652 end
8653end
8654if fio and fio.writecardinal1 then
8655 files.writecardinal1=fio.writecardinal1
8656 files.writecardinal2=fio.writecardinal2
8657 files.writecardinal3=fio.writecardinal3
8658 files.writecardinal4=fio.writecardinal4
8659 files.writecardinal1le=fio.writecardinal1le
8660 files.writecardinal2le=fio.writecardinal2le
8661 files.writecardinal3le=fio.writecardinal3le
8662 files.writecardinal4le=fio.writecardinal4le
8663 files.writeinteger1=fio.writeinteger1 or fio.writecardinal1
8664 files.writeinteger2=fio.writeinteger2 or fio.writecardinal2
8665 files.writeinteger3=fio.writeinteger3 or fio.writecardinal3
8666 files.writeinteger4=fio.writeinteger4 or fio.writecardinal4
8667 files.writeinteger1le=files.writeinteger1le or fio.writecardinal1le
8668 files.writeinteger2le=files.writeinteger2le or fio.writecardinal2le
8669 files.writeinteger3le=files.writeinteger3le or fio.writecardinal3le
8670 files.writeinteger4le=files.writeinteger4le or fio.writecardinal4le
8671end
8672if fio and fio.readcardinaltable then
8673 files.readcardinaltable=fio.readcardinaltable
8674 files.readintegertable=fio.readintegertable
8675else
8676 local readcardinal1=files.readcardinal1
8677 local readcardinal2=files.readcardinal2
8678 local readcardinal3=files.readcardinal3
8679 local readcardinal4=files.readcardinal4
8680 function files.readcardinaltable(f,n,b)
8681  local t={}
8682   if b==1 then for i=1,n do t[i]=readcardinal1(f) end
8683  elseif b==2 then for i=1,n do t[i]=readcardinal2(f) end
8684  elseif b==3 then for i=1,n do t[i]=readcardinal3(f) end
8685  elseif b==4 then for i=1,n do t[i]=readcardinal4(f) end end
8686  return t
8687 end
8688 local readinteger1=files.readinteger1
8689 local readinteger2=files.readinteger2
8690 local readinteger3=files.readinteger3
8691 local readinteger4=files.readinteger4
8692 function files.readintegertable(f,n,b)
8693  local t={}
8694   if b==1 then for i=1,n do t[i]=readinteger1(f) end
8695  elseif b==2 then for i=1,n do t[i]=readinteger2(f) end
8696  elseif b==3 then for i=1,n do t[i]=readinteger3(f) end
8697  elseif b==4 then for i=1,n do t[i]=readinteger4(f) end end
8698  return t
8699 end
8700end
8701
8702
8703end -- of closure
8704
8705do -- create closure to overcome 200 locals limit
8706
8707package.loaded["util-sac"] = package.loaded["util-sac"] or true
8708
8709-- original size: 14107, stripped down to: 10453
8710
8711if not modules then modules={} end modules ['util-sac']={
8712 version=1.001,
8713 optimize=true,
8714 comment="companion to luat-lib.mkiv",
8715 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
8716 copyright="PRAGMA ADE / ConTeXt Development Team",
8717 license="see context related readme files"
8718}
8719local byte,sub=string.byte,string.sub
8720local tonumber=tonumber
8721utilities=utilities or {}
8722local streams={}
8723utilities.streams=streams
8724function streams.open(filename,zerobased)
8725 local f=filename and io.loaddata(filename)
8726 if f then
8727  return { f,1,#f,zerobased or false }
8728 end
8729end
8730function streams.openstring(f,zerobased)
8731 if f then
8732  return { f,1,#f,zerobased or false }
8733 end
8734end
8735function streams.getstring(f)
8736 if f then
8737  return f[1]
8738 end
8739end
8740function streams.close()
8741end
8742function streams.size(f)
8743 return f and f[3] or 0
8744end
8745streams.getsize=streams.size
8746function streams.setposition(f,i)
8747 if f[4] then
8748  if i<=0 then
8749   f[2]=1
8750  else
8751   f[2]=i+1
8752  end
8753 else
8754  if i<=1 then
8755   f[2]=1
8756  else
8757   f[2]=i
8758  end
8759 end
8760end
8761function streams.getposition(f)
8762 if f[4] then
8763  return f[2]-1
8764 else
8765  return f[2]
8766 end
8767end
8768function streams.look(f,n,chars)
8769 local b=f[2]
8770 local e=b+n-1
8771 if chars then
8772  return sub(f[1],b,e)
8773 else
8774  return byte(f[1],b,e)
8775 end
8776end
8777function streams.skip(f,n)
8778 f[2]=f[2]+n
8779end
8780function streams.readbyte(f)
8781 local i=f[2]
8782 f[2]=i+1
8783 return byte(f[1],i)
8784end
8785function streams.readbytes(f,n)
8786 local i=f[2]
8787 local j=i+n
8788 f[2]=j
8789 return byte(f[1],i,j-1)
8790end
8791function streams.readbytetable(f,n)
8792 local i=f[2]
8793 local j=i+n
8794 f[2]=j
8795 return { byte(f[1],i,j-1) }
8796end
8797function streams.skipbytes(f,n)
8798 f[2]=f[2]+n
8799end
8800function streams.readchar(f)
8801 local i=f[2]
8802 f[2]=i+1
8803 return sub(f[1],i,i)
8804end
8805function streams.readstring(f,n)
8806 local i=f[2]
8807 local j=i+n
8808 f[2]=j
8809 return sub(f[1],i,j-1)
8810end
8811function streams.readinteger1(f)  
8812 local i=f[2]
8813 f[2]=i+1
8814 local n=byte(f[1],i)
8815 if n>=0x80 then
8816  return n-0x100
8817 else
8818  return n
8819 end
8820end
8821streams.readcardinal1=streams.readbyte  
8822streams.readcardinal=streams.readcardinal1
8823streams.readinteger=streams.readinteger1
8824function streams.readcardinal2(f)
8825 local i=f[2]
8826 local j=i+1
8827 f[2]=j+1
8828 local a,b=byte(f[1],i,j)
8829 return 0x100*a+b
8830end
8831function streams.readcardinal2le(f)
8832 local i=f[2]
8833 local j=i+1
8834 f[2]=j+1
8835 local b,a=byte(f[1],i,j)
8836 return 0x100*a+b
8837end
8838function streams.readinteger2(f)
8839 local i=f[2]
8840 local j=i+1
8841 f[2]=j+1
8842 local a,b=byte(f[1],i,j)
8843 if a>=0x80 then
8844  return 0x100*a+b-0x10000
8845 else
8846  return 0x100*a+b
8847 end
8848end
8849function streams.readinteger2le(f)
8850 local i=f[2]
8851 local j=i+1
8852 f[2]=j+1
8853 local b,a=byte(f[1],i,j)
8854 if a>=0x80 then
8855  return 0x100*a+b-0x10000
8856 else
8857  return 0x100*a+b
8858 end
8859end
8860function streams.readcardinal3(f)
8861 local i=f[2]
8862 local j=i+2
8863 f[2]=j+1
8864 local a,b,c=byte(f[1],i,j)
8865 return 0x10000*a+0x100*b+c
8866end
8867function streams.readcardinal3le(f)
8868 local i=f[2]
8869 local j=i+2
8870 f[2]=j+1
8871 local c,b,a=byte(f[1],i,j)
8872 return 0x10000*a+0x100*b+c
8873end
8874function streams.readinteger3(f)
8875 local i=f[2]
8876 local j=i+3
8877 f[2]=j+1
8878 local a,b,c=byte(f[1],i,j)
8879 if a>=0x80 then
8880  return 0x10000*a+0x100*b+c-0x1000000
8881 else
8882  return 0x10000*a+0x100*b+c
8883 end
8884end
8885function streams.readinteger3le(f)
8886 local i=f[2]
8887 local j=i+3
8888 f[2]=j+1
8889 local c,b,a=byte(f[1],i,j)
8890 if a>=0x80 then
8891  return 0x10000*a+0x100*b+c-0x1000000
8892 else
8893  return 0x10000*a+0x100*b+c
8894 end
8895end
8896function streams.readcardinal4(f)
8897 local i=f[2]
8898 local j=i+3
8899 f[2]=j+1
8900 local a,b,c,d=byte(f[1],i,j)
8901 return 0x1000000*a+0x10000*b+0x100*c+d
8902end
8903function streams.readcardinal4le(f)
8904 local i=f[2]
8905 local j=i+3
8906 f[2]=j+1
8907 local d,c,b,a=byte(f[1],i,j)
8908 return 0x1000000*a+0x10000*b+0x100*c+d
8909end
8910function streams.readinteger4(f)
8911 local i=f[2]
8912 local j=i+3
8913 f[2]=j+1
8914 local a,b,c,d=byte(f[1],i,j)
8915 if a>=0x80 then
8916  return 0x1000000*a+0x10000*b+0x100*c+d-0x100000000
8917 else
8918  return 0x1000000*a+0x10000*b+0x100*c+d
8919 end
8920end
8921function streams.readinteger4le(f)
8922 local i=f[2]
8923 local j=i+3
8924 f[2]=j+1
8925 local d,c,b,a=byte(f[1],i,j)
8926 if a>=0x80 then
8927  return 0x1000000*a+0x10000*b+0x100*c+d-0x100000000
8928 else
8929  return 0x1000000*a+0x10000*b+0x100*c+d
8930 end
8931end
8932function streams.readfixed2(f)
8933 local i=f[2]
8934 local j=i+1
8935 f[2]=j+1
8936 local n1,n2=byte(f[1],i,j)
8937 if n1>=0x80 then
8938  n1=n1-0x100
8939 end
8940 return n1+n2/0xFF
8941end
8942function streams.readfixed4(f)
8943 local i=f[2]
8944 local j=i+3
8945 f[2]=j+1
8946 local a,b,c,d=byte(f[1],i,j)
8947 local n1=0x100*a+b
8948 local n2=0x100*c+d
8949 if n1>=0x8000 then
8950  n1=n1-0x10000
8951 end
8952 return n1+n2/0xFFFF
8953end
8954if bit32 then
8955 local extract=bit32.extract
8956 local band=bit32.band
8957 function streams.read2dot14(f)
8958  local i=f[2]
8959  local j=i+1
8960  f[2]=j+1
8961  local a,b=byte(f[1],i,j)
8962  if a>=0x80 then
8963   local n=-(0x100*a+b)
8964   return-(extract(n,14,2)+(band(n,0x3FFF)/16384.0))
8965  else
8966   local n=0x100*a+b
8967   return   (extract(n,14,2)+(band(n,0x3FFF)/16384.0))
8968  end
8969 end
8970end
8971function streams.skipshort(f,n)
8972 f[2]=f[2]+2*(n or 1)
8973end
8974function streams.skiplong(f,n)
8975 f[2]=f[2]+4*(n or 1)
8976end
8977if sio and sio.readcardinal2 then
8978 local readcardinal1=sio.readcardinal1
8979 local readcardinal2=sio.readcardinal2
8980 local readcardinal3=sio.readcardinal3
8981 local readcardinal4=sio.readcardinal4
8982 local readinteger1=sio.readinteger1
8983 local readinteger2=sio.readinteger2
8984 local readinteger3=sio.readinteger3
8985 local readinteger4=sio.readinteger4
8986 local readfixed2=sio.readfixed2
8987 local readfixed4=sio.readfixed4
8988 local read2dot14=sio.read2dot14
8989 local readbytes=sio.readbytes
8990 local readbytetable=sio.readbytetable
8991 function streams.readcardinal1(f)
8992  local i=f[2]
8993  f[2]=i+1
8994  return readcardinal1(f[1],i)
8995 end
8996 function streams.readcardinal2(f)
8997  local i=f[2]
8998  f[2]=i+2
8999  return readcardinal2(f[1],i)
9000 end
9001 function streams.readcardinal3(f)
9002  local i=f[2]
9003  f[2]=i+3
9004  return readcardinal3(f[1],i)
9005 end
9006 function streams.readcardinal4(f)
9007  local i=f[2]
9008  f[2]=i+4
9009  return readcardinal4(f[1],i)
9010 end
9011 function streams.readinteger1(f)
9012  local i=f[2]
9013  f[2]=i+1
9014  return readinteger1(f[1],i)
9015 end
9016 function streams.readinteger2(f)
9017  local i=f[2]
9018  f[2]=i+2
9019  return readinteger2(f[1],i)
9020 end
9021 function streams.readinteger3(f)
9022  local i=f[2]
9023  f[2]=i+3
9024  return readinteger3(f[1],i)
9025 end
9026 function streams.readinteger4(f)
9027  local i=f[2]
9028  f[2]=i+4
9029  return readinteger4(f[1],i)
9030 end
9031 function streams.readfixed2(f) 
9032  local i=f[2]
9033  f[2]=i+2
9034  return readfixed2(f[1],i)
9035 end
9036 function streams.readfixed4(f) 
9037  local i=f[2]
9038  f[2]=i+4
9039  return readfixed4(f[1],i)
9040 end
9041 function streams.read2dot14(f)
9042  local i=f[2]
9043  f[2]=i+2
9044  return read2dot14(f[1],i)
9045 end
9046 function streams.readbytes(f,n)
9047  local i=f[2]
9048  local s=f[3]
9049  local p=i+n
9050  if p>s then
9051   f[2]=s+1
9052  else
9053   f[2]=p
9054  end
9055  return readbytes(f[1],i,n)
9056 end
9057 function streams.readbytetable(f,n)
9058  local i=f[2]
9059  local s=f[3]
9060  local p=i+n
9061  if p>s then
9062   f[2]=s+1
9063  else
9064   f[2]=p
9065  end
9066  return readbytetable(f[1],i,n)
9067 end
9068 streams.readbyte=streams.readcardinal1
9069 streams.readsignedbyte=streams.readinteger1
9070 streams.readcardinal=streams.readcardinal1
9071 streams.readinteger=streams.readinteger1
9072end
9073if sio and sio.readcardinaltable then
9074 local readcardinaltable=sio.readcardinaltable
9075 local readintegertable=sio.readintegertable
9076 function utilities.streams.readcardinaltable(f,n,b)
9077  local i=f[2]
9078  local s=f[3]
9079  local p=i+n*b
9080  if p>s then
9081   f[2]=s+1
9082  else
9083   f[2]=p
9084  end
9085  return readcardinaltable(f[1],i,n,b)
9086 end
9087 function utilities.streams.readintegertable(f,n,b)
9088  local i=f[2]
9089  local s=f[3]
9090  local p=i+n*b
9091  if p>s then
9092   f[2]=s+1
9093  else
9094   f[2]=p
9095  end
9096  return readintegertable(f[1],i,n,b)
9097 end
9098else
9099 local readcardinal1=streams.readcardinal1
9100 local readcardinal2=streams.readcardinal2
9101 local readcardinal3=streams.readcardinal3
9102 local readcardinal4=streams.readcardinal4
9103 function streams.readcardinaltable(f,n,b)
9104  local i=f[2]
9105  local s=f[3]
9106  local p=i+n*b
9107  if p>s then
9108   f[2]=s+1
9109  else
9110   f[2]=p
9111  end
9112  local t={}
9113   if b==1 then for i=1,n do t[i]=readcardinal1(f[1],i) end
9114  elseif b==2 then for i=1,n do t[i]=readcardinal2(f[1],i) end
9115  elseif b==3 then for i=1,n do t[i]=readcardinal3(f[1],i) end
9116  elseif b==4 then for i=1,n do t[i]=readcardinal4(f[1],i) end end
9117  return t
9118 end
9119 local readinteger1=streams.readinteger1
9120 local readinteger2=streams.readinteger2
9121 local readinteger3=streams.readinteger3
9122 local readinteger4=streams.readinteger4
9123 function streams.readintegertable(f,n,b)
9124  local i=f[2]
9125  local s=f[3]
9126  local p=i+n*b
9127  if p>s then
9128   f[2]=s+1
9129  else
9130   f[2]=p
9131  end
9132  local t={}
9133   if b==1 then for i=1,n do t[i]=readinteger1(f[1],i) end
9134  elseif b==2 then for i=1,n do t[i]=readinteger2(f[1],i) end
9135  elseif b==3 then for i=1,n do t[i]=readinteger3(f[1],i) end
9136  elseif b==4 then for i=1,n do t[i]=readinteger4(f[1],i) end end
9137  return t
9138 end
9139end
9140do
9141 local files=utilities.files
9142 if files then
9143  local openfile=files.open
9144  local openstream=streams.open
9145  local openstring=streams.openstring
9146  local setmetatable=setmetatable
9147  function io.newreader(str,method)
9148   local f,m
9149   if method=="string" then
9150    f=openstring(str,true)
9151    m=streams
9152   elseif method=="stream" then
9153    f=openstream(str,true)
9154    m=streams
9155   else
9156    f=openfile(str,"rb")
9157    m=files
9158   end
9159   if f then
9160    local t={}
9161    setmetatable(t,{
9162     __index=function(t,k)
9163      local r=m[k]
9164      if k=="close" then
9165       if f then
9166        m.close(f)
9167        f=nil
9168       end
9169       return function() end
9170      elseif r then
9171       local v=function(_,a,b) return r(f,a,b) end
9172       t[k]=v
9173       return v
9174      else
9175       print("unknown key",k)
9176      end
9177     end
9178    } )
9179    return t
9180   end
9181  end
9182 end
9183end
9184if bit32 and not streams.tocardinal1 then
9185 local extract=bit32.extract
9186 local char=string.char
9187    streams.tocardinal1=char
9188 function streams.tocardinal2(n)   return char(extract(n,8,8),extract(n,0,8)) end
9189 function streams.tocardinal3(n)   return char(extract(n,16,8),extract(n,8,8),extract(n,0,8)) end
9190 function streams.tocardinal4(n)   return char(extract(n,24,8),extract(n,16,8),extract(n,8,8),extract(n,0,8)) end
9191    streams.tocardinal1le=char
9192 function streams.tocardinal2le(n) return char(extract(n,0,8),extract(n,8,8)) end
9193 function streams.tocardinal3le(n) return char(extract(n,0,8),extract(n,8,8),extract(n,16,8)) end
9194 function streams.tocardinal4le(n) return char(extract(n,0,8),extract(n,8,8),extract(n,16,8),extract(n,24,8)) end
9195end
9196if not streams.readcstring then
9197 local readchar=streams.readchar
9198 local concat=table.concat
9199 function streams.readcstring(f)
9200  local t={}
9201  while true do
9202   local c=readchar(f)
9203   if c and c~="\0" then
9204    t[#t+1]=c
9205   else
9206    return concat(t)
9207   end
9208  end
9209 end
9210end
9211
9212
9213end -- of closure
9214
9215do -- create closure to overcome 200 locals limit
9216
9217package.loaded["util-sto"] = package.loaded["util-sto"] or true
9218
9219-- original size: 6661, stripped down to: 3074
9220
9221if not modules then modules={} end modules ['util-sto']={
9222 version=1.001,
9223 comment="companion to luat-lib.mkiv",
9224 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
9225 copyright="PRAGMA ADE / ConTeXt Development Team",
9226 license="see context related readme files"
9227}
9228local setmetatable,getmetatable,rawset,type=setmetatable,getmetatable,rawset,type
9229utilities=utilities or {}
9230utilities.storage=utilities.storage or {}
9231local storage=utilities.storage
9232function storage.mark(t)
9233 if not t then
9234  print("\nfatal error: storage cannot be marked\n")
9235  os.exit()
9236  return
9237 end
9238 local m=getmetatable(t)
9239 if not m then
9240  m={}
9241  setmetatable(t,m)
9242 end
9243 m.__storage__=true
9244 return t
9245end
9246function storage.allocate(t)
9247 t=t or {}
9248 local m=getmetatable(t)
9249 if not m then
9250  m={}
9251  setmetatable(t,m)
9252 end
9253 m.__storage__=true
9254 return t
9255end
9256function storage.marked(t)
9257 local m=getmetatable(t)
9258 return m and m.__storage__
9259end
9260function storage.checked(t)
9261 if not t then
9262  report("\nfatal error: storage has not been allocated\n")
9263  os.exit()
9264  return
9265 end
9266 return t
9267end
9268function storage.setinitializer(data,initialize)
9269 local m=getmetatable(data) or {}
9270 m.__index=function(data,k)
9271  m.__index=nil 
9272  initialize()
9273  return data[k]
9274 end
9275 setmetatable(data,m)
9276end
9277local keyisvalue={ __index=function(t,k)
9278 t[k]=k
9279 return k
9280end }
9281function storage.sparse(t)
9282 t=t or {}
9283 setmetatable(t,keyisvalue)
9284 return t
9285end
9286local function f_empty ()         return "" end 
9287local function f_self  (t,k) t[k]=k      return k  end
9288local function f_table (t,k) local v={} t[k]=v return v  end
9289local function f_number(t,k) t[k]=0      return 0  end 
9290local function f_ignore()          end 
9291local f_index={
9292 ["empty"]=f_empty,
9293 ["self"]=f_self,
9294 ["table"]=f_table,
9295 ["number"]=f_number,
9296}
9297function table.setmetatableindex(t,f)
9298 if type(t)~="table" then
9299  f,t=t,{}
9300 end
9301 local m=getmetatable(t)
9302 local i=f_index[f] or f
9303 if m then
9304  m.__index=i
9305 else
9306  setmetatable(t,{ __index=i })
9307 end
9308 return t
9309end
9310local f_index={
9311 ["ignore"]=f_ignore,
9312}
9313function table.setmetatablenewindex(t,f)
9314 if type(t)~="table" then
9315  f,t=t,{}
9316 end
9317 local m=getmetatable(t)
9318 local i=f_index[f] or f
9319 if m then
9320  m.__newindex=i
9321 else
9322  setmetatable(t,{ __newindex=i })
9323 end
9324 return t
9325end
9326function table.setmetatablecall(t,f)
9327 if type(t)~="table" then
9328  f,t=t,{}
9329 end
9330 local m=getmetatable(t)
9331 if m then
9332  m.__call=f
9333 else
9334  setmetatable(t,{ __call=f })
9335 end
9336 return t
9337end
9338function table.setmetatableindices(t,f,n,c)
9339 if type(t)~="table" then
9340  f,t=t,{}
9341 end
9342 local m=getmetatable(t)
9343 local i=f_index[f] or f
9344 if m then
9345  m.__index=i
9346  m.__newindex=n
9347  m.__call=c
9348 else
9349  setmetatable(t,{
9350   __index=i,
9351   __newindex=n,
9352   __call=c,
9353  })
9354 end
9355 return t
9356end
9357function table.setmetatablekey(t,key,value)
9358 local m=getmetatable(t)
9359 if not m then
9360  m={}
9361  setmetatable(t,m)
9362 end
9363 m[key]=value
9364 return t
9365end
9366function table.getmetatablekey(t,key,value)
9367 local m=getmetatable(t)
9368 return m and m[key]
9369end
9370function table.makeweak(t)
9371 if not t then
9372  t={}
9373 end
9374 local m=getmetatable(t)
9375 if m then
9376  m.__mode="v"
9377 else
9378  setmetatable(t,{ __mode="v" })
9379 end
9380 return t
9381end
9382
9383
9384end -- of closure
9385
9386do -- create closure to overcome 200 locals limit
9387
9388package.loaded["util-prs"] = package.loaded["util-prs"] or true
9389
9390-- original size: 26298, stripped down to: 17137
9391
9392if not modules then modules={} end modules ['util-prs']={
9393 version=1.001,
9394 comment="companion to luat-lib.mkiv",
9395 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
9396 copyright="PRAGMA ADE / ConTeXt Development Team",
9397 license="see context related readme files"
9398}
9399local lpeg,table,string=lpeg,table,string
9400local P,R,V,S,C,Ct,Cs,Carg,Cc,Cg,Cf,Cp=lpeg.P,lpeg.R,lpeg.V,lpeg.S,lpeg.C,lpeg.Ct,lpeg.Cs,lpeg.Carg,lpeg.Cc,lpeg.Cg,lpeg.Cf,lpeg.Cp
9401local lpegmatch,lpegpatterns=lpeg.match,lpeg.patterns
9402local concat,gmatch,find=table.concat,string.gmatch,string.find
9403local tonumber,tostring,type,next,rawset=tonumber,tostring,type,next,rawset
9404local mod,div=math.mod,math.div
9405utilities=utilities or {}
9406local parsers=utilities.parsers or {}
9407utilities.parsers=parsers
9408local patterns=parsers.patterns or {}
9409parsers.patterns=patterns
9410local setmetatableindex=table.setmetatableindex
9411local sortedhash=table.sortedhash
9412local sortedkeys=table.sortedkeys
9413local tohash=table.tohash
9414local hashes={}
9415parsers.hashes=hashes
9416local digit=R("09")
9417local space=P(' ')
9418local equal=P("=")
9419local colon=P(":")
9420local comma=P(",")
9421local lbrace=P("{")
9422local rbrace=P("}")
9423local lparent=P("(")
9424local rparent=P(")")
9425local lbracket=P("[")
9426local rbracket=P("]")
9427local period=S(".")
9428local punctuation=S(".,:;")
9429local spacer=lpegpatterns.spacer
9430local whitespace=lpegpatterns.whitespace
9431local newline=lpegpatterns.newline
9432local anything=lpegpatterns.anything
9433local endofstring=lpegpatterns.endofstring
9434local nobrace=1-(lbrace+rbrace )
9435local noparent=1-(lparent+rparent)
9436local nobracket=1-(lbracket+rbracket)
9437local escape,left,right=P("\\"),P('{'),P('}')
9438lpegpatterns.balanced=P {
9439 ((escape*(left+right))+(1-(left+right))+V(2))^0,
9440 left*V(1)*right
9441}
9442local nestedbraces=P { lbrace*(nobrace+V(1))^0*rbrace }
9443local nestedparents=P { lparent*(noparent+V(1))^0*rparent }
9444local nestedbrackets=P { lbracket*(nobracket+V(1))^0*rbracket }
9445local spaces=space^0
9446local argument=Cs((lbrace/"")*((nobrace+nestedbraces)^0)*(rbrace/""))
9447local content=(1-endofstring)^0
9448lpegpatterns.nestedbraces=nestedbraces   
9449lpegpatterns.nestedparents=nestedparents  
9450lpegpatterns.nestedbrackets=nestedbrackets 
9451lpegpatterns.nested=nestedbraces   
9452lpegpatterns.argument=argument    
9453lpegpatterns.content=content  
9454local value=lbrace*C((nobrace+nestedbraces)^0)*rbrace+C((nestedbraces+(1-comma))^0)
9455local key=C((1-equal-comma)^1)
9456local pattern_a=(space+comma)^0*(key*equal*value+key*C(""))
9457local pattern_c=(space+comma)^0*(key*equal*value)
9458local pattern_d=(space+comma)^0*(key*(equal+colon)*value+key*C(""))
9459local key=C((1-space-equal-comma)^1)
9460local pattern_b=spaces*comma^0*spaces*(key*((spaces*equal*spaces*value)+C("")))
9461local hash={}
9462local function set(key,value)
9463 hash[key]=value
9464end
9465local pattern_a_s=(pattern_a/set)^1
9466local pattern_b_s=(pattern_b/set)^1
9467local pattern_c_s=(pattern_c/set)^1
9468local pattern_d_s=(pattern_d/set)^1
9469patterns.settings_to_hash_a=pattern_a_s
9470patterns.settings_to_hash_b=pattern_b_s
9471patterns.settings_to_hash_c=pattern_c_s
9472patterns.settings_to_hash_d=pattern_d_s
9473function parsers.make_settings_to_hash_pattern(set,how)
9474 if how=="strict" then
9475  return (pattern_c/set)^1
9476 elseif how=="tolerant" then
9477  return (pattern_b/set)^1
9478 else
9479  return (pattern_a/set)^1
9480 end
9481end
9482function parsers.settings_to_hash(str,existing)
9483 if not str or str=="" then
9484  return {}
9485 elseif type(str)=="table" then
9486  if existing then
9487   for k,v in next,str do
9488    existing[k]=v
9489   end
9490   return exiting
9491  else
9492   return str
9493  end
9494 else
9495  hash=existing or {}
9496  lpegmatch(pattern_a_s,str)
9497  return hash
9498 end
9499end
9500function parsers.settings_to_hash_colon_too(str)
9501 if not str or str=="" then
9502  return {}
9503 elseif type(str)=="table" then
9504  return str
9505 else
9506  hash={}
9507  lpegmatch(pattern_d_s,str)
9508  return hash
9509 end
9510end
9511function parsers.settings_to_hash_tolerant(str,existing)
9512 if not str or str=="" then
9513  return {}
9514 elseif type(str)=="table" then
9515  if existing then
9516   for k,v in next,str do
9517    existing[k]=v
9518   end
9519   return exiting
9520  else
9521   return str
9522  end
9523 else
9524  hash=existing or {}
9525  lpegmatch(pattern_b_s,str)
9526  return hash
9527 end
9528end
9529function parsers.settings_to_hash_strict(str,existing)
9530 if not str or str=="" then
9531  return nil
9532 elseif type(str)=="table" then
9533  if existing then
9534   for k,v in next,str do
9535    existing[k]=v
9536   end
9537   return exiting
9538  else
9539   return str
9540  end
9541 elseif str and str~="" then
9542  hash=existing or {}
9543  lpegmatch(pattern_c_s,str)
9544  return next(hash) and hash
9545 end
9546end
9547local separator=comma*space^0
9548local value=lbrace*C((nobrace+nestedbraces)^0)*rbrace+C((nestedbraces+(1-comma))^0)
9549local pattern=spaces*Ct(value*(separator*value)^0)
9550patterns.settings_to_array=pattern
9551function parsers.settings_to_array(str,strict)
9552 if not str or str=="" then
9553  return {}
9554 elseif type(str)=="table" then
9555  return str
9556 elseif strict then
9557  if find(str,"{",1,true) then
9558   return lpegmatch(pattern,str)
9559  else
9560   return { str }
9561  end
9562 elseif find(str,",",1,true) then
9563  return lpegmatch(pattern,str)
9564 else
9565  return { str }
9566 end
9567end
9568function parsers.settings_to_numbers(str)
9569 if not str or str=="" then
9570  return {}
9571 end
9572 if type(str)=="table" then
9573 elseif find(str,",",1,true) then
9574  str=lpegmatch(pattern,str)
9575 else
9576  return { tonumber(str) }
9577 end
9578 for i=1,#str do
9579  str[i]=tonumber(str[i])
9580 end
9581 return str
9582end
9583local value=lbrace*C((nobrace+nestedbraces)^0)*rbrace+C((nestedbraces+nestedbrackets+nestedparents+(1-comma))^0)
9584local pattern=spaces*Ct(value*(separator*value)^0)
9585function parsers.settings_to_array_obey_fences(str)
9586 return lpegmatch(pattern,str)
9587end
9588local cache_a={}
9589local cache_b={}
9590function parsers.groupedsplitat(symbol,withaction)
9591 if not symbol then
9592  symbol=","
9593 end
9594 local pattern=(withaction and cache_b or cache_a)[symbol]
9595 if not pattern then
9596  local symbols=S(symbol)
9597  local separator=space^0*symbols*space^0
9598  local value=lbrace*C((nobrace+nestedbraces)^0)
9599*(rbrace*(#symbols+P(-1))) 
9600+C((nestedbraces+(1-(space^0*(symbols+P(-1)))))^0)
9601  if withaction then
9602   local withvalue=Carg(1)*value/function(f,s) return f(s) end
9603   pattern=spaces*withvalue*(separator*withvalue)^0
9604   cache_b[symbol]=pattern
9605  else
9606   pattern=spaces*Ct(value*(separator*value)^0)
9607   cache_a[symbol]=pattern
9608  end
9609 end
9610 return pattern
9611end
9612local pattern_a=parsers.groupedsplitat(",",false)
9613local pattern_b=parsers.groupedsplitat(",",true)
9614function parsers.stripped_settings_to_array(str)
9615 if not str or str=="" then
9616  return {}
9617 else
9618  return lpegmatch(pattern_a,str)
9619 end
9620end
9621function parsers.process_stripped_settings(str,action)
9622 if not str or str=="" then
9623  return {}
9624 else
9625  return lpegmatch(pattern_b,str,1,action)
9626 end
9627end
9628local function set(t,v)
9629 t[#t+1]=v
9630end
9631local value=P(Carg(1)*value)/set
9632local pattern=value*(separator*value)^0*Carg(1)
9633function parsers.add_settings_to_array(t,str)
9634 return lpegmatch(pattern,str,nil,t)
9635end
9636function parsers.hash_to_string(h,separator,yes,no,strict,omit)
9637 if h then
9638  local t={}
9639  local tn=0
9640  local s=sortedkeys(h)
9641  omit=omit and tohash(omit)
9642  for i=1,#s do
9643   local key=s[i]
9644   if not omit or not omit[key] then
9645    local value=h[key]
9646    if type(value)=="boolean" then
9647     if yes and no then
9648      if value then
9649       tn=tn+1
9650       t[tn]=key..'='..yes
9651      elseif not strict then
9652       tn=tn+1
9653       t[tn]=key..'='..no
9654      end
9655     elseif value or not strict then
9656      tn=tn+1
9657      t[tn]=key..'='..tostring(value)
9658     end
9659    else
9660     tn=tn+1
9661     t[tn]=key..'='..value
9662    end
9663   end
9664  end
9665  return concat(t,separator or ",")
9666 else
9667  return ""
9668 end
9669end
9670function parsers.array_to_string(a,separator)
9671 if a then
9672  return concat(a,separator or ",")
9673 else
9674  return ""
9675 end
9676end
9677local pattern=Cf(Ct("")*Cg(C((1-S(", "))^1)*S(", ")^0*Cc(true))^1,rawset)
9678function parsers.settings_to_set(str)
9679 return str and lpegmatch(pattern,str) or {}
9680end
9681hashes.settings_to_set=table.setmetatableindex(function(t,k) 
9682 local v=k and lpegmatch(pattern,k) or {}
9683 t[k]=v
9684 return v
9685end)
9686function parsers.settings_to_set(str)
9687 return str and lpegmatch(pattern,str) or {}
9688end
9689local pattern=Ct((C((1-S(", "))^1)*S(", ")^0)^1)
9690hashes.settings_to_list=table.setmetatableindex(function(t,k) 
9691 local v=k and lpegmatch(pattern,k) or {}
9692 t[k]=v
9693 return v
9694end)
9695getmetatable(hashes.settings_to_set ).__mode="kv" 
9696getmetatable(hashes.settings_to_list).__mode="kv" 
9697function parsers.simple_hash_to_string(h,separator)
9698 local t={}
9699 local tn=0
9700 for k,v in sortedhash(h) do
9701  if v then
9702   tn=tn+1
9703   t[tn]=k
9704  end
9705 end
9706 return concat(t,separator or ",")
9707end
9708local str=Cs(lpegpatterns.unquoted)+C((1-whitespace-equal)^1)
9709local setting=Cf(Carg(1)*(whitespace^0*Cg(str*whitespace^0*(equal*whitespace^0*str+Cc(""))))^1,rawset)
9710local splitter=setting^1
9711function parsers.options_to_hash(str,target)
9712 return str and lpegmatch(splitter,str,1,target or {}) or {}
9713end
9714local splitter=lpeg.tsplitat(" ")
9715function parsers.options_to_array(str)
9716 return str and lpegmatch(splitter,str) or {}
9717end
9718local value=P(lbrace*C((nobrace+nestedbraces)^0)*rbrace)+C(digit^1*lparent*(noparent+nestedparents)^1*rparent)+C((nestedbraces+(1-comma))^1)+Cc("") 
9719local pattern_a=spaces*Ct(value*(separator*value)^0)
9720local function repeater(n,str)
9721 if not n then
9722  return str
9723 else
9724  local s=lpegmatch(pattern_a,str)
9725  if n==1 then
9726   return unpack(s)
9727  else
9728   local t={}
9729   local tn=0
9730   for i=1,n do
9731    for j=1,#s do
9732     tn=tn+1
9733     t[tn]=s[j]
9734    end
9735   end
9736   return unpack(t)
9737  end
9738 end
9739end
9740local value=P(lbrace*C((nobrace+nestedbraces)^0)*rbrace)+(C(digit^1)/tonumber*lparent*Cs((noparent+nestedparents)^1)*rparent)/repeater+C((nestedbraces+(1-comma))^1)+Cc("") 
9741local pattern_b=spaces*Ct(value*(separator*value)^0)
9742function parsers.settings_to_array_with_repeat(str,expand) 
9743 if expand then
9744  return lpegmatch(pattern_b,str) or {}
9745 else
9746  return lpegmatch(pattern_a,str) or {}
9747 end
9748end
9749local value=lbrace*C((nobrace+nestedbraces)^0)*rbrace
9750local pattern=Ct((space+value)^0)
9751function parsers.arguments_to_table(str)
9752 return lpegmatch(pattern,str)
9753end
9754function parsers.getparameters(self,class,parentclass,settings)
9755 local sc=self[class]
9756 if not sc then
9757  sc={}
9758  self[class]=sc
9759  if parentclass then
9760   local sp=self[parentclass]
9761   if not sp then
9762    sp={}
9763    self[parentclass]=sp
9764   end
9765   setmetatableindex(sc,sp)
9766  end
9767 end
9768 parsers.settings_to_hash(settings,sc)
9769end
9770function parsers.listitem(str)
9771 return gmatch(str,"[^, ]+")
9772end
9773local pattern=Cs { "start",
9774 start=V("one")+V("two")+V("three"),
9775 rest=(Cc(",")*V("thousand"))^0*(P(".")+endofstring)*anything^0,
9776 thousand=digit*digit*digit,
9777 one=digit*V("rest"),
9778 two=digit*digit*V("rest"),
9779 three=V("thousand")*V("rest"),
9780}
9781lpegpatterns.splitthousands=pattern 
9782function parsers.splitthousands(str)
9783 return lpegmatch(pattern,str) or str
9784end
9785local optionalwhitespace=whitespace^0
9786lpegpatterns.words=Ct((Cs((1-punctuation-whitespace)^1)+anything)^1)
9787lpegpatterns.sentences=Ct((optionalwhitespace*Cs((1-period)^0*period))^1)
9788lpegpatterns.paragraphs=Ct((optionalwhitespace*Cs((whitespace^1*endofstring/""+1-(spacer^0*newline*newline))^1))^1)
9789local dquote=P('"')
9790local equal=P('=')
9791local escape=P('\\')
9792local separator=S(' ,')
9793local key=C((1-equal)^1)
9794local value=dquote*C((1-dquote-escape*dquote)^0)*dquote
9795local pattern=Cf(Ct("")*(Cg(key*equal*value)*separator^0)^1,rawset)^0*P(-1)
9796function parsers.keq_to_hash(str)
9797 if str and str~="" then
9798  return lpegmatch(pattern,str)
9799 else
9800  return {}
9801 end
9802end
9803local defaultspecification={ separator=",",quote='"' }
9804function parsers.csvsplitter(specification)
9805 specification=specification and setmetatableindex(specification,defaultspecification) or defaultspecification
9806 local separator=specification.separator
9807 local quotechar=specification.quote
9808 local numbers=specification.numbers
9809 local separator=S(separator~="" and separator or ",")
9810 local whatever=C((1-separator-newline)^0)
9811 if quotechar and quotechar~="" then
9812  local quotedata=nil
9813  for chr in gmatch(quotechar,".") do
9814   local quotechar=P(chr)
9815   local quoteitem=(1-quotechar)^0
9816   local quoteword=quotechar*(numbers and (quoteitem/tonumber) or C(quoteitem))*quotechar
9817   if quotedata then
9818    quotedata=quotedata+quoteword
9819   else
9820    quotedata=quoteword
9821   end
9822  end
9823  whatever=quotedata+whatever
9824 end
9825 local parser=Ct((Ct(whatever*(separator*whatever)^0)*S("\n\r")^1)^0 )
9826 return function(data)
9827  return lpegmatch(parser,data)
9828 end
9829end
9830function parsers.rfc4180splitter(specification)
9831 specification=specification and setmetatableindex(specification,defaultspecification) or defaultspecification
9832 local numbers=specification.numbers
9833 local separator=specification.separator 
9834 local quotechar=P(specification.quote)  
9835 local dquotechar=quotechar*quotechar   
9836/specification.quote
9837 local separator=S(separator~="" and separator or ",")
9838 local whatever=(dquotechar+(1-quotechar))^0
9839 local escaped=quotechar*(numbers and (whatever/tonumber) or Cs(whatever))*quotechar
9840 local non_escaped=C((1-quotechar-newline-separator)^1)
9841 local field=escaped+non_escaped+Cc("")
9842 local record=Ct(field*(separator*field)^1)
9843 local headerline=record*Cp()
9844 local morerecords=(newline^(specification.strict and -1 or 1)*record)^0
9845 local headeryes=Ct(morerecords)
9846 local headernop=Ct(record*morerecords)
9847 return function(data,getheader)
9848  if getheader then
9849   local header,position=lpegmatch(headerline,data)
9850   local data=lpegmatch(headeryes,data,position)
9851   return data,header
9852  else
9853   return lpegmatch(headernop,data)
9854  end
9855 end
9856end
9857local function ranger(first,last,n,action)
9858 if not first then
9859 elseif last==true then
9860  for i=first,n or first do
9861   action(i)
9862  end
9863 elseif last then
9864  for i=first,last do
9865   action(i)
9866  end
9867 else
9868  action(first)
9869 end
9870end
9871local cardinal=(lpegpatterns.hexadecimal+lpegpatterns.cardinal)/tonumber
9872local spacers=lpegpatterns.spacer^0
9873local endofstring=lpegpatterns.endofstring
9874local stepper=spacers*(cardinal*(spacers*S(":-")*spacers*(cardinal+Cc(true) )+Cc(false) )*Carg(1)*Carg(2)/ranger*S(", ")^0 )^1
9875local stepper=spacers*(cardinal*(spacers*S(":-")*spacers*(cardinal+(P("*")+endofstring)*Cc(true) )+Cc(false) )*Carg(1)*Carg(2)/ranger*S(", ")^0 )^1*endofstring 
9876function parsers.stepper(str,n,action)
9877 local ts=type(str)
9878 if type(n)=="function" then
9879  if ts=="number" then
9880   n(str)
9881  elseif ts=="table" then
9882   for i=1,#str do
9883    n(str[i])
9884   end
9885  else
9886   lpegmatch(stepper,str,1,false,n or print)
9887  end
9888 elseif ts=="string" then
9889  lpegmatch(stepper,str,1,n,action or print)
9890 end
9891end
9892local pattern_math=Cs((P("%")/"\\percent "+P("^")*Cc("{")*lpegpatterns.integer*Cc("}")+anything)^0)
9893local pattern_text=Cs((P("%")/"\\percent "+(P("^")/"\\high")*Cc("{")*lpegpatterns.integer*Cc("}")+anything)^0)
9894patterns.unittotex=pattern
9895function parsers.unittotex(str,textmode)
9896 return lpegmatch(textmode and pattern_text or pattern_math,str)
9897end
9898local pattern=Cs((P("^")/"<sup>"*lpegpatterns.integer*Cc("</sup>")+anything)^0)
9899function parsers.unittoxml(str)
9900 return lpegmatch(pattern,str)
9901end
9902local cache={}
9903local spaces=lpegpatterns.space^0
9904local dummy=function() end
9905setmetatableindex(cache,function(t,k)
9906 local separator=S(k) 
9907 local value=(1-separator)^0
9908 local pattern=spaces*C(value)*separator^0*Cp()
9909 t[k]=pattern
9910 return pattern
9911end)
9912local commalistiterator=cache[","]
9913function parsers.iterator(str,separator)
9914 local n=#str
9915 if n==0 then
9916  return dummy
9917 else
9918  local pattern=separator and cache[separator] or commalistiterator
9919  local p=1
9920  return function()
9921   if p<=n then
9922    local s,e=lpegmatch(pattern,str,p)
9923    if e then
9924     p=e
9925     return s
9926    end
9927   end
9928  end
9929 end
9930end
9931local function initialize(t,name)
9932 local source=t[name]
9933 if source then
9934  local result={}
9935  for k,v in next,t[name] do
9936   result[k]=v
9937  end
9938  return result
9939 else
9940  return {}
9941 end
9942end
9943local function fetch(t,name)
9944 return t[name] or {}
9945end
9946local function process(result,more)
9947 for k,v in next,more do
9948  result[k]=v
9949 end
9950 return result
9951end
9952local name=C((1-S(", "))^1)
9953local parser=(Carg(1)*name/initialize)*(S(", ")^1*(Carg(1)*name/fetch))^0
9954local merge=Cf(parser,process)
9955function parsers.mergehashes(hash,list)
9956 return lpegmatch(merge,list,1,hash)
9957end
9958function parsers.runtime(time)
9959 if not time then
9960  time=os.runtime()
9961 end
9962 local days=div(time,24*60*60)
9963 time=mod(time,24*60*60)
9964 local hours=div(time,60*60)
9965 time=mod(time,60*60)
9966 local minutes=div(time,60)
9967 local seconds=mod(time,60)
9968 return days,hours,minutes,seconds
9969end
9970local spacing=whitespace^0
9971local apply=P("->")
9972local method=C((1-apply)^1)
9973local token=lbrace*C((1-rbrace)^1)*rbrace+C(anything^1)
9974local pattern=spacing*(method*spacing*apply+Carg(1))*spacing*token
9975function parsers.splitmethod(str,default)
9976 if str then
9977  return lpegmatch(pattern,str,1,default or false)
9978 else
9979  return default or false,""
9980 end
9981end
9982local p_year=lpegpatterns.digit^4/tonumber
9983local pattern=Cf(Ct("")*(
9984  (Cg(Cc("year")*p_year)*S("-/")*Cg(Cc("month")*cardinal)*S("-/")*Cg(Cc("day")*cardinal)
9985  )+(Cg(Cc("day")*cardinal)*S("-/")*Cg(Cc("month")*cardinal)*S("-/")*Cg(Cc("year")*p_year)
9986  )+(Cg(Cc("year")*p_year)*S("-/")*Cg(Cc("month")*cardinal)
9987  )+(Cg(Cc("month")*cardinal)*S("-/")*Cg(Cc("year")*p_year)
9988  )
9989 )*(
9990   P(" ")*Cg(Cc("hour")*cardinal)*P(":")*Cg(Cc("min")*cardinal)*(P(":")*Cg(Cc("sec")*cardinal))^-1+P(-1) )
9991,rawset)
9992lpegpatterns.splittime=pattern
9993function parsers.totime(str)
9994 return lpegmatch(pattern,str)
9995end
9996
9997
9998end -- of closure
9999
10000do -- create closure to overcome 200 locals limit
10001
10002package.loaded["util-fmt"] = package.loaded["util-fmt"] or true
10003
10004-- original size: 3379, stripped down to: 2273
10005
10006if not modules then modules={} end modules ['util-fmt']={
10007 version=1.001,
10008 comment="companion to luat-lib.mkiv",
10009 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
10010 copyright="PRAGMA ADE / ConTeXt Development Team",
10011 license="see context related readme files"
10012}
10013utilities=utilities or {}
10014utilities.formatters=utilities.formatters or {}
10015local formatters=utilities.formatters
10016local concat,format=table.concat,string.format
10017local tostring,type,unpack=tostring,type,unpack
10018local strip=string.strip
10019local lpegmatch=lpeg.match
10020local stripper=lpeg.patterns.stripzeros
10021function formatters.stripzeros(str)
10022 return lpegmatch(stripper,str)
10023end
10024function formatters.formatcolumns(result,between,header)
10025 if result and #result>0 then
10026  local widths={}
10027  local numbers={}
10028  local templates={}
10029  local first=result[1]
10030  local n=#first
10031     between=between or "   "
10032  for i=1,n do
10033   widths[i]=0
10034  end
10035  for i=1,#result do
10036   local r=result[i]
10037   for j=1,n do
10038    local rj=r[j]
10039    local tj=type(rj)
10040    if tj=="number" then
10041     numbers[j]=true
10042     rj=tostring(rj)
10043    elseif tj~="string" then
10044     rj=tostring(rj)
10045     r[j]=rj
10046    end
10047    local w=#rj
10048    if w>widths[j] then
10049     widths[j]=w
10050    end
10051   end
10052  end
10053  if header then
10054   for i=1,#header do
10055    local h=header[i]
10056    for j=1,n do
10057     local hj=tostring(h[j])
10058     h[j]=hj
10059     local w=#hj
10060     if w>widths[j] then
10061      widths[j]=w
10062     end
10063    end
10064   end
10065  end
10066  for i=1,n do
10067   local w=widths[i]
10068   if numbers[i] then
10069    if w>80 then
10070     templates[i]="%s"..between
10071    else
10072     templates[i]="% "..w.."i"..between
10073    end
10074   else
10075    if w>80 then
10076     templates[i]="%s"..between
10077    elseif w>0 then
10078     templates[i]="%-"..w.."s"..between
10079    else
10080     templates[i]="%s"
10081    end
10082   end
10083  end
10084  local template=strip(concat(templates))
10085  for i=1,#result do
10086   local str=format(template,unpack(result[i]))
10087   result[i]=strip(str)
10088  end
10089  if header then
10090   for i=1,n do
10091    local w=widths[i]
10092    if w>80 then
10093     templates[i]="%s"..between
10094    elseif w>0 then
10095     templates[i]="%-"..w.."s"..between
10096    else
10097     templates[i]="%s"
10098    end
10099   end
10100   local template=strip(concat(templates))
10101   for i=1,#header do
10102    local str=format(template,unpack(header[i]))
10103    header[i]=strip(str)
10104   end
10105  end
10106 end
10107 return result,header
10108end
10109
10110
10111end -- of closure
10112
10113do -- create closure to overcome 200 locals limit
10114
10115package.loaded["util-soc-imp-reset"] = package.loaded["util-soc-imp-reset"] or true
10116
10117-- original size: 374, stripped down to: 282
10118
10119local loaded=package.loaded
10120loaded["socket"]=nil
10121loaded["copas"]=nil
10122loaded["ltn12"]=nil
10123loaded["mbox"]=nil
10124loaded["mime"]=nil
10125loaded["socket.url"]=nil
10126loaded["socket.headers"]=nil
10127loaded["socket.tp"]=nil
10128loaded["socket.http"]=nil
10129loaded["socket.ftp"]=nil
10130loaded["socket.smtp"]=nil
10131
10132
10133end -- of closure
10134
10135do -- create closure to overcome 200 locals limit
10136
10137package.loaded["util-soc-imp-socket"] = package.loaded["util-soc-imp-socket"] or true
10138
10139-- original size: 4905, stripped down to: 3562
10140
10141
10142local type,tostring,setmetatable=type,tostring,setmetatable
10143local min=math.min
10144local format=string.format
10145local socket=socket or package.loaded.socket or require("socket.core")
10146local connect=socket.connect
10147local tcp4=socket.tcp4
10148local tcp6=socket.tcp6
10149local getaddrinfo=socket.dns.getaddrinfo
10150local defaulthost="0.0.0.0"
10151local function report(fmt,first,...)
10152 if logs then
10153  report=logs and logs.reporter("socket")
10154  report(fmt,first,...)
10155 elseif fmt then
10156  fmt="socket: "..fmt
10157  if first then
10158   print(format(fmt,first,...))
10159  else
10160   print(fmt)
10161  end
10162 end
10163end
10164socket.report=report
10165function socket.connect4(address,port,laddress,lport)
10166 return connect(address,port,laddress,lport,"inet")
10167end
10168function socket.connect6(address,port,laddress,lport)
10169 return connect(address,port,laddress,lport,"inet6")
10170end
10171function socket.bind(host,port,backlog)
10172 if host=="*" or host=="" then
10173  host=defaulthost
10174 end
10175 local addrinfo,err=getaddrinfo(host)
10176 if not addrinfo then
10177  return nil,err
10178 end
10179 for i=1,#addrinfo do
10180  local alt=addrinfo[i]
10181  local sock,err=(alt.family=="inet" and tcp4 or tcp6)()
10182  if not sock then
10183   return nil,err or "unknown error"
10184  end
10185  sock:setoption("reuseaddr",true)
10186  local res,err=sock:bind(alt.addr,port)
10187  if res then
10188   res,err=sock:listen(backlog)
10189   if res then
10190    return sock
10191   else
10192    sock:close()
10193   end
10194  else
10195   sock:close()
10196  end
10197 end
10198 return nil,"invalid address"
10199end
10200socket.try=socket.newtry()
10201function socket.choose(list)
10202 return function(name,opt1,opt2)
10203  if type(name)~="string" then
10204   name,opt1,opt2="default",name,opt1
10205  end
10206  local f=list[name or "nil"]
10207  if f then
10208   return f(opt1,opt2)
10209  else
10210   report("error: unknown key '%s'",tostring(name))
10211  end
10212 end
10213end
10214local sourcet={}
10215local sinkt={}
10216socket.sourcet=sourcet
10217socket.sinkt=sinkt
10218socket.BLOCKSIZE=2048
10219sinkt["close-when-done"]=function(sock)
10220 return setmetatable (
10221  {
10222   getfd=function() return sock:getfd() end,
10223   dirty=function() return sock:dirty() end,
10224  },
10225  {
10226   __call=function(self,chunk,err)
10227    if chunk then
10228     return sock:send(chunk)
10229    else
10230     sock:close()
10231     return 1 
10232    end
10233   end
10234  }
10235 )
10236end
10237sinkt["keep-open"]=function(sock)
10238 return setmetatable (
10239  {
10240   getfd=function() return sock:getfd() end,
10241   dirty=function() return sock:dirty() end,
10242  },{
10243   __call=function(self,chunk,err)
10244    if chunk then
10245     return sock:send(chunk)
10246    else
10247     return 1 
10248    end
10249   end
10250  }
10251 )
10252end
10253sinkt["default"]=sinkt["keep-open"]
10254socket.sink=socket.choose(sinkt)
10255sourcet["by-length"]=function(sock,length)
10256 local blocksize=socket.BLOCKSIZE
10257 return setmetatable (
10258  {
10259   getfd=function() return sock:getfd() end,
10260   dirty=function() return sock:dirty() end,
10261  },
10262  {
10263   __call=function()
10264    if length<=0 then
10265     return nil
10266    end
10267    local chunk,err=sock:receive(min(blocksize,length))
10268    if err then
10269     return nil,err
10270    end
10271    length=length-#chunk
10272    return chunk
10273   end
10274  }
10275 )
10276end
10277sourcet["until-closed"]=function(sock)
10278 local blocksize=socket.BLOCKSIZE
10279 local done=false
10280 return setmetatable (
10281  {
10282   getfd=function() return sock:getfd() end,
10283   dirty=function() return sock:dirty() end,
10284  },{
10285   __call=function()
10286    if done then
10287     return nil
10288    end
10289    local chunk,status,partial=sock:receive(blocksize)
10290    if not status then
10291     return chunk
10292    elseif status=="closed" then
10293     sock:close()
10294     done=true
10295     return partial
10296    else
10297     return nil,status
10298    end
10299   end
10300  }
10301 )
10302end
10303sourcet["default"]=sourcet["until-closed"]
10304socket.source=socket.choose(sourcet)
10305_G.socket=socket 
10306package.loaded["socket"]=socket
10307
10308
10309end -- of closure
10310
10311do -- create closure to overcome 200 locals limit
10312
10313package.loaded["util-soc-imp-copas"] = package.loaded["util-soc-imp-copas"] or true
10314
10315-- original size: 26186, stripped down to: 14893
10316
10317
10318local socket=socket or require("socket")
10319local ssl=ssl or nil 
10320local WATCH_DOG_TIMEOUT=120
10321local UDP_DATAGRAM_MAX=8192
10322local type,next,pcall,getmetatable,tostring=type,next,pcall,getmetatable,tostring
10323local min,max,random=math.min,math.max,math.random
10324local find=string.find
10325local insert,remove=table.insert,table.remove
10326local gettime=socket.gettime
10327local selectsocket=socket.select
10328local createcoroutine=coroutine.create
10329local resumecoroutine=coroutine.resume
10330local yieldcoroutine=coroutine.yield
10331local runningcoroutine=coroutine.running
10332local function report(fmt,first,...)
10333 if logs then
10334  report=logs and logs.reporter("copas")
10335  report(fmt,first,...)
10336 elseif fmt then
10337  fmt="copas: "..fmt
10338  if first then
10339   print(format(fmt,first,...))
10340  else
10341   print(fmt)
10342  end
10343 end
10344end
10345local copas={
10346 _COPYRIGHT="Copyright (C) 2005-2016 Kepler Project",
10347 _DESCRIPTION="Coroutine Oriented Portable Asynchronous Services",
10348 _VERSION="Copas 2.0.1",
10349 autoclose=true,
10350 running=false,
10351 report=report,
10352 trace=false,
10353}
10354local function statushandler(status,...)
10355 if status then
10356  return...
10357 end
10358 local err=(...)
10359 if type(err)=="table" then
10360  err=err[1]
10361 end
10362 if copas.trace then
10363  report("error: %s",tostring(err))
10364 end
10365 return nil,err
10366end
10367function socket.protect(func)
10368 return function(...)
10369  return statushandler(pcall(func,...))
10370 end
10371end
10372function socket.newtry(finalizer)
10373 return function (...)
10374  local status=(...)
10375  if not status then
10376   local detail=select(2,...)
10377   pcall(finalizer,detail)
10378   if copas.trace then
10379    report("error: %s",tostring(detail))
10380   end
10381   return
10382  end
10383  return...
10384 end
10385end
10386local function newset()
10387 local reverse={}
10388 local set={}
10389 local queue={}
10390 setmetatable(set,{
10391  __index={
10392   insert=function(set,value)
10393     if not reverse[value] then
10394      local n=#set+1
10395      set[n]=value
10396      reverse[value]=n
10397     end
10398    end,
10399   remove=function(set,value)
10400     local index=reverse[value]
10401     if index then
10402      reverse[value]=nil
10403      local n=#set
10404      local top=set[n]
10405      set[n]=nil
10406      if top~=value then
10407       reverse[top]=index
10408       set[index]=top
10409      end
10410     end
10411    end,
10412   push=function (set,key,itm)
10413     local entry=queue[key]
10414     if entry==nil then 
10415      queue[key]={ itm }
10416     else
10417      entry[#entry+1]=itm
10418     end
10419    end,
10420   pop=function (set,key)
10421     local top=queue[key]
10422     if top~=nil then
10423      local ret=remove(top,1)
10424      if top[1]==nil then
10425       queue[key]=nil
10426      end
10427      return ret
10428     end
10429    end
10430  }
10431 } )
10432 return set
10433end
10434local _sleeping={
10435 times={},
10436 cos={},
10437 lethargy={},
10438 insert=function()
10439  end,
10440 remove=function()
10441  end,
10442 push=function(self,sleeptime,co)
10443   if not co then
10444    return
10445   end
10446   if sleeptime<0 then
10447    self.lethargy[co]=true
10448    return
10449   else
10450    sleeptime=gettime()+sleeptime
10451   end
10452   local t=self.times
10453   local c=self.cos
10454   local i=1
10455   local n=#t
10456   while i<=n and t[i]<=sleeptime do
10457    i=i+1
10458   end
10459   insert(t,i,sleeptime)
10460   insert(c,i,co)
10461  end,
10462 getnext=
10463  function(self)
10464   local t=self.times
10465   local delay=t[1] and t[1]-gettime() or nil
10466   return delay and max(delay,0) or nil
10467  end,
10468 pop=
10469  function(self,time)
10470   local t=self.times
10471   local c=self.cos
10472   if #t==0 or time<t[1] then
10473    return
10474   end
10475   local co=c[1]
10476   remove(t,1)
10477   remove(c,1)
10478   return co
10479  end,
10480  wakeup=function(self,co)
10481    local let=self.lethargy
10482    if let[co] then
10483     self:push(0,co)
10484     let[co]=nil
10485    else
10486     local c=self.cos
10487     local t=self.times
10488     for i=1,#c do
10489      if c[i]==co then
10490       remove(c,i)
10491       remove(t,i)
10492       self:push(0,co)
10493       return
10494      end
10495     end
10496    end
10497   end
10498}
10499local _servers=newset() 
10500local _reading=newset() 
10501local _writing=newset() 
10502local _reading_log={}
10503local _writing_log={}
10504local _is_timeout={  
10505 timeout=true,
10506 wantread=true,
10507 wantwrite=true,
10508}
10509local function isTCP(socket)
10510 return not find(tostring(socket),"^udp")
10511end
10512local function copasreceive(client,pattern,part)
10513 if not pattern or pattern=="" then
10514  pattern="*l"
10515 end
10516 local current_log=_reading_log
10517 local s,err
10518 repeat
10519  s,err,part=client:receive(pattern,part)
10520  if s or (not _is_timeout[err]) then
10521   current_log[client]=nil
10522   return s,err,part
10523  end
10524  if err=="wantwrite" then
10525   current_log=_writing_log
10526   current_log[client]=gettime()
10527   yieldcoroutine(client,_writing)
10528  else
10529   current_log=_reading_log
10530   current_log[client]=gettime()
10531   yieldcoroutine(client,_reading)
10532  end
10533 until false
10534end
10535local function copasreceivefrom(client,size)
10536 local s,err,port
10537 if not size or size==0 then
10538  size=UDP_DATAGRAM_MAX
10539 end
10540 repeat
10541  s,err,port=client:receivefrom(size)
10542  if s or err~="timeout" then
10543   _reading_log[client]=nil
10544   return s,err,port
10545  end
10546  _reading_log[client]=gettime()
10547  yieldcoroutine(client,_reading)
10548 until false
10549end
10550local function copasreceivepartial(client,pattern,part)
10551 if not pattern or pattern=="" then
10552  pattern="*l"
10553 end
10554 local logger=_reading_log
10555 local queue=_reading
10556 local s,err
10557 repeat
10558  s,err,part=client:receive(pattern,part)
10559  if s or (type(pattern)=="number" and part~="" and part) or not _is_timeout[err] then
10560    logger[client]=nil
10561    return s,err,part
10562  end
10563  if err=="wantwrite" then
10564   logger=_writing_log
10565   queue=_writing
10566  else
10567   logger=_reading_log
10568   queue=_reading
10569  end
10570  logger[client]=gettime()
10571  yieldcoroutine(client,queue)
10572 until false
10573end
10574local function copassend(client,data,from,to)
10575 if not from then
10576  from=1
10577 end
10578 local lastIndex=from-1
10579 local logger=_writing_log
10580 local queue=_writing
10581 local s,err
10582 repeat
10583  s,err,lastIndex=client:send(data,lastIndex+1,to)
10584  if random(100)>90 then
10585   logger[client]=gettime()
10586   yieldcoroutine(client,queue)
10587  end
10588  if s or not _is_timeout[err] then
10589   logger[client]=nil
10590   return s,err,lastIndex
10591  end
10592  if err=="wantread" then
10593   logger=_reading_log
10594   queue=_reading
10595  else
10596   logger=_writing_log
10597   queue=_writing
10598  end
10599  logger[client]=gettime()
10600  yieldcoroutine(client,queue)
10601 until false
10602end
10603local function copassendto(client,data,ip,port)
10604 repeat
10605  local s,err=client:sendto(data,ip,port)
10606  if random(100)>90 then
10607   _writing_log[client]=gettime()
10608   yieldcoroutine(client,_writing)
10609  end
10610  if s or err~="timeout" then
10611   _writing_log[client]=nil
10612   return s,err
10613  end
10614  _writing_log[client]=gettime()
10615  yieldcoroutine(client,_writing)
10616 until false
10617end
10618local function copasconnect(skt,host,port)
10619 skt:settimeout(0)
10620 local ret,err,tried_more_than_once
10621 repeat
10622  ret,err=skt:connect (host,port)
10623  if ret or (err~="timeout" and err~="Operation already in progress") then
10624   if not ret and err=="already connected" and tried_more_than_once then
10625    ret=1
10626    err=nil
10627   end
10628   _writing_log[skt]=nil
10629   return ret,err
10630  end
10631  tried_more_than_once=tried_more_than_once or true
10632  _writing_log[skt]=gettime()
10633  yieldcoroutine(skt,_writing)
10634 until false
10635end
10636local function copasdohandshake(skt,sslt) 
10637 if not ssl then
10638  ssl=require("ssl")
10639 end
10640 if not ssl then
10641  report("error: no ssl library")
10642  return
10643 end
10644 local nskt,err=ssl.wrap(skt,sslt)
10645 if not nskt then
10646  report("error: %s",tostring(err))
10647  return
10648 end
10649 nskt:settimeout(0)
10650 local queue
10651 repeat
10652  local success,err=nskt:dohandshake()
10653  if success then
10654   return nskt
10655  elseif err=="wantwrite" then
10656   queue=_writing
10657  elseif err=="wantread" then
10658   queue=_reading
10659  else
10660   report("error: %s",tostring(err))
10661   return
10662  end
10663  yieldcoroutine(nskt,queue)
10664 until false
10665end
10666local function copasflush(client)
10667end
10668copas.connect=copassconnect
10669copas.send=copassend
10670copas.sendto=copassendto
10671copas.receive=copasreceive
10672copas.receivefrom=copasreceivefrom
10673copas.copasreceivepartial=copasreceivepartial
10674copas.copasreceivePartial=copasreceivepartial
10675copas.dohandshake=copasdohandshake
10676copas.flush=copasflush
10677local function _skt_mt_tostring(self)
10678 return tostring(self.socket).." (copas wrapped)"
10679end
10680local _skt_mt_tcp_index={
10681 send=function(self,data,from,to)
10682   return copassend (self.socket,data,from,to)
10683  end,
10684 receive=function (self,pattern,prefix)
10685   if self.timeout==0 then
10686    return copasreceivePartial(self.socket,pattern,prefix)
10687   else
10688    return copasreceive(self.socket,pattern,prefix)
10689   end
10690  end,
10691 flush=function (self)
10692   return copasflush(self.socket)
10693  end,
10694 settimeout=function (self,time)
10695   self.timeout=time
10696   return true
10697  end,
10698 connect=function(self,...)
10699   local res,err=copasconnect(self.socket,...)
10700   if res and self.ssl_params then
10701    res,err=self:dohandshake()
10702   end
10703   return res,err
10704  end,
10705 close=function(self,...)
10706   return self.socket:close(...)
10707  end,
10708 bind=function(self,...)
10709   return self.socket:bind(...)
10710  end,
10711 getsockname=function(self,...)
10712   return self.socket:getsockname(...)
10713  end,
10714 getstats=function(self,...)
10715   return self.socket:getstats(...)
10716  end,
10717 setstats=function(self,...)
10718   return self.socket:setstats(...)
10719  end,
10720 listen=function(self,...)
10721   return self.socket:listen(...)
10722  end,
10723 accept=function(self,...)
10724   return self.socket:accept(...)
10725  end,
10726 setoption=function(self,...)
10727   return self.socket:setoption(...)
10728  end,
10729 getpeername=function(self,...)
10730   return self.socket:getpeername(...)
10731  end,
10732 shutdown=function(self,...)
10733   return self.socket:shutdown(...)
10734  end,
10735 dohandshake=function(self,sslt)
10736   self.ssl_params=sslt or self.ssl_params
10737   local nskt,err=copasdohandshake(self.socket,self.ssl_params)
10738   if not nskt then
10739    return nskt,err
10740   end
10741   self.socket=nskt
10742   return self
10743  end,
10744}
10745local _skt_mt_tcp={
10746 __tostring=_skt_mt_tostring,
10747 __index=_skt_mt_tcp_index,
10748}
10749local _skt_mt_udp_index={
10750 sendto=function (self,...)
10751   return copassendto(self.socket,...)
10752  end,
10753 receive=function (self,size)
10754   return copasreceive(self.socket,size or UDP_DATAGRAM_MAX)
10755  end,
10756 receivefrom=function (self,size)
10757   return copasreceivefrom(self.socket,size or UDP_DATAGRAM_MAX)
10758  end,
10759 setpeername=function(self,...)
10760   return self.socket:getpeername(...)
10761  end,
10762 setsockname=function(self,...)
10763   return self.socket:setsockname(...)
10764  end,
10765 close=function(self,...)
10766   return true
10767  end
10768}
10769local _skt_mt_udp={
10770 __tostring=_skt_mt_tostring,
10771 __index=_skt_mt_udp_index,
10772}
10773for k,v in next,_skt_mt_tcp_index do
10774 if not _skt_mt_udp_index[k] then
10775  _skt_mt_udp_index[k]=v
10776 end
10777end
10778local function wrap(skt,sslt)
10779 if getmetatable(skt)==_skt_mt_tcp or getmetatable(skt)==_skt_mt_udp then
10780  return skt 
10781 end
10782 skt:settimeout(0)
10783 if isTCP(skt) then
10784  return setmetatable ({ socket=skt,ssl_params=sslt },_skt_mt_tcp)
10785 else
10786  return setmetatable ({ socket=skt },_skt_mt_udp)
10787 end
10788end
10789copas.wrap=wrap
10790function copas.handler(handler,sslparams)
10791 return function (skt,...)
10792  skt=wrap(skt)
10793  if sslparams then
10794   skt:dohandshake(sslparams)
10795  end
10796  return handler(skt,...)
10797 end
10798end
10799local _errhandlers={}
10800function copas.setErrorHandler(err)
10801 local co=runningcoroutine()
10802 if co then
10803  _errhandlers[co]=err
10804 end
10805end
10806local function _deferror (msg,co,skt)
10807 report("%s (%s) (%s)",msg,tostring(co),tostring(skt))
10808end
10809local function _doTick (co,skt,...)
10810 if not co then
10811  return
10812 end
10813 local ok,res,new_q=resumecoroutine(co,skt,...)
10814 if ok and res and new_q then
10815  new_q:insert(res)
10816  new_q:push(res,co)
10817 else
10818  if not ok then
10819   pcall(_errhandlers[co] or _deferror,res,co,skt)
10820  end
10821  if skt and copas.autoclose and isTCP(skt) then
10822   skt:close()
10823  end
10824  _errhandlers[co]=nil
10825 end
10826end
10827local function _accept(input,handler)
10828 local client=input:accept()
10829 if client then
10830  client:settimeout(0)
10831  local co=createcoroutine(handler)
10832  _doTick (co,client)
10833 end
10834 return client
10835end
10836local function _tickRead(skt)
10837 _doTick(_reading:pop(skt),skt)
10838end
10839local function _tickWrite(skt)
10840 _doTick(_writing:pop(skt),skt)
10841end
10842local function addTCPserver(server,handler,timeout)
10843 server:settimeout(timeout or 0)
10844 _servers[server]=handler
10845 _reading:insert(server)
10846end
10847local function addUDPserver(server,handler,timeout)
10848 server:settimeout(timeout or 0)
10849 local co=createcoroutine(handler)
10850 _reading:insert(server)
10851 _doTick(co,server)
10852end
10853function copas.addserver(server,handler,timeout)
10854 if isTCP(server) then
10855  addTCPserver(server,handler,timeout)
10856 else
10857  addUDPserver(server,handler,timeout)
10858 end
10859end
10860function copas.removeserver(server,keep_open)
10861 local s=server
10862 local mt=getmetatable(server)
10863 if mt==_skt_mt_tcp or mt==_skt_mt_udp then
10864  s=server.socket
10865 end
10866 _servers[s]=nil
10867 _reading:remove(s)
10868 if keep_open then
10869  return true
10870 end
10871 return server:close()
10872end
10873function copas.addthread(handler,...)
10874 local thread=createcoroutine(function(_,...) return handler(...) end)
10875 _doTick(thread,nil,...)
10876 return thread
10877end
10878local _tasks={}
10879local function addtaskRead(task)
10880 task.def_tick=_tickRead
10881 _tasks[task]=true
10882end
10883local function addtaskWrite(task)
10884 task.def_tick=_tickWrite
10885 _tasks[task]=true
10886end
10887local function tasks()
10888 return next,_tasks
10889end
10890local _readable_t={
10891 events=function(self)
10892   local i=0
10893   return function ()
10894    i=i+1
10895    return self._evs[i]
10896   end
10897  end,
10898 tick=function(self,input)
10899   local handler=_servers[input]
10900   if handler then
10901    input=_accept(input,handler)
10902   else
10903    _reading:remove(input)
10904    self.def_tick(input)
10905   end
10906  end
10907}
10908addtaskRead(_readable_t)
10909local _writable_t={
10910 events=function(self)
10911   local i=0
10912   return function()
10913    i=i+1
10914    return self._evs[i]
10915   end
10916  end,
10917 tick=function(self,output)
10918   _writing:remove(output)
10919   self.def_tick(output)
10920  end
10921}
10922addtaskWrite(_writable_t)
10923local _sleeping_t={
10924 tick=function(self,time,...)
10925  _doTick(_sleeping:pop(time),...)
10926 end
10927}
10928function copas.sleep(sleeptime)
10929 yieldcoroutine((sleeptime or 0),_sleeping)
10930end
10931function copas.wakeup(co)
10932 _sleeping:wakeup(co)
10933end
10934local last_cleansing=0
10935local function _select(timeout)
10936 local now=gettime()
10937 local r_evs,w_evs,err=selectsocket(_reading,_writing,timeout)
10938 _readable_t._evs=r_evs
10939 _writable_t._evs=w_evs
10940 if (last_cleansing-now)>WATCH_DOG_TIMEOUT then
10941  last_cleansing=now
10942  for skt,time in next,_reading_log do
10943   if not r_evs[skt] and (time-now)>WATCH_DOG_TIMEOUT then
10944    local n=#r_evs+1
10945    _reading_log[skt]=nil
10946    r_evs[n]=skt
10947    r_evs[skt]=n
10948   end
10949  end
10950  for skt,time in next,_writing_log do
10951   if not w_evs[skt] and (time-now)>WATCH_DOG_TIMEOUT then
10952    local n=#w_evs+1
10953    _writing_log[skt]=nil
10954    w_evs[n]=skt
10955    w_evs[skt]=n
10956   end
10957  end
10958 end
10959 if err=="timeout" and #r_evs+#w_evs>0 then
10960  return nil
10961 else
10962  return err
10963 end
10964end
10965local function copasfinished()
10966 return not (next(_reading) or next(_writing) or _sleeping:getnext())
10967end
10968local function copasstep(timeout)
10969 _sleeping_t:tick(gettime())
10970 local nextwait=_sleeping:getnext()
10971 if nextwait then
10972  timeout=timeout and min(nextwait,timeout) or nextwait
10973 elseif copasfinished() then
10974  return false
10975 end
10976 local err=_select(timeout)
10977 if err then
10978  if err=="timeout" then
10979   return false
10980  end
10981  return nil,err
10982 end
10983 for task in tasks() do
10984  for event in task:events() do
10985   task:tick(event)
10986  end
10987 end
10988 return true
10989end
10990copas.finished=copasfinished
10991copas.step=copasstep
10992function copas.loop(timeout)
10993 copas.running=true
10994 while not copasfinished() do
10995  copasstep(timeout)
10996 end
10997 copas.running=false
10998end
10999package.loaded["copas"]=copas
11000
11001
11002end -- of closure
11003
11004do -- create closure to overcome 200 locals limit
11005
11006package.loaded["util-soc-imp-ltn12"] = package.loaded["util-soc-imp-ltn12"] or true
11007
11008-- original size: 8709, stripped down to: 5411
11009
11010
11011local select,unpack=select,unpack
11012local insert,remove=table.insert,table.remove
11013local sub=string.sub
11014local function report(fmt,first,...)
11015 if logs then
11016  report=logs and logs.reporter("ltn12")
11017  report(fmt,first,...)
11018 elseif fmt then
11019  fmt="ltn12: "..fmt
11020  if first then
11021   print(format(fmt,first,...))
11022  else
11023   print(fmt)
11024  end
11025 end
11026end
11027local filter={}
11028local source={}
11029local sink={}
11030local pump={}
11031local ltn12={
11032 _VERSION="LTN12 1.0.3",
11033 BLOCKSIZE=2048,
11034 filter=filter,
11035 source=source,
11036 sink=sink,
11037 pump=pump,
11038 report=report,
11039}
11040function filter.cycle(low,ctx,extra)
11041 if low then
11042  return function(chunk)
11043   return (low(ctx,chunk,extra))
11044  end
11045 end
11046end
11047function filter.chain(...)
11048 local arg={... }
11049 local n=select('#',...)
11050 local top=1
11051 local index=1
11052 local retry=""
11053 return function(chunk)
11054  retry=chunk and retry
11055  while true do
11056   local action=arg[index]
11057   if index==top then
11058    chunk=action(chunk)
11059    if chunk=="" or top==n then
11060     return chunk
11061    elseif chunk then
11062     index=index+1
11063    else
11064     top=top+1
11065     index=top
11066    end
11067   else
11068    chunk=action(chunk or "")
11069    if chunk=="" then
11070     index=index-1
11071     chunk=retry
11072    elseif chunk then
11073     if index==n then
11074      return chunk
11075     else
11076      index=index+1
11077     end
11078    else
11079     report("error: filter returned inappropriate 'nil'")
11080     return
11081    end
11082   end
11083  end
11084 end
11085end
11086local function empty()
11087 return nil
11088end
11089function source.empty()
11090 return empty
11091end
11092local function sourceerror(err)
11093 return function()
11094  return nil,err
11095 end
11096end
11097source.error=sourceerror
11098function source.file(handle,io_err)
11099 if handle then
11100  local blocksize=ltn12.BLOCKSIZE
11101  return function()
11102   local chunk=handle:read(blocksize)
11103   if not chunk then
11104    handle:close()
11105   end
11106   return chunk
11107  end
11108 else
11109  return sourceerror(io_err or "unable to open file")
11110 end
11111end
11112function source.simplify(src)
11113 return function()
11114  local chunk,err_or_new=src()
11115  if err_or_new then
11116   src=err_or_new
11117  end
11118  if chunk then
11119   return chunk
11120  else
11121   return nil,err_or_new
11122  end
11123 end
11124end
11125function source.string(s)
11126 if s then
11127  local blocksize=ltn12.BLOCKSIZE
11128  local i=1
11129  return function()
11130   local nexti=i+blocksize
11131   local chunk=sub(s,i,nexti-1)
11132   i=nexti
11133   if chunk~="" then
11134    return chunk
11135   else
11136    return nil
11137   end
11138  end
11139 else return source.empty() end
11140end
11141function source.rewind(src)
11142 local t={}
11143 return function(chunk)
11144  if chunk then
11145   insert(t,chunk)
11146  else
11147   chunk=remove(t)
11148   if chunk then
11149    return chunk
11150   else
11151    return src()
11152   end
11153  end
11154 end
11155end
11156function source.chain(src,f,...)
11157 if... then
11158  f=filter.chain(f,...)
11159 end
11160 local last_in=""
11161 local last_out=""
11162 local state="feeding"
11163 local err
11164 return function()
11165  if not last_out then
11166   report("error: source is empty")
11167   return
11168  end
11169  while true do
11170   if state=="feeding" then
11171    last_in,err=src()
11172    if err then
11173     return nil,err
11174    end
11175    last_out=f(last_in)
11176    if not last_out then
11177     if last_in then
11178      report("error: filter returned inappropriate 'nil'")
11179     end
11180     return nil
11181    elseif last_out~="" then
11182     state="eating"
11183     if last_in then
11184      last_in=""
11185     end
11186     return last_out
11187    end
11188   else
11189    last_out=f(last_in)
11190    if last_out=="" then
11191     if last_in=="" then
11192      state="feeding"
11193     else
11194      report("error: filter returned nothing")
11195      return
11196     end
11197    elseif not last_out then
11198     if last_in then
11199      report("filter returned inappropriate 'nil'")
11200     end
11201     return nil
11202    else
11203     return last_out
11204    end
11205   end
11206  end
11207 end
11208end
11209function source.cat(...)
11210 local arg={... }
11211 local src=remove(arg,1)
11212 return function()
11213  while src do
11214   local chunk,err=src()
11215   if chunk then
11216    return chunk
11217   end
11218   if err then
11219    return nil,err
11220   end
11221   src=remove(arg,1)
11222  end
11223 end
11224end
11225function sink.table(t)
11226 if not t then
11227  t={}
11228 end
11229 local f=function(chunk,err)
11230  if chunk then
11231   insert(t,chunk)
11232  end
11233  return 1
11234 end
11235 return f,t
11236end
11237function sink.simplify(snk)
11238 return function(chunk,err)
11239  local ret,err_or_new=snk(chunk,err)
11240  if not ret then
11241   return nil,err_or_new
11242  end
11243  if err_or_new then
11244   snk=err_or_new
11245  end
11246  return 1
11247 end
11248end
11249local function null()
11250 return 1
11251end
11252function sink.null()
11253 return null
11254end
11255local function sinkerror(err)
11256 return function()
11257  return nil,err
11258 end
11259end
11260sink.error=sinkerror
11261function sink.file(handle,io_err)
11262 if handle then
11263  return function(chunk,err)
11264   if not chunk then
11265    handle:close()
11266    return 1
11267   else
11268    return handle:write(chunk)
11269   end
11270  end
11271 else
11272  return sinkerror(io_err or "unable to open file")
11273 end
11274end
11275function sink.chain(f,snk,...)
11276 if... then
11277  local args={ f,snk,... }
11278  snk=remove(args,#args)
11279  f=filter.chain(unpack(args))
11280 end
11281 return function(chunk,err)
11282  if chunk~="" then
11283   local filtered=f(chunk)
11284   local done=chunk and ""
11285   while true do
11286    local ret,snkerr=snk(filtered,err)
11287    if not ret then
11288     return nil,snkerr
11289    end
11290    if filtered==done then
11291     return 1
11292    end
11293    filtered=f(done)
11294   end
11295  else
11296   return 1
11297  end
11298 end
11299end
11300function pump.step(src,snk)
11301 local chunk,src_err=src()
11302 local ret,snk_err=snk(chunk,src_err)
11303 if chunk and ret then
11304  return 1
11305 else
11306  return nil,src_err or snk_err
11307 end
11308end
11309function pump.all(src,snk,step)
11310 if not step then
11311  step=pump.step
11312 end
11313 while true do
11314  local ret,err=step(src,snk)
11315  if not ret then
11316   if err then
11317    return nil,err
11318   else
11319    return 1
11320   end
11321  end
11322 end
11323end
11324package.loaded["ltn12"]=ltn12
11325
11326
11327end -- of closure
11328
11329do -- create closure to overcome 200 locals limit
11330
11331package.loaded["util-soc-imp-mime"] = package.loaded["util-soc-imp-mime"] or true
11332
11333-- original size: 2373, stripped down to: 1931
11334
11335
11336local type,tostring=type,tostring
11337local mime=mime  or package.loaded.mime  or require("mime.core")
11338local ltn12=ltn12 or package.loaded.ltn12 or require("ltn12")
11339local filtercycle=ltn12.filter.cycle
11340local function report(fmt,first,...)
11341 if logs then
11342  report=logs and logs.reporter("mime")
11343  report(fmt,first,...)
11344 elseif fmt then
11345  fmt="mime: "..fmt
11346  if first then
11347   print(format(fmt,first,...))
11348  else
11349   print(fmt)
11350  end
11351 end
11352end
11353mime.report=report
11354local encodet={}
11355local decodet={}
11356local wrapt={}
11357mime.encodet=encodet
11358mime.decodet=decodet
11359mime.wrapt=wrapt
11360local mime_b64=mime.b64
11361local mime_qp=mime.qp
11362local mime_unb64=mime.unb64
11363local mime_unqp=mime.unqp
11364local mime_wrp=mime.wrp
11365local mime_qpwrp=mime.qpwrp
11366local mime_eol=mime_eol
11367local mime_dot=mime_dot
11368encodet['base64']=function()
11369 return filtercycle(mime_b64,"")
11370end
11371encodet['quoted-printable']=function(mode)
11372 return filtercycle(mime_qp,"",mode=="binary" and "=0D=0A" or "\r\n")
11373end
11374decodet['base64']=function()
11375 return filtercycle(mime_unb64,"")
11376end
11377decodet['quoted-printable']=function()
11378 return filtercycle(mime_unqp,"")
11379end
11380local wraptext=function(length)
11381 if not length then
11382  length=76
11383 end
11384 return filtercycle(mime_wrp,length,length)
11385end
11386local wrapquoted=function()
11387 return filtercycle(mime_qpwrp,76,76)
11388end
11389wrapt['text']=wraptext
11390wrapt['base64']=wraptext
11391wrapt['default']=wraptext
11392wrapt['quoted-printable']=wrapquoted
11393function mime.normalize(marker)
11394 return filtercycle(mime_eol,0,marker)
11395end
11396function mime.stuff()
11397 return filtercycle(mime_dot,2)
11398end
11399local function choose(list)
11400 return function(name,opt1,opt2)
11401  if type(name)~="string" then
11402   name,opt1,opt2="default",name,opt1
11403  end
11404  local filter=list[name or "nil"]
11405  if filter then
11406   return filter(opt1,opt2)
11407  else
11408   report("error: unknown key '%s'",tostring(name))
11409  end
11410 end
11411end
11412mime.encode=choose(encodet)
11413mime.decode=choose(decodet)
11414mime.wrap=choose(wrapt)
11415package.loaded["mime"]=mime
11416
11417
11418end -- of closure
11419
11420do -- create closure to overcome 200 locals limit
11421
11422package.loaded["util-soc-imp-url"] = package.loaded["util-soc-imp-url"] or true
11423
11424-- original size: 6863, stripped down to: 5269
11425
11426
11427local tonumber,tostring,type=tonumber,tostring,type
11428local gsub,sub,match,find,format,byte,char=string.gsub,string.sub,string.match,string.find,string.format,string.byte,string.char
11429local insert=table.insert
11430local socket=socket or require("socket")
11431local url={
11432 _VERSION="URL 1.0.3",
11433}
11434socket.url=url
11435function url.escape(s)
11436 return (gsub(s,"([^A-Za-z0-9_])",function(c)
11437  return format("%%%02x",byte(c))
11438 end))
11439end
11440local function make_set(t) 
11441 local s={}
11442 for i=1,#t do
11443  s[t[i]]=true
11444 end
11445 return s
11446end
11447local segment_set=make_set {
11448 "-","_",".","!","~","*","'","(",
11449 ")",":","@","&","=","+","$",",",
11450}
11451local function protect_segment(s)
11452 return gsub(s,"([^A-Za-z0-9_])",function(c)
11453  if segment_set[c] then
11454   return c
11455  else
11456   return format("%%%02X",byte(c))
11457  end
11458 end)
11459end
11460function url.unescape(s)
11461 return (gsub(s,"%%(%x%x)",function(hex)
11462  return char(tonumber(hex,16))
11463 end))
11464end
11465local function absolute_path(base_path,relative_path)
11466 if find(relative_path,"^/") then
11467  return relative_path
11468 end
11469 local path=gsub(base_path,"[^/]*$","")
11470 path=path..relative_path
11471 path=gsub(path,"([^/]*%./)",function (s)
11472  if s~="./" then
11473   return s
11474  else
11475   return ""
11476  end
11477 end)
11478 path=gsub(path,"/%.$","/")
11479 local reduced
11480 while reduced~=path do
11481  reduced=path
11482  path=gsub(reduced,"([^/]*/%.%./)",function (s)
11483   if s~="../../" then
11484    return ""
11485   else
11486    return s
11487   end
11488  end)
11489 end
11490 path=gsub(reduced,"([^/]*/%.%.)$",function (s)
11491  if s~="../.." then
11492   return ""
11493  else
11494   return s
11495  end
11496 end)
11497 return path
11498end
11499function url.parse(url,default)
11500 local parsed={}
11501 for k,v in next,default or parsed do
11502  parsed[k]=v
11503 end
11504 if not url or url=="" then
11505  return nil,"invalid url"
11506 end
11507 url=gsub(url,"#(.*)$",function(f)
11508  parsed.fragment=f
11509  return ""
11510 end)
11511 url=gsub(url,"^([%w][%w%+%-%.]*)%:",function(s)
11512  parsed.scheme=s
11513  return ""
11514 end)
11515 url=gsub(url,"^//([^/]*)",function(n)
11516  parsed.authority=n
11517  return ""
11518 end)
11519 url=gsub(url,"%?(.*)",function(q)
11520  parsed.query=q
11521  return ""
11522 end)
11523 url=gsub(url,"%;(.*)",function(p)
11524  parsed.params=p
11525  return ""
11526 end)
11527 if url~="" then
11528  parsed.path=url
11529 end
11530 local authority=parsed.authority
11531 if not authority then
11532  return parsed
11533 end
11534 authority=gsub(authority,"^([^@]*)@",function(u)
11535  parsed.userinfo=u
11536  return ""
11537 end)
11538 authority=gsub(authority,":([^:%]]*)$",function(p)
11539  parsed.port=p
11540  return ""
11541 end)
11542 if authority~="" then
11543  parsed.host=match(authority,"^%[(.+)%]$") or authority
11544 end
11545 local userinfo=parsed.userinfo
11546 if not userinfo then
11547  return parsed
11548 end
11549 userinfo=gsub(userinfo,":([^:]*)$",function(p)
11550  parsed.password=p
11551  return ""
11552 end)
11553 parsed.user=userinfo
11554 return parsed
11555end
11556function url.build(parsed)
11557 local url=parsed.path or ""
11558 if parsed.params then
11559  url=url..";"..parsed.params
11560 end
11561 if parsed.query then
11562  url=url.."?"..parsed.query
11563 end
11564 local authority=parsed.authority
11565 if parsed.host then
11566  authority=parsed.host
11567  if find(authority,":") then 
11568   authority="["..authority.."]"
11569  end
11570  if parsed.port then
11571   authority=authority..":"..tostring(parsed.port)
11572  end
11573  local userinfo=parsed.userinfo
11574  if parsed.user then
11575   userinfo=parsed.user
11576   if parsed.password then
11577    userinfo=userinfo..":"..parsed.password
11578   end
11579  end
11580  if userinfo then authority=userinfo.."@"..authority end
11581 end
11582 if authority then
11583  url="//"..authority..url
11584 end
11585 if parsed.scheme then
11586  url=parsed.scheme..":"..url
11587 end
11588 if parsed.fragment then
11589  url=url.."#"..parsed.fragment
11590 end
11591 return url
11592end
11593function url.absolute(base_url,relative_url)
11594 local base_parsed
11595 if type(base_url)=="table" then
11596  base_parsed=base_url
11597  base_url=url.build(base_parsed)
11598 else
11599  base_parsed=url.parse(base_url)
11600 end
11601 local relative_parsed=url.parse(relative_url)
11602 if not base_parsed then
11603  return relative_url
11604 elseif not relative_parsed then
11605  return base_url
11606 elseif relative_parsed.scheme then
11607  return relative_url
11608 else
11609  relative_parsed.scheme=base_parsed.scheme
11610  if not relative_parsed.authority then
11611   relative_parsed.authority=base_parsed.authority
11612   if not relative_parsed.path then
11613    relative_parsed.path=base_parsed.path
11614    if not relative_parsed.params then
11615     relative_parsed.params=base_parsed.params
11616     if not relative_parsed.query then
11617      relative_parsed.query=base_parsed.query
11618     end
11619    end
11620   else
11621    relative_parsed.path=absolute_path(base_parsed.path or "",relative_parsed.path)
11622   end
11623  end
11624  return url.build(relative_parsed)
11625 end
11626end
11627function url.parse_path(path)
11628 local parsed={}
11629 path=path or ""
11630 gsub(path,"([^/]+)",function (s)
11631  insert(parsed,s)
11632 end)
11633 for i=1,#parsed do
11634  parsed[i]=url.unescape(parsed[i])
11635 end
11636 if sub(path,1,1)=="/" then
11637  parsed.is_absolute=1
11638 end
11639 if sub(path,-1,-1)=="/" then
11640  parsed.is_directory=1
11641 end
11642 return parsed
11643end
11644function url.build_path(parsed,unsafe)
11645 local path=""
11646 local n=#parsed
11647 if unsafe then
11648  for i=1,n-1 do
11649   path=path..parsed[i].."/"
11650  end
11651  if n>0 then
11652   path=path..parsed[n]
11653   if parsed.is_directory then
11654    path=path.."/"
11655   end
11656  end
11657 else
11658  for i=1,n-1 do
11659   path=path..protect_segment(parsed[i]).."/"
11660  end
11661  if n>0 then
11662   path=path..protect_segment(parsed[n])
11663   if parsed.is_directory then
11664    path=path.."/"
11665   end
11666  end
11667 end
11668 if parsed.is_absolute then
11669  path="/"..path
11670 end
11671 return path
11672end
11673package.loaded["socket.url"]=url
11674
11675
11676end -- of closure
11677
11678do -- create closure to overcome 200 locals limit
11679
11680package.loaded["util-soc-imp-headers"] = package.loaded["util-soc-imp-headers"] or true
11681
11682-- original size: 5721, stripped down to: 3754
11683
11684
11685local next=next
11686local lower=string.lower
11687local concat=table.concat
11688local socket=socket or require("socket")
11689local headers={}
11690socket.headers=headers
11691local canonic={
11692 ["accept"]="Accept",
11693 ["accept-charset"]="Accept-Charset",
11694 ["accept-encoding"]="Accept-Encoding",
11695 ["accept-language"]="Accept-Language",
11696 ["accept-ranges"]="Accept-Ranges",
11697 ["action"]="Action",
11698 ["alternate-recipient"]="Alternate-Recipient",
11699 ["age"]="Age",
11700 ["allow"]="Allow",
11701 ["arrival-date"]="Arrival-Date",
11702 ["authorization"]="Authorization",
11703 ["bcc"]="Bcc",
11704 ["cache-control"]="Cache-Control",
11705 ["cc"]="Cc",
11706 ["comments"]="Comments",
11707 ["connection"]="Connection",
11708 ["content-description"]="Content-Description",
11709 ["content-disposition"]="Content-Disposition",
11710 ["content-encoding"]="Content-Encoding",
11711 ["content-id"]="Content-ID",
11712 ["content-language"]="Content-Language",
11713 ["content-length"]="Content-Length",
11714 ["content-location"]="Content-Location",
11715 ["content-md5"]="Content-MD5",
11716 ["content-range"]="Content-Range",
11717 ["content-transfer-encoding"]="Content-Transfer-Encoding",
11718 ["content-type"]="Content-Type",
11719 ["cookie"]="Cookie",
11720 ["date"]="Date",
11721 ["diagnostic-code"]="Diagnostic-Code",
11722 ["dsn-gateway"]="DSN-Gateway",
11723 ["etag"]="ETag",
11724 ["expect"]="Expect",
11725 ["expires"]="Expires",
11726 ["final-log-id"]="Final-Log-ID",
11727 ["final-recipient"]="Final-Recipient",
11728 ["from"]="From",
11729 ["host"]="Host",
11730 ["if-match"]="If-Match",
11731 ["if-modified-since"]="If-Modified-Since",
11732 ["if-none-match"]="If-None-Match",
11733 ["if-range"]="If-Range",
11734 ["if-unmodified-since"]="If-Unmodified-Since",
11735 ["in-reply-to"]="In-Reply-To",
11736 ["keywords"]="Keywords",
11737 ["last-attempt-date"]="Last-Attempt-Date",
11738 ["last-modified"]="Last-Modified",
11739 ["location"]="Location",
11740 ["max-forwards"]="Max-Forwards",
11741 ["message-id"]="Message-ID",
11742 ["mime-version"]="MIME-Version",
11743 ["original-envelope-id"]="Original-Envelope-ID",
11744 ["original-recipient"]="Original-Recipient",
11745 ["pragma"]="Pragma",
11746 ["proxy-authenticate"]="Proxy-Authenticate",
11747 ["proxy-authorization"]="Proxy-Authorization",
11748 ["range"]="Range",
11749 ["received"]="Received",
11750 ["received-from-mta"]="Received-From-MTA",
11751 ["references"]="References",
11752 ["referer"]="Referer",
11753 ["remote-mta"]="Remote-MTA",
11754 ["reply-to"]="Reply-To",
11755 ["reporting-mta"]="Reporting-MTA",
11756 ["resent-bcc"]="Resent-Bcc",
11757 ["resent-cc"]="Resent-Cc",
11758 ["resent-date"]="Resent-Date",
11759 ["resent-from"]="Resent-From",
11760 ["resent-message-id"]="Resent-Message-ID",
11761 ["resent-reply-to"]="Resent-Reply-To",
11762 ["resent-sender"]="Resent-Sender",
11763 ["resent-to"]="Resent-To",
11764 ["retry-after"]="Retry-After",
11765 ["return-path"]="Return-Path",
11766 ["sender"]="Sender",
11767 ["server"]="Server",
11768 ["smtp-remote-recipient"]="SMTP-Remote-Recipient",
11769 ["status"]="Status",
11770 ["subject"]="Subject",
11771 ["te"]="TE",
11772 ["to"]="To",
11773 ["trailer"]="Trailer",
11774 ["transfer-encoding"]="Transfer-Encoding",
11775 ["upgrade"]="Upgrade",
11776 ["user-agent"]="User-Agent",
11777 ["vary"]="Vary",
11778 ["via"]="Via",
11779 ["warning"]="Warning",
11780 ["will-retry-until"]="Will-Retry-Until",
11781 ["www-authenticate"]="WWW-Authenticate",
11782 ["x-mailer"]="X-Mailer",
11783}
11784headers.canonic=setmetatable(canonic,{
11785 __index=function(t,k)
11786  socket.report("invalid header: %s",k)
11787  t[k]=k
11788  return k
11789 end
11790})
11791function headers.normalize(headers)
11792 if not headers then
11793  return {}
11794 end
11795 local normalized={}
11796 for k,v in next,headers do
11797  normalized[#normalized+1]=canonic[k]..": "..v
11798 end
11799 normalized[#normalized+1]=""
11800 normalized[#normalized+1]=""
11801 return concat(normalized,"\r\n")
11802end
11803function headers.lower(lowered,headers)
11804 if not lowered then
11805  return {}
11806 end
11807 if not headers then
11808  lowered,headers={},lowered
11809 end
11810 for k,v in next,headers do
11811  lowered[lower(k)]=v
11812 end
11813 return lowered
11814end
11815socket.headers=headers
11816package.loaded["socket.headers"]=headers
11817
11818
11819end -- of closure
11820
11821do -- create closure to overcome 200 locals limit
11822
11823package.loaded["util-soc-imp-tp"] = package.loaded["util-soc-imp-tp"] or true
11824
11825-- original size: 3116, stripped down to: 2533
11826
11827
11828local setmetatable,next,type,tonumber=setmetatable,next,type,tonumber
11829local find,upper=string.find,string.upper
11830local socket=socket or require("socket")
11831local ltn12=ltn12  or require("ltn12")
11832local skipsocket=socket.skip
11833local sinksocket=socket.sink
11834local tcpsocket=socket.tcp
11835local ltn12pump=ltn12.pump
11836local pumpall=ltn12pump.all
11837local pumpstep=ltn12pump.step
11838local tp={
11839 TIMEOUT=60,
11840}
11841socket.tp=tp
11842local function get_reply(c)
11843 local line,err=c:receive()
11844 local reply=line
11845 if err then return
11846  nil,err
11847 end
11848 local code,sep=skipsocket(2,find(line,"^(%d%d%d)(.?)"))
11849 if not code then
11850  return nil,"invalid server reply"
11851 end
11852 if sep=="-" then
11853  local current
11854  repeat
11855   line,err=c:receive()
11856   if err then
11857    return nil,err
11858   end
11859   current,sep=skipsocket(2,find(line,"^(%d%d%d)(.?)"))
11860   reply=reply.."\n"..line
11861  until code==current and sep==" "
11862 end
11863 return code,reply
11864end
11865local methods={}
11866local mt={ __index=methods }
11867function methods.getpeername(self)
11868 return self.c:getpeername()
11869end
11870function methods.getsockname(self)
11871 return self.c:getpeername()
11872end
11873function methods.check(self,ok)
11874 local code,reply=get_reply(self.c)
11875 if not code then
11876  return nil,reply
11877 end
11878 local c=tonumber(code)
11879 local t=type(ok)
11880 if t=="function" then
11881  return ok(c,reply)
11882 elseif t=="table" then
11883  for i=1,#ok do
11884   if find(code,ok[i]) then
11885    return c,reply
11886   end
11887  end
11888  return nil,reply
11889 elseif find(code,ok) then
11890  return c,reply
11891 else
11892  return nil,reply
11893 end
11894end
11895function methods.command(self,cmd,arg)
11896 cmd=upper(cmd)
11897 if arg then
11898  cmd=cmd.." "..arg.."\r\n"
11899 else
11900  cmd=cmd.."\r\n"
11901 end
11902 return self.c:send(cmd)
11903end
11904function methods.sink(self,snk,pat)
11905 local chunk,err=self.c:receive(pat)
11906 return snk(chunk,err)
11907end
11908function methods.send(self,data)
11909 return self.c:send(data)
11910end
11911function methods.receive(self,pat)
11912 return self.c:receive(pat)
11913end
11914function methods.getfd(self)
11915 return self.c:getfd()
11916end
11917function methods.dirty(self)
11918 return self.c:dirty()
11919end
11920function methods.getcontrol(self)
11921 return self.c
11922end
11923function methods.source(self,source,step)
11924 local sink=sinksocket("keep-open",self.c)
11925 local ret,err=pumpall(source,sink,step or pumpstep)
11926 return ret,err
11927end
11928function methods.close(self)
11929 self.c:close()
11930 return 1
11931end
11932function tp.connect(host,port,timeout,create)
11933 local c,e=(create or tcpsocket)()
11934 if not c then
11935  return nil,e
11936 end
11937 c:settimeout(timeout or tp.TIMEOUT)
11938 local r,e=c:connect(host,port)
11939 if not r then
11940  c:close()
11941  return nil,e
11942 end
11943 return setmetatable({ c=c },mt)
11944end
11945package.loaded["socket.tp"]=tp
11946
11947
11948end -- of closure
11949
11950do -- create closure to overcome 200 locals limit
11951
11952package.loaded["util-soc-imp-http"] = package.loaded["util-soc-imp-http"] or true
11953
11954-- original size: 13055, stripped down to: 9818
11955
11956
11957local tostring,tonumber,setmetatable,next,type=tostring,tonumber,setmetatable,next,type
11958local find,lower,format,gsub,match=string.find,string.lower,string.format,string.gsub,string.match
11959local concat=table.concat
11960local socket=socket   or require("socket")
11961local url=socket.url  or require("socket.url")
11962local ltn12=ltn12    or require("ltn12")
11963local mime=mime     or require("mime")
11964local headers=socket.headers or require("socket.headers")
11965local normalizeheaders=headers.normalize
11966local parseurl=url.parse
11967local buildurl=url.build
11968local absoluteurl=url.absolute
11969local unescapeurl=url.unescape
11970local skipsocket=socket.skip
11971local sinksocket=socket.sink
11972local sourcesocket=socket.source
11973local trysocket=socket.try
11974local tcpsocket=socket.tcp
11975local newtrysocket=socket.newtry
11976local protectsocket=socket.protect
11977local emptysource=ltn12.source.empty
11978local stringsource=ltn12.source.string
11979local rewindsource=ltn12.source.rewind
11980local pumpstep=ltn12.pump.step
11981local pumpall=ltn12.pump.all
11982local sinknull=ltn12.sink.null
11983local sinktable=ltn12.sink.table
11984local lowerheaders=headers.lower
11985local mimeb64=mime.b64
11986local http={
11987 TIMEOUT=60,
11988 USERAGENT=socket._VERSION,
11989}
11990socket.http=http
11991local PORT=80
11992local SCHEMES={
11993 http=true,
11994}
11995local function receiveheaders(sock,headers)
11996 if not headers then
11997  headers={}
11998 end
11999 local line,err=sock:receive("*l") 
12000 if err then
12001  return nil,err
12002 end
12003 while line~="" do
12004  local name,value=skipsocket(2,find(line,"^(.-):%s*(.*)"))
12005  if not (name and value) then
12006   return nil,"malformed response headers"
12007  end
12008  name=lower(name)
12009  line,err=sock:receive("*l")
12010  if err then
12011   return nil,err
12012  end
12013  while find(line,"^%s") do
12014   value=value..line
12015   line=sock:receive("*l")
12016   if err then
12017    return nil,err
12018   end
12019  end
12020  local found=headers[name]
12021  if found then
12022   value=found..", "..value
12023  end
12024  headers[name]=value
12025 end
12026 return headers
12027end
12028socket.sourcet["http-chunked"]=function(sock,headers)
12029 return setmetatable (
12030  {
12031   getfd=function() return sock:getfd() end,
12032   dirty=function() return sock:dirty() end,
12033  },{
12034   __call=function()
12035    local line,err=sock:receive("*l")
12036    if err then
12037     return nil,err
12038    end
12039    local size=tonumber(gsub(line,";.*",""),16)
12040    if not size then
12041     return nil,"invalid chunk size"
12042    end
12043    if size>0 then
12044     local chunk,err,part=sock:receive(size)
12045     if chunk then
12046      sock:receive("*a")
12047     end
12048     return chunk,err
12049    else
12050     headers,err=receiveheaders(sock,headers)
12051     if not headers then
12052      return nil,err
12053     end
12054    end
12055   end
12056  }
12057 )
12058end
12059socket.sinkt["http-chunked"]=function(sock)
12060 return setmetatable(
12061  {
12062   getfd=function() return sock:getfd() end,
12063   dirty=function() return sock:dirty() end,
12064  },
12065  {
12066   __call=function(self,chunk,err)
12067    if not chunk then
12068     chunk=""
12069    end
12070    return sock:send(format("%X\r\n%s\r\n",#chunk,chunk))
12071   end
12072 })
12073end
12074local methods={}
12075local mt={ __index=methods }
12076local function openhttp(host,port,create)
12077 local c=trysocket((create or tcpsocket)())
12078 local h=setmetatable({ c=c },mt)
12079 local try=newtrysocket(function() h:close() end)
12080 h.try=try
12081 try(c:settimeout(http.TIMEOUT))
12082 try(c:connect(host,port or PORT))
12083 return h
12084end
12085http.open=openhttp
12086function methods.sendrequestline(self,method,uri)
12087 local requestline=format("%s %s HTTP/1.1\r\n",method or "GET",uri)
12088 return self.try(self.c:send(requestline))
12089end
12090function methods.sendheaders(self,headers)
12091 self.try(self.c:send(normalizeheaders(headers)))
12092 return 1
12093end
12094function methods.sendbody(self,headers,source,step)
12095 if not source then
12096  source=emptysource()
12097 end
12098 if not step then
12099  step=pumpstep
12100 end
12101 local mode="http-chunked"
12102 if headers["content-length"] then
12103  mode="keep-open"
12104 end
12105 return self.try(pumpall(source,sinksocket(mode,self.c),step))
12106end
12107function methods.receivestatusline(self)
12108 local try=self.try
12109 local status,err=try(self.c:receive(5))
12110 if status~="HTTP/" then
12111  if err=="timeout" then
12112   return 408
12113  else
12114   return nil,status 
12115  end
12116 end
12117 status=try(self.c:receive("*l",status))
12118 local code=skipsocket(2,find(status,"HTTP/%d*%.%d* (%d%d%d)"))
12119 return try(tonumber(code),status)
12120end
12121function methods.receiveheaders(self)
12122 return self.try(receiveheaders(self.c))
12123end
12124function methods.receivebody(self,headers,sink,step)
12125 if not sink then
12126  sink=sinknull()
12127 end
12128 if not step then
12129  step=pumpstep
12130 end
12131 local length=tonumber(headers["content-length"])
12132 local encoding=headers["transfer-encoding"] 
12133 local mode="default" 
12134 if encoding and encoding~="identity" then
12135  mode="http-chunked"
12136 elseif length then
12137  mode="by-length"
12138 end
12139 return self.try(pumpall(sourcesocket(mode,self.c,length),sink,step))
12140end
12141function methods.receive09body(self,status,sink,step)
12142 local source=rewindsource(sourcesocket("until-closed",self.c))
12143 source(status)
12144 return self.try(pumpall(source,sink,step))
12145end
12146function methods.close(self)
12147 return self.c:close()
12148end
12149local function adjusturi(request)
12150 if not request.proxy and not http.PROXY then
12151  request={
12152     path=trysocket(request.path,"invalid path 'nil'"),
12153     params=request.params,
12154     query=request.query,
12155     fragment=request.fragment,
12156  }
12157 end
12158 return buildurl(request)
12159end
12160local function adjustheaders(request)
12161 local headers={
12162  ["user-agent"]=http.USERAGENT,
12163  ["host"]=gsub(request.authority,"^.-@",""),
12164  ["connection"]="close, TE",
12165  ["te"]="trailers"
12166 }
12167 local username=request.user
12168 local password=request.password
12169 if username and password then
12170  headers["authorization"]="Basic "..(mimeb64(username..":"..unescapeurl(password)))
12171 end
12172 local proxy=request.proxy or http.PROXY
12173 if proxy then
12174  proxy=parseurl(proxy)
12175  local username=proxy.user
12176  local password=proxy.password
12177  if username and password then
12178   headers["proxy-authorization"]="Basic "..(mimeb64(username..":"..password))
12179  end
12180 end
12181 local requestheaders=request.headers
12182 if requestheaders then
12183  headers=lowerheaders(headers,requestheaders)
12184 end
12185 return headers
12186end
12187local default={
12188 host="",
12189 port=PORT,
12190 path="/",
12191 scheme="http"
12192}
12193local function adjustrequest(originalrequest)
12194 local url=originalrequest.url
12195 local request=url and parseurl(url,default) or {}
12196 for k,v in next,originalrequest do
12197  request[k]=v
12198 end
12199 local host=request.host
12200 local port=request.port
12201 local uri=request.uri
12202 if not host or host=="" then
12203  trysocket(nil,"invalid host '"..tostring(host).."'")
12204 end
12205 if port=="" then
12206  request.port=PORT
12207 end
12208 if not uri or uri=="" then
12209  request.uri=adjusturi(request)
12210 end
12211 request.headers=adjustheaders(request)
12212 local proxy=request.proxy or http.PROXY
12213 if proxy then
12214  proxy=parseurl(proxy)
12215  request.host=proxy.host
12216  request.port=proxy.port or 3128
12217 end
12218 return request
12219end
12220local maxredericts=5
12221local validredirects={ [301]=true,[302]=true,[303]=true,[307]=true }
12222local validmethods={ [false]=true,GET=true,HEAD=true }
12223local function shouldredirect(request,code,headers)
12224 local location=headers.location
12225 if not location then
12226  return false
12227 end
12228 location=gsub(location,"%s","")
12229 if location=="" then
12230  return false
12231 end
12232 local scheme=match(location,"^([%w][%w%+%-%.]*)%:")
12233 if scheme and not SCHEMES[scheme] then
12234  return false
12235 end
12236 local method=request.method
12237 local redirect=request.redirect
12238 local redirects=request.nredirects or 0
12239 local maxredirects=request.maxredirects or maxredirects
12240 return redirect and validredirects[code] and validmethods[method] and redirects<=maxredirects
12241end
12242local function shouldreceivebody(request,code)
12243 if request.method=="HEAD" then
12244  return nil
12245 end
12246 if code==204 or code==304 then
12247  return nil
12248 end
12249 if code>=100 and code<200 then
12250  return nil
12251 end
12252 return 1
12253end
12254local tredirect,trequest,srequest
12255tredirect=function(request,location)
12256 local result,code,headers,status=trequest {
12257  url=absoluteurl(request.url,location),
12258  source=request.source,
12259  sink=request.sink,
12260  headers=request.headers,
12261  proxy=request.proxy,
12262  nredirects=(request.nredirects or 0)+1,
12263  maxredirects=request.maxredirects or maxredirects,
12264  create=request.create,
12265 }
12266 if not headers then
12267  headers={}
12268 end
12269 if not headers.location then
12270  headers.location=location
12271 end
12272 return result,code,headers,status
12273end
12274trequest=function(originalrequest)
12275 local request=adjustrequest(originalrequest)
12276 local connection=openhttp(request.host,request.port,request.create)
12277 local headers=request.headers
12278 connection:sendrequestline(request.method,request.uri)
12279 connection:sendheaders(headers)
12280 if request.source then
12281  connection:sendbody(headers,request.source,request.step)
12282 end
12283 local code,status=connection:receivestatusline()
12284 if not code then
12285  connection:receive09body(status,request.sink,request.step)
12286  connection:close()
12287  return 1,200
12288 elseif code==408 then
12289  return 1,code
12290 end
12291 while code==100 do
12292  connection:receiveheaders()
12293  code,status=connection:receivestatusline()
12294 end
12295 headers=connection:receiveheaders()
12296 if shouldredirect(request,code,headers) and not request.source then
12297  connection:close()
12298  return tredirect(originalrequest,headers.location)
12299 end
12300 if shouldreceivebody(request,code) then
12301  connection:receivebody(headers,request.sink,request.step)
12302 end
12303 connection:close()
12304 return 1,code,headers,status
12305end
12306local function genericform(url,body)
12307 local buffer={}
12308 local request={
12309  url=url,
12310  sink=sinktable(buffer),
12311  target=buffer,
12312 }
12313 if body then
12314  request.source=stringsource(body)
12315  request.method="POST"
12316  request.headers={
12317   ["content-length"]=#body,
12318   ["content-type"]="application/x-www-form-urlencoded"
12319  }
12320 end
12321 return request
12322end
12323http.genericform=genericform
12324srequest=function(url,body)
12325 local request=genericform(url,body)
12326 local _,code,headers,status=trequest(request)
12327 return concat(request.target),code,headers,status
12328end
12329http.request=protectsocket(function(request,body)
12330 if type(request)=="string" then
12331  return srequest(request,body)
12332 else
12333  return trequest(request)
12334 end
12335end)
12336package.loaded["socket.http"]=http
12337
12338
12339end -- of closure
12340
12341do -- create closure to overcome 200 locals limit
12342
12343package.loaded["util-soc-imp-ftp"] = package.loaded["util-soc-imp-ftp"] or true
12344
12345-- original size: 10345, stripped down to: 8538
12346
12347
12348local setmetatable,type,next=setmetatable,type,next
12349local find,format,gsub,match=string.find,string.format,string.gsub,string.match
12350local concat=table.concat
12351local mod=math.mod
12352local socket=socket  or require("socket")
12353local url=socket.url or require("socket.url")
12354local tp=socket.tp  or require("socket.tp")
12355local ltn12=ltn12   or require("ltn12")
12356local tcpsocket=socket.tcp
12357local trysocket=socket.try
12358local skipsocket=socket.skip
12359local sinksocket=socket.sink
12360local selectsocket=socket.select
12361local bindsocket=socket.bind
12362local newtrysocket=socket.newtry
12363local sourcesocket=socket.source
12364local protectsocket=socket.protect
12365local parseurl=url.parse
12366local unescapeurl=url.unescape
12367local pumpall=ltn12.pump.all
12368local pumpstep=ltn12.pump.step
12369local sourcestring=ltn12.source.string
12370local sinktable=ltn12.sink.table
12371local ftp={
12372 TIMEOUT=60,
12373 USER="ftp",
12374 PASSWORD="anonymous@anonymous.org",
12375}
12376socket.ftp=ftp
12377local PORT=21
12378local methods={}
12379local mt={ __index=methods }
12380function ftp.open(server,port,create)
12381 local tp=trysocket(tp.connect(server,port or PORT,ftp.TIMEOUT,create))
12382 local f=setmetatable({ tp=tp },metat)
12383 f.try=newtrysocket(function() f:close() end)
12384 return f
12385end
12386function methods.portconnect(self)
12387 local try=self.try
12388 local server=self.server
12389 try(server:settimeout(ftp.TIMEOUT))
12390 self.data=try(server:accept())
12391 try(self.data:settimeout(ftp.TIMEOUT))
12392end
12393function methods.pasvconnect(self)
12394 local try=self.try
12395 self.data=try(tcpsocket())
12396 self(self.data:settimeout(ftp.TIMEOUT))
12397 self(self.data:connect(self.pasvt.address,self.pasvt.port))
12398end
12399function methods.login(self,user,password)
12400 local try=self.try
12401 local tp=self.tp
12402 try(tp:command("user",user or ftp.USER))
12403 local code,reply=try(tp:check{"2..",331})
12404 if code==331 then
12405  try(tp:command("pass",password or ftp.PASSWORD))
12406  try(tp:check("2.."))
12407 end
12408 return 1
12409end
12410function methods.pasv(self)
12411 local try=self.try
12412 local tp=self.tp
12413 try(tp:command("pasv"))
12414 local code,reply=try(self.tp:check("2.."))
12415 local pattern="(%d+)%D(%d+)%D(%d+)%D(%d+)%D(%d+)%D(%d+)"
12416 local a,b,c,d,p1,p2=skipsocket(2,find(reply,pattern))
12417 try(a and b and c and d and p1 and p2,reply)
12418 local address=format("%d.%d.%d.%d",a,b,c,d)
12419 local port=p1*256+p2
12420 local server=self.server
12421 self.pasvt={
12422  address=address,
12423  port=port,
12424 }
12425 if server then
12426  server:close()
12427  self.server=nil
12428 end
12429 return address,port
12430end
12431function methods.epsv(self)
12432 local try=self.try
12433 local tp=self.tp
12434 try(tp:command("epsv"))
12435 local code,reply=try(tp:check("229"))
12436 local pattern="%((.)(.-)%1(.-)%1(.-)%1%)"
12437 local d,prt,address,port=match(reply,pattern)
12438 try(port,"invalid epsv response")
12439 local address=tp:getpeername()
12440 local server=self.server
12441 self.pasvt={
12442  address=address,
12443  port=port,
12444 }
12445 if self.server then
12446  server:close()
12447  self.server=nil
12448 end
12449 return address,port
12450end
12451function methods.port(self,address,port)
12452 local try=self.try
12453 local tp=self.tp
12454 self.pasvt=nil
12455 if not address then
12456  address=try(tp:getsockname())
12457  self.server=try(bindsocket(address,0))
12458  address,port=try(self.server:getsockname())
12459  try(self.server:settimeout(ftp.TIMEOUT))
12460 end
12461 local pl=mod(port,256)
12462 local ph=(port-pl)/256
12463 local arg=gsub(format("%s,%d,%d",address,ph,pl),"%.",",")
12464 try(tp:command("port",arg))
12465 try(tp:check("2.."))
12466 return 1
12467end
12468function methods.eprt(self,family,address,port)
12469 local try=self.try
12470 local tp=self.tp
12471 self.pasvt=nil
12472 if not address then
12473  address=try(tp:getsockname())
12474  self.server=try(bindsocket(address,0))
12475  address,port=try(self.server:getsockname())
12476  try(self.server:settimeout(ftp.TIMEOUT))
12477 end
12478 local arg=format("|%s|%s|%d|",family,address,port)
12479 try(tp:command("eprt",arg))
12480 try(tp:check("2.."))
12481 return 1
12482end
12483function methods.send(self,sendt)
12484 local try=self.try
12485 local tp=self.tp
12486 try(self.pasvt or self.server,"need port or pasv first")
12487 if self.pasvt then
12488  self:pasvconnect()
12489 end
12490 local argument=sendt.argument or unescapeurl(gsub(sendt.path or "","^[/\\]",""))
12491 if argument=="" then
12492  argument=nil
12493 end
12494 local command=sendt.command or "stor"
12495 try(tp:command(command,argument))
12496 local code,reply=try(tp:check{"2..","1.."})
12497 if not self.pasvt then
12498  self:portconnect()
12499 end
12500 local step=sendt.step or pumpstep
12501 local readt={ tp }
12502 local checkstep=function(src,snk)
12503  local readyt=selectsocket(readt,nil,0)
12504  if readyt[tp] then
12505   code=try(tp:check("2.."))
12506  end
12507  return step(src,snk)
12508 end
12509 local sink=sinksocket("close-when-done",self.data)
12510 try(pumpall(sendt.source,sink,checkstep))
12511 if find(code,"1..") then
12512  try(tp:check("2.."))
12513 end
12514 self.data:close()
12515 local sent=skipsocket(1,self.data:getstats())
12516 self.data=nil
12517 return sent
12518end
12519function methods.receive(self,recvt)
12520 local try=self.try
12521 local tp=self.tp
12522 try(self.pasvt or self.server,"need port or pasv first")
12523 if self.pasvt then self:pasvconnect() end
12524 local argument=recvt.argument or unescapeurl(gsub(recvt.path or "","^[/\\]",""))
12525 if argument=="" then
12526  argument=nil
12527 end
12528 local command=recvt.command or "retr"
12529 try(tp:command(command,argument))
12530 local code,reply=try(tp:check{"1..","2.."})
12531 if code>=200 and code<=299 then
12532  recvt.sink(reply)
12533  return 1
12534 end
12535 if not self.pasvt then
12536  self:portconnect()
12537 end
12538 local source=sourcesocket("until-closed",self.data)
12539 local step=recvt.step or pumpstep
12540 try(pumpall(source,recvt.sink,step))
12541 if find(code,"1..") then
12542  try(tp:check("2.."))
12543 end
12544 self.data:close()
12545 self.data=nil
12546 return 1
12547end
12548function methods.cwd(self,dir)
12549 local try=self.try
12550 local tp=self.tp
12551 try(tp:command("cwd",dir))
12552 try(tp:check(250))
12553 return 1
12554end
12555function methods.type(self,typ)
12556 local try=self.try
12557 local tp=self.tp
12558 try(tp:command("type",typ))
12559 try(tp:check(200))
12560 return 1
12561end
12562function methods.greet(self)
12563 local try=self.try
12564 local tp=self.tp
12565 local code=try(tp:check{"1..","2.."})
12566 if find(code,"1..") then
12567  try(tp:check("2.."))
12568 end
12569 return 1
12570end
12571function methods.quit(self)
12572 local try=self.try
12573 try(self.tp:command("quit"))
12574 try(self.tp:check("2.."))
12575 return 1
12576end
12577function methods.close(self)
12578 local data=self.data
12579 if data then
12580  data:close()
12581 end
12582 local server=self.server
12583 if server then
12584  server:close()
12585 end
12586 local tp=self.tp
12587 if tp then
12588  tp:close()
12589 end
12590end
12591local function override(t)
12592 if t.url then
12593  local u=parseurl(t.url)
12594  for k,v in next,t do
12595   u[k]=v
12596  end
12597  return u
12598 else
12599  return t
12600 end
12601end
12602local function tput(putt)
12603 putt=override(putt)
12604 local host=putt.host
12605 trysocket(host,"missing hostname")
12606 local f=ftp.open(host,putt.port,putt.create)
12607 f:greet()
12608 f:login(putt.user,putt.password)
12609 local typ=putt.type
12610 if typ then
12611  f:type(typ)
12612 end
12613 f:epsv()
12614 local sent=f:send(putt)
12615 f:quit()
12616 f:close()
12617 return sent
12618end
12619local default={
12620 path="/",
12621 scheme="ftp",
12622}
12623local function genericform(u)
12624 local t=trysocket(parseurl(u,default))
12625 trysocket(t.scheme=="ftp","wrong scheme '"..t.scheme.."'")
12626 trysocket(t.host,"missing hostname")
12627 local pat="^type=(.)$"
12628 if t.params then
12629  local typ=skipsocket(2,find(t.params,pat))
12630  t.type=typ
12631  trysocket(typ=="a" or typ=="i","invalid type '"..typ.."'")
12632 end
12633 return t
12634end
12635ftp.genericform=genericform
12636local function sput(u,body)
12637 local putt=genericform(u)
12638 putt.source=sourcestring(body)
12639 return tput(putt)
12640end
12641ftp.put=protectsocket(function(putt,body)
12642 if type(putt)=="string" then
12643  return sput(putt,body)
12644 else
12645  return tput(putt)
12646 end
12647end)
12648local function tget(gett)
12649 gett=override(gett)
12650 local host=gett.host
12651 trysocket(host,"missing hostname")
12652 local f=ftp.open(host,gett.port,gett.create)
12653 f:greet()
12654 f:login(gett.user,gett.password)
12655 if gett.type then
12656  f:type(gett.type)
12657 end
12658 f:epsv()
12659 f:receive(gett)
12660 f:quit()
12661 return f:close()
12662end
12663local function sget(u)
12664 local gett=genericform(u)
12665 local t={}
12666 gett.sink=sinktable(t)
12667 tget(gett)
12668 return concat(t)
12669end
12670ftp.command=protectsocket(function(cmdt)
12671 cmdt=override(cmdt)
12672 local command=cmdt.command
12673 local argument=cmdt.argument
12674 local check=cmdt.check
12675 local host=cmdt.host
12676 trysocket(host,"missing hostname")
12677 trysocket(command,"missing command")
12678 local f=ftp.open(host,cmdt.port,cmdt.create)
12679 local try=f.try
12680 local tp=f.tp
12681 f:greet()
12682 f:login(cmdt.user,cmdt.password)
12683 if type(command)=="table" then
12684  local argument=argument or {}
12685  for i=1,#command do
12686   local cmd=command[i]
12687   try(tp:command(cmd,argument[i]))
12688   if check and check[i] then
12689    try(tp:check(check[i]))
12690   end
12691  end
12692 else
12693  try(tp:command(command,argument))
12694  if check then
12695   try(tp:check(check))
12696  end
12697 end
12698 f:quit()
12699 return f:close()
12700end)
12701ftp.get=protectsocket(function(gett)
12702 if type(gett)=="string" then
12703  return sget(gett)
12704 else
12705  return tget(gett)
12706 end
12707end)
12708package.loaded["socket.ftp"]=ftp
12709
12710
12711end -- of closure
12712
12713do -- create closure to overcome 200 locals limit
12714
12715package.loaded["util-soc-imp-smtp"] = package.loaded["util-soc-imp-smtp"] or true
12716
12717-- original size: 7018, stripped down to: 5883
12718
12719
12720local type,setmetatable,next=type,setmetatable,next
12721local find,lower,format=string.find,string.lower,string.format
12722local osdate,osgetenv=os.date,os.getenv
12723local random=math.random
12724local socket=socket   or require("socket")
12725local headers=socket.headers or require("socket.headers")
12726local ltn12=ltn12    or require("ltn12")
12727local tp=socket.tp   or require("socket.tp")
12728local mime=mime     or require("mime")
12729local mimeb64=mime.b64
12730local mimestuff=mime.stuff
12731local skipsocket=socket.skip
12732local trysocket=socket.try
12733local newtrysocket=socket.newtry
12734local protectsocket=socket.protect
12735local normalizeheaders=headers.normalize
12736local lowerheaders=headers.lower
12737local createcoroutine=coroutine.create
12738local resumecoroutine=coroutine.resume
12739local yieldcoroutine=coroutine.resume
12740local smtp={
12741 TIMEOUT=60,
12742 SERVER="localhost",
12743 PORT=25,
12744 DOMAIN=osgetenv("SERVER_NAME") or "localhost",
12745 ZONE="-0000",
12746}
12747socket.smtp=smtp
12748local methods={}
12749local mt={ __index=methods }
12750function methods.greet(self,domain)
12751 local try=self.try
12752 local tp=self.tp
12753 try(tp:check("2.."))
12754 try(tp:command("EHLO",domain or _M.DOMAIN))
12755 return skipsocket(1,try(tp:check("2..")))
12756end
12757function methods.mail(self,from)
12758 local try=self.try
12759 local tp=self.tp
12760 try(tp:command("MAIL","FROM:"..from))
12761 return try(tp:check("2.."))
12762end
12763function methods.rcpt(self,to)
12764 local try=self.try
12765 local tp=self.tp
12766 try(tp:command("RCPT","TO:"..to))
12767 return try(tp:check("2.."))
12768end
12769function methods.data(self,src,step)
12770 local try=self.try
12771 local tp=self.tp
12772 try(tp:command("DATA"))
12773 try(tp:check("3.."))
12774 try(tp:source(src,step))
12775 try(tp:send("\r\n.\r\n"))
12776 return try(tp:check("2.."))
12777end
12778function methods.quit(self)
12779 local try=self.try
12780 local tp=self.tp
12781 try(tp:command("QUIT"))
12782 return try(tp:check("2.."))
12783end
12784function methods.close(self)
12785 return self.tp:close()
12786end
12787function methods.login(self,user,password)
12788 local try=self.try
12789 local tp=self.tp
12790 try(tp:command("AUTH","LOGIN"))
12791 try(tp:check("3.."))
12792 try(tp:send(mimeb64(user).."\r\n"))
12793 try(tp:check("3.."))
12794 try(tp:send(mimeb64(password).."\r\n"))
12795 return try(tp:check("2.."))
12796end
12797function methods.plain(self,user,password)
12798 local try=self.try
12799 local tp=self.tp
12800 local auth="PLAIN "..mimeb64("\0"..user.."\0"..password)
12801 try(tp:command("AUTH",auth))
12802 return try(tp:check("2.."))
12803end
12804function methods.auth(self,user,password,ext)
12805 if not user or not password then
12806  return 1
12807 end
12808 local try=self.try
12809 if find(ext,"AUTH[^\n]+LOGIN") then
12810  return self:login(user,password)
12811 elseif find(ext,"AUTH[^\n]+PLAIN") then
12812  return self:plain(user,password)
12813 else
12814  try(nil,"authentication not supported")
12815 end
12816end
12817function methods.send(self,mail)
12818 self:mail(mail.from)
12819 local receipt=mail.rcpt
12820 if type(receipt)=="table" then
12821  for i=1,#receipt do
12822   self:rcpt(receipt[i])
12823  end
12824 elseif receipt then
12825  self:rcpt(receipt)
12826 end
12827 self:data(ltn12.source.chain(mail.source,mimestuff()),mail.step)
12828end
12829local function opensmtp(self,server,port,create)
12830 if not server or server=="" then
12831  server=smtp.SERVER
12832 end
12833 if not port or port=="" then
12834  port=smtp.PORT
12835 end
12836 local s={
12837  tp=trysocket(tp.connect(server,port,smtp.TIMEOUT,create)),
12838  try=newtrysocket(function()
12839   s:close()
12840  end),
12841 }
12842 setmetatable(s,mt)
12843 return s
12844end
12845smtp.open=opensmtp
12846local nofboundaries=0
12847local function newboundary()
12848 nofboundaries=nofboundaries+1
12849 return format('%s%05d==%05u',osdate('%d%m%Y%H%M%S'),random(0,99999),nofboundaries)
12850end
12851local send_message
12852local function send_headers(headers)
12853 yieldcoroutine(normalizeheaders(headers))
12854end
12855local function send_multipart(message)
12856 local boundary=newboundary()
12857 local headers=lowerheaders(message.headers)
12858 local body=message.body
12859 local preamble=body.preamble
12860 local epilogue=body.epilogue
12861 local content=headers['content-type'] or 'multipart/mixed'
12862 headers['content-type']=content..'; boundary="'..boundary..'"'
12863 send_headers(headers)
12864 if preamble then
12865  yieldcoroutine(preamble)
12866  yieldcoroutine("\r\n")
12867 end
12868 for i=1,#body do
12869  yieldcoroutine("\r\n--"..boundary.."\r\n")
12870  send_message(body[i])
12871 end
12872 yieldcoroutine("\r\n--"..boundary.."--\r\n\r\n")
12873 if epilogue then
12874  yieldcoroutine(epilogue)
12875  yieldcoroutine("\r\n")
12876 end
12877end
12878local default_content_type='text/plain; charset="UTF-8"'
12879local function send_source(message)
12880 local headers=lowerheaders(message.headers)
12881 if not headers['content-type'] then
12882  headers['content-type']=default_content_type
12883 end
12884 send_headers(headers)
12885 local getchunk=message.body
12886 while true do
12887  local chunk,err=getchunk()
12888  if err then
12889   yieldcoroutine(nil,err)
12890  elseif chunk then
12891   yieldcoroutine(chunk)
12892  else
12893   break
12894  end
12895 end
12896end
12897local function send_string(message)
12898 local headers=lowerheaders(message.headers)
12899 if not headers['content-type'] then
12900  headers['content-type']=default_content_type
12901 end
12902 send_headers(headers)
12903 yieldcoroutine(message.body)
12904end
12905function send_message(message)
12906 local body=message.body
12907 if type(body)=="table" then
12908  send_multipart(message)
12909 elseif type(body)=="function" then
12910  send_source(message)
12911 else
12912  send_string(message)
12913 end
12914end
12915local function adjust_headers(message)
12916 local headers=lowerheaders(message.headers)
12917 if not headers["date"] then
12918  headers["date"]=osdate("!%a, %d %b %Y %H:%M:%S ")..(message.zone or smtp.ZONE)
12919 end
12920 if not headers["x-mailer"] then
12921  headers["x-mailer"]=socket._VERSION
12922 end
12923 headers["mime-version"]="1.0"
12924 return headers
12925end
12926function smtp.message(message)
12927 message.headers=adjust_headers(message)
12928 local action=createcoroutine(function()
12929  send_message(message)
12930 end)
12931 return function()
12932  local ret,a,b=resumecoroutine(action)
12933  if ret then
12934   return a,b
12935  else
12936   return nil,a
12937  end
12938 end
12939end
12940smtp.send=protectsocket(function(mail)
12941 local snd=opensmtp(smtp,mail.server,mail.port,mail.create)
12942 local ext=snd:greet(mail.domain)
12943 snd:auth(mail.user,mail.password,ext)
12944 snd:send(mail)
12945 snd:quit()
12946 return snd:close()
12947end)
12948package.loaded["socket.smtp"]=smtp
12949
12950
12951end -- of closure
12952
12953do -- create closure to overcome 200 locals limit
12954
12955package.loaded["trac-set"] = package.loaded["trac-set"] or true
12956
12957-- original size: 14574, stripped down to: 9650
12958
12959if not modules then modules={} end modules ['trac-set']={ 
12960 version=1.001,
12961 comment="companion to luat-lib.mkiv",
12962 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
12963 copyright="PRAGMA ADE / ConTeXt Development Team",
12964 license="see context related readme files"
12965}
12966local type,next,tostring,tonumber=type,next,tostring,tonumber
12967local print=print
12968local concat,sortedhash=table.concat,table.sortedhash
12969local formatters,find,lower,gsub,topattern=string.formatters,string.find,string.lower,string.gsub,string.topattern
12970local is_boolean=string.is_boolean
12971local settings_to_hash=utilities.parsers.settings_to_hash
12972local allocate=utilities.storage.allocate
12973utilities=utilities or {}
12974local utilities=utilities
12975local setters=utilities.setters or {}
12976utilities.setters=setters
12977local data={}
12978local trace_initialize=false 
12979local frozen=true  
12980local function initialize_setter(filename,name,values) 
12981 local setter=data[name]
12982 if setter then
12983  local data=setter.data
12984  if data then
12985   for key,newvalue in sortedhash(values) do
12986    local newvalue=is_boolean(newvalue,newvalue,true) 
12987    local functions=data[key]
12988    if functions then
12989     local oldvalue=functions.value
12990     if functions.frozen then
12991      if trace_initialize then
12992       setter.report("%s: %a is %s to %a",filename,key,"frozen",oldvalue)
12993      end
12994     elseif #functions>0 and not oldvalue then
12995      if trace_initialize then
12996       setter.report("%s: %a is %s to %a",filename,key,"set",newvalue)
12997      end
12998      for i=1,#functions do
12999       functions[i](newvalue)
13000      end
13001      functions.value=newvalue
13002      functions.frozen=functions.frozen or frozen
13003     else
13004      if trace_initialize then
13005       setter.report("%s: %a is %s as %a",filename,key,"kept",oldvalue)
13006      end
13007     end
13008    else
13009     functions={ default=newvalue,frozen=frozen }
13010     data[key]=functions
13011     if trace_initialize then
13012      setter.report("%s: %a is %s to %a",filename,key,"defaulted",newvalue)
13013     end
13014    end
13015   end
13016   return true
13017  end
13018 end
13019end
13020local function set(t,what,newvalue)
13021 local data=t.data 
13022 if data and not data.frozen then
13023  local done=t.done
13024  if type(what)=="string" then
13025   what=settings_to_hash(what) 
13026  end
13027  if type(what)~="table" then
13028   return
13029  end
13030  if not done then 
13031   done={}
13032   t.done=done
13033  end
13034  for w,value in sortedhash(what) do
13035   if value=="" then
13036    value=newvalue
13037   elseif not value then
13038    value=false 
13039   else
13040    value=is_boolean(value,value,true) 
13041   end
13042   local p=topattern(w,true,true)
13043   for name,functions in sortedhash(data) do
13044    if done[name] then
13045    elseif find(name,p) then
13046     done[name]=true
13047     for i=1,#functions do
13048      functions[i](value)
13049     end
13050     functions.value=value
13051    end
13052   end
13053  end
13054 end
13055end
13056local function reset(t)
13057 local data=t.data
13058 if data and not data.frozen then
13059  for name,functions in sortedthash(data) do
13060   for i=1,#functions do
13061    functions[i](false)
13062   end
13063   functions.value=false
13064  end
13065 end
13066end
13067local function enable(t,what)
13068 set(t,what,true)
13069end
13070local function disable(t,what)
13071 local data=t.data
13072 if not what or what=="" then
13073  t.done={}
13074  reset(t)
13075 else
13076  set(t,what,false)
13077 end
13078end
13079local function register_setter(t,what,...)
13080 local data=t.data
13081 what=lower(what)
13082 local functions=data[what]
13083 if not functions then
13084  functions={}
13085  data[what]=functions
13086  if trace_initialize then
13087   t.report("defining %a",what)
13088  end
13089 end
13090 local default=functions.default 
13091 for i=1,select("#",...) do
13092  local fnc=select(i,...)
13093  local typ=type(fnc)
13094  if typ=="string" then
13095   if trace_initialize then
13096    t.report("coupling %a to %a",what,fnc)
13097   end
13098   local s=fnc 
13099   fnc=function(value) set(t,s,value) end
13100  elseif typ=="table" then
13101   functions.values=fnc
13102   fnc=nil
13103  elseif typ~="function" then
13104   fnc=nil
13105  end
13106  if fnc then
13107   functions[#functions+1]=fnc
13108   local value=functions.value or default
13109   if value~=nil then
13110    fnc(value)
13111    functions.value=value
13112   end
13113  end
13114 end
13115 return false 
13116end
13117local function enable_setter(t,what)
13118 local e=t.enable
13119 t.enable,t.done=enable,{}
13120 set(t,what,true)
13121 enable(t,what)
13122 t.enable,t.done=e,{}
13123end
13124local function disable_setter(t,what)
13125 local e=t.disable
13126 t.disable,t.done=disable,{}
13127 disable(t,what)
13128 t.disable,t.done=e,{}
13129end
13130local function reset_setter(t)
13131 t.done={}
13132 reset(t)
13133end
13134local function list_setter(t) 
13135 local list=table.sortedkeys(t.data)
13136 local user,system={},{}
13137 for l=1,#list do
13138  local what=list[l]
13139  if find(what,"^%*") then
13140   system[#system+1]=what
13141  else
13142   user[#user+1]=what
13143  end
13144 end
13145 return user,system
13146end
13147local function show_setter(t,pattern)
13148 local list=list_setter(t)
13149 t.report()
13150 for k=1,#list do
13151  local name=list[k]
13152  if not pattern or find(name,pattern) then
13153   local functions=t.data[name]
13154   if functions then
13155    local value=functions.value
13156    local default=functions.default
13157    local values=functions.values
13158    local modules=#functions
13159    if default==nil then
13160     default="unset"
13161    elseif type(default)=="table" then
13162     default=concat(default,"|")
13163    else
13164     default=tostring(default)
13165    end
13166    if value==nil then
13167     value="unset"
13168    elseif type(value)=="table" then
13169     value=concat(value,"|")
13170    else
13171     value=tostring(value)
13172    end
13173    t.report(name)
13174    t.report("    modules : %i",modules)
13175    t.report("    default : %s",default)
13176    t.report("    value   : %s",value)
13177   if values then
13178    local v={} for i=1,#values do v[i]=tostring(values[i]) end
13179    t.report("    values  : % t",v)
13180   end
13181    t.report()
13182   end
13183  end
13184 end
13185end
13186function setters.report(setter,fmt,...)
13187 if fmt then
13188  print(formatters["%-15s : %s"](setter.name,formatters[fmt](...)))
13189 else
13190  print("")
13191 end
13192end
13193local function setter_default(setter,name)
13194 local d=setter.data[name]
13195 return d and d.default
13196end
13197local function setter_value(setter,name)
13198 local d=setter.data[name]
13199 return d and (d.value or d.default)
13200end
13201local function setter_values(setter,name)
13202 local d=setter.data[name]
13203 return d and d.values
13204end
13205local function new_setter(name) 
13206 local setter 
13207 setter={
13208  data=allocate(),
13209  name=name,
13210  report=function(...)   setters.report (setter,...) end,
13211  enable=function(...)   enable_setter  (setter,...) end,
13212  disable=function(...)   disable_setter (setter,...) end,
13213  reset=function(...)   reset_setter   (setter,...) end,
13214  register=function(...)   register_setter(setter,...) end,
13215  list=function(...)  return list_setter (setter,...) end,
13216  show=function(...)   show_setter (setter,...) end,
13217  default=function(...)  return setter_default (setter,...) end,
13218  value=function(...)  return setter_value   (setter,...) end,
13219  values=function(...)  return setter_values  (setter,...) end,
13220 }
13221 data[name]=setter
13222 return setter
13223end
13224setters.enable=enable_setter
13225setters.disable=disable_setter
13226setters.register=register_setter
13227setters.list=list_setter
13228setters.show=show_setter
13229setters.reset=reset_setter
13230setters.new=new_setter
13231setters.initialize=initialize_setter
13232trackers=new_setter("trackers")
13233directives=new_setter("directives")
13234experiments=new_setter("experiments")
13235local t_enable,t_disable=trackers   .enable,trackers   .disable
13236local d_enable,d_disable=directives .enable,directives .disable
13237local e_enable,e_disable=experiments.enable,experiments.disable
13238local trace_directives=false local trace_directives=false  trackers.register("system.directives",function(v) trace_directives=v end)
13239local trace_experiments=false local trace_experiments=false  trackers.register("system.experiments",function(v) trace_experiments=v end)
13240function directives.enable(...)
13241 if trace_directives then
13242  directives.report("enabling: % t",{...})
13243 end
13244 d_enable(...)
13245end
13246function directives.disable(...)
13247 if trace_directives then
13248  directives.report("disabling: % t",{...})
13249 end
13250 d_disable(...)
13251end
13252function experiments.enable(...)
13253 if trace_experiments then
13254  experiments.report("enabling: % t",{...})
13255 end
13256 e_enable(...)
13257end
13258function experiments.disable(...)
13259 if trace_experiments then
13260  experiments.report("disabling: % t",{...})
13261 end
13262 e_disable(...)
13263end
13264directives.register("system.nostatistics",function(v)
13265 if statistics then
13266  statistics.enable=not v
13267 else
13268 end
13269end)
13270directives.register("system.nolibraries",function(v)
13271 if libraries then
13272  libraries=nil 
13273 else
13274 end
13275end)
13276if environment then
13277 local engineflags=environment.engineflags
13278 if engineflags then
13279  local list=engineflags["c:trackers"] or engineflags["trackers"]
13280  if type(list)=="string" then
13281   initialize_setter("commandline flags","trackers",settings_to_hash(list))
13282  end
13283  local list=engineflags["c:directives"] or engineflags["directives"]
13284  if type(list)=="string" then
13285   initialize_setter("commandline flags","directives",settings_to_hash(list))
13286  end
13287 end
13288end
13289if texconfig then
13290 local function set(k,v)
13291  local v=tonumber(v)
13292  if v then
13293   texconfig[k]=v
13294  end
13295 end
13296 directives.register("luatex.expanddepth",function(v) set("expand_depth",v)   end)
13297 directives.register("luatex.hashextra",function(v) set("hash_extra",v)  end)
13298 directives.register("luatex.nestsize",function(v) set("nest_size",v)   end)
13299 directives.register("luatex.maxinopen",function(v) set("max_in_open",v) end)
13300 directives.register("luatex.maxprintline",function(v) set("max_print_line",v) end)
13301 directives.register("luatex.maxstrings",function(v) set("max_strings",v) end)
13302 directives.register("luatex.paramsize",function(v) set("param_size",v)  end)
13303 directives.register("luatex.savesize",function(v) set("save_size",v)   end)
13304 directives.register("luatex.stacksize",function(v) set("stack_size",v)  end)
13305end
13306local data=table.setmetatableindex("table")
13307updaters={
13308 register=function(what,f)
13309  local d=data[what]
13310  d[#d+1]=f
13311 end,
13312 apply=function(what,...)
13313  local d=data[what]
13314  for i=1,#d do
13315   d[i](...)
13316  end
13317 end,
13318}
13319
13320
13321end -- of closure
13322
13323do -- create closure to overcome 200 locals limit
13324
13325package.loaded["trac-log"] = package.loaded["trac-log"] or true
13326
13327-- original size: 16046, stripped down to: 11072
13328
13329if not modules then modules={} end modules ['trac-log']={
13330 version=1.001,
13331 comment="companion to trac-log.mkiv",
13332 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
13333 copyright="PRAGMA ADE / ConTeXt Development Team",
13334 license="see context related readme files"
13335}
13336local next,type,select,print=next,type,select,print
13337local format,gmatch,find=string.format,string.gmatch,string.find
13338local concat,insert,remove=table.concat,table.insert,table.remove
13339local topattern=string.topattern
13340local utfchar=utf.char
13341local datetime=os.date
13342local sleep=os.sleep
13343local openfile=io.open
13344local write_nl=print
13345local write=io.write
13346local setmetatableindex=table.setmetatableindex
13347local formatters=string.formatters
13348local settings_to_hash=utilities.parsers.settings_to_hash
13349local sortedkeys=table.sortedkeys
13350local variant="default"
13351logs=logs or {}
13352local logs=logs
13353local moreinfo=[[
13354More information about ConTeXt and the tools that come with it can be found at:
13355]].."\n"..[[
13356maillist : ntg-context@ntg.nl / http://www.ntg.nl/mailman/listinfo/ntg-context
13357webpage  : http://www.pragma-ade.nl / http://tex.aanhet.net
13358wiki     : http://contextgarden.net
13359]]
13360formatters.add (
13361 formatters,"unichr",
13362 [["U+" .. format("%%05X",%s) .. " (" .. utfchar(%s) .. ")"]]
13363)
13364formatters.add (
13365 formatters,"chruni",
13366 [[utfchar(%s) .. " (U+" .. format("%%05X",%s) .. ")"]]
13367)
13368local function ignore() end
13369setmetatableindex(logs,function(t,k) t[k]=ignore;return ignore end)
13370local report,subreport,status,settarget,setformats,settranslations
13371local direct,subdirect,writer,pushtarget,poptarget,setlogfile,settimedlog,setprocessor,setformatters,newline
13372local function ansisupported(specification)
13373 if specification~="ansi" and specification~="ansilog" then
13374  return false
13375 elseif os and os.enableansi then
13376  return os.enableansi()
13377 else
13378  return false
13379 end
13380end
13381do
13382 local report_yes,subreport_yes,status_yes
13383 local report_nop,subreport_nop,status_nop
13384 local variants={
13385  default={
13386   formats={
13387    report_yes=formatters["%-15s | %s"],
13388    report_nop=formatters["%-15s |"],
13389    subreport_yes=formatters["%-15s | %s | %s"],
13390    subreport_nop=formatters["%-15s | %s |"],
13391    status_yes=formatters["%-15s : %s\n"],
13392    status_nop=formatters["%-15s :\n"],
13393   },
13394  },
13395  ansi={
13396   formats={
13397    report_yes=formatters["%-15s | %s"],
13398    report_nop=formatters["%-15s |"],
13399    subreport_yes=formatters["%-15s | %s | %s"],
13400    subreport_nop=formatters["%-15s | %s |"],
13401    status_yes=formatters["%-15s : %s\n"],
13402    status_nop=formatters["%-15s :\n"],
13403   },
13404  },
13405 }
13406 logs.flush=ignore
13407 writer=function(s)
13408  write_nl(s)
13409 end
13410 newline=function()
13411  write_nl("\n")
13412 end
13413 report=function(a,b,c,...)
13414  if c then
13415   write_nl(report_yes(a,formatters[b](c,...)))
13416  elseif b then
13417   write_nl(report_yes(a,b))
13418  elseif a then
13419   write_nl(report_nop(a))
13420  else
13421   write_nl("")
13422  end
13423 end
13424 subreport=function(a,sub,b,c,...)
13425  if c then
13426   write_nl(subreport_yes(a,sub,formatters[b](c,...)))
13427  elseif b then
13428   write_nl(subreport_yes(a,sub,b))
13429  elseif a then
13430   write_nl(subreport_nop(a,sub))
13431  else
13432   write_nl("")
13433  end
13434 end
13435 status=function(a,b,c,...) 
13436  if c then
13437   write_nl(status_yes(a,formatters[b](c,...)))
13438  elseif b then
13439   write_nl(status_yes(a,b)) 
13440  elseif a then
13441   write_nl(status_nop(a))
13442  else
13443   write_nl("\n")
13444  end
13445 end
13446 direct=ignore
13447 subdirect=ignore
13448 settarget=ignore
13449 pushtarget=ignore
13450 poptarget=ignore
13451 setformats=ignore
13452 settranslations=ignore
13453 setprocessor=function(f)
13454  local writeline=write_nl
13455  write_nl=function(s)
13456   writeline(f(s))
13457  end
13458 end
13459 setformatters=function(specification)
13460  local f=nil
13461  local d=variants.default
13462  if specification then
13463   if type(specification)=="table" then
13464    f=specification.formats or specification
13465   else
13466    if not ansisupported(specification) then
13467     specification="default"
13468    end
13469    local v=variants[specification]
13470    if v then
13471     f=v.formats
13472    end
13473   end
13474  end
13475  if f then
13476   d=d.formats
13477  else
13478   f=d.formats
13479   d=f
13480  end
13481  setmetatableindex(f,d)
13482  report_yes=f.report_yes
13483  report_nop=f.report_nop
13484  subreport_yes=f.subreport_yes
13485  subreport_nop=f.subreport_nop
13486  status_yes=f.status_yes
13487  status_nop=f.status_nop
13488 end
13489 setformatters(variant)
13490 setlogfile=function(name,keepopen)
13491  if name and name~="" then
13492   local localtime=os.localtime
13493   local writeline=write_nl
13494   if keepopen then
13495    local f=io.open(name,"ab")
13496    write_nl=function(s)
13497     writeline(s)
13498     f:write(localtime()," | ",s,"\n")
13499    end
13500   else
13501    write_nl=function(s)
13502     writeline(s)
13503     local f=io.open(name,"ab")
13504     f:write(localtime()," | ",s,"\n")
13505     f:close()
13506    end
13507   end
13508  end
13509  setlogfile=ignore
13510 end
13511 settimedlog=function()
13512  local localtime=os.localtime
13513  local writeline=write_nl
13514  write_nl=function(s)
13515   writeline(localtime().." | "..s)
13516  end
13517  settimedlog=ignore
13518 end
13519end
13520logs.report=report
13521logs.subreport=subreport
13522logs.status=status
13523logs.settarget=settarget
13524logs.pushtarget=pushtarget
13525logs.poptarget=poptarget
13526logs.setformats=setformats
13527logs.settranslations=settranslations
13528logs.setlogfile=setlogfile
13529logs.settimedlog=settimedlog
13530logs.setprocessor=setprocessor
13531logs.setformatters=setformatters
13532logs.direct=direct
13533logs.subdirect=subdirect
13534logs.writer=writer
13535logs.newline=newline
13536local data={}
13537local states=nil
13538local force=false
13539function logs.reporter(category,subcategory)
13540 local logger=data[category]
13541 if not logger then
13542  local state=states==true
13543  if not state and type(states)=="table" then
13544   for c,_ in next,states do
13545    if find(category,c) then
13546     state=true
13547     break
13548    end
13549   end
13550  end
13551  logger={
13552   reporters={},
13553   state=state,
13554  }
13555  data[category]=logger
13556 end
13557 local reporter=logger.reporters[subcategory or "default"]
13558 if not reporter then
13559  if subcategory then
13560   reporter=function(...)
13561    if force or not logger.state then
13562     subreport(category,subcategory,...)
13563    end
13564   end
13565   logger.reporters[subcategory]=reporter
13566  else
13567   local tag=category
13568   reporter=function(...)
13569    if force or not logger.state then
13570     report(category,...)
13571    end
13572   end
13573   logger.reporters.default=reporter
13574  end
13575 end
13576 return reporter
13577end
13578logs.new=logs.reporter
13579local ctxreport=logs.writer
13580function logs.setmessenger(m)
13581 ctxreport=m
13582end
13583function logs.messenger(category,subcategory)
13584 if subcategory then
13585  return function(...)
13586   ctxreport(subdirect(category,subcategory,...))
13587  end
13588 else
13589  return function(...)
13590   ctxreport(direct(category,...))
13591  end
13592 end
13593end
13594local function setblocked(category,value) 
13595 if category==true or category=="all" then
13596  category,value="*",true
13597 elseif category==false then
13598  category,value="*",false
13599 elseif value==nil then
13600  value=true
13601 end
13602 if category=="*" then
13603  states=value
13604  for k,v in next,data do
13605   v.state=value
13606  end
13607 else
13608  alllocked=false
13609  states=settings_to_hash(category,type(states)=="table" and states or nil)
13610  for c in next,states do
13611   local v=data[c]
13612   if v then
13613    v.state=value
13614   else
13615    local p=topattern(c,true,true)
13616    for k,v in next,data do
13617     if find(k,p) then
13618      v.state=value
13619     end
13620    end
13621   end
13622  end
13623 end
13624end
13625function logs.disable(category,value)
13626 setblocked(category,value==nil and true or value)
13627end
13628function logs.enable(category)
13629 setblocked(category,false)
13630end
13631function logs.categories()
13632 return sortedkeys(data)
13633end
13634function logs.show()
13635 local n,c,s,max=0,0,0,0
13636 for category,v in table.sortedpairs(data) do
13637  n=n+1
13638  local state=v.state
13639  local reporters=v.reporters
13640  local nc=#category
13641  if nc>c then
13642   c=nc
13643  end
13644  for subcategory,_ in next,reporters do
13645   local ns=#subcategory
13646   if ns>c then
13647    s=ns
13648   end
13649   local m=nc+ns
13650   if m>max then
13651    max=m
13652   end
13653  end
13654  local subcategories=concat(sortedkeys(reporters),", ")
13655  if state==true then
13656   state="disabled"
13657  elseif state==false then
13658   state="enabled"
13659  else
13660   state="unknown"
13661  end
13662  report("logging","category %a, subcategories %a, state %a",category,subcategories,state)
13663 end
13664 report("logging","categories: %s, max category: %s, max subcategory: %s, max combined: %s",n,c,s,max)
13665end
13666local delayed_reporters={}
13667setmetatableindex(delayed_reporters,function(t,k)
13668 local v=logs.reporter(k.name)
13669 t[k]=v
13670 return v
13671end)
13672function utilities.setters.report(setter,...)
13673 delayed_reporters[setter](...)
13674end
13675directives.register("logs.blocked",function(v)
13676 setblocked(v,true)
13677end)
13678directives.register("logs.target",function(v)
13679 settarget(v)
13680end)
13681local nesting=0
13682local verbose=false
13683local hasscheme=url.hasscheme
13684local simple=logs.reporter("comment")
13685logs.simple=simple
13686logs.simpleline=simple
13687logs.setprogram=ignore 
13688logs.extendbanner=ignore 
13689logs.reportlines=ignore 
13690logs.reportbanner=ignore 
13691logs.reportline=ignore 
13692logs.simplelines=ignore 
13693logs.help=ignore
13694local Carg,C,lpegmatch=lpeg.Carg,lpeg.C,lpeg.match
13695local p_newline=lpeg.patterns.newline
13696local linewise=(
13697 Carg(1)*C((1-p_newline)^1)/function(t,s) t.report(s) end+Carg(1)*p_newline^2/function(t)   t.report()  end+p_newline
13698)^1
13699local function reportlines(t,str)
13700 if str then
13701  lpegmatch(linewise,str,1,t)
13702 end
13703end
13704local function reportbanner(t)
13705 local banner=t.banner
13706 if banner then
13707  t.report(banner)
13708  t.report()
13709 end
13710end
13711local function reportversion(t)
13712 local banner=t.banner
13713 if banner then
13714  t.report(banner)
13715 end
13716end
13717local function reporthelp(t,...)
13718 local helpinfo=t.helpinfo
13719 if type(helpinfo)=="string" then
13720  reportlines(t,helpinfo)
13721 elseif type(helpinfo)=="table" then
13722  for i=1,select("#",...) do
13723   reportlines(t,t.helpinfo[select(i,...)])
13724   if i<n then
13725    t.report()
13726   end
13727  end
13728 end
13729end
13730local function reportinfo(t)
13731 t.report()
13732 reportlines(t,t.moreinfo)
13733end
13734local function reportexport(t,method)
13735 report(t.helpinfo)
13736end
13737local reporters={
13738 lines=reportlines,
13739 banner=reportbanner,
13740 version=reportversion,
13741 help=reporthelp,
13742 info=reportinfo,
13743 export=reportexport,
13744}
13745local exporters={
13746}
13747logs.reporters=reporters
13748logs.exporters=exporters
13749function logs.application(t)
13750 local arguments=environment and environment.arguments
13751 if arguments then
13752  local ansi=arguments.ansi or arguments.ansilog
13753  if ansi then
13754   logs.setformatters(arguments.ansi and "ansi" or "ansilog")
13755  end
13756 end
13757 t.name=t.name   or "unknown"
13758 t.banner=t.banner
13759 t.moreinfo=moreinfo
13760 t.report=logs.reporter(t.name)
13761 t.help=function(...)
13762  reporters.banner(t)
13763  reporters.help(t,...)
13764  reporters.info(t)
13765 end
13766 t.export=function(...)
13767  reporters.export(t,...)
13768 end
13769 t.identify=function()
13770  reporters.banner(t)
13771 end
13772 t.version=function()
13773  reporters.version(t)
13774 end
13775 return t
13776end
13777local f_syslog=formatters["%s %s => %s => %s => %s\r"]
13778function logs.system(whereto,process,jobname,category,fmt,arg,...)
13779 local message=f_syslog(datetime("%d/%m/%y %H:%m:%S"),process,jobname,category,arg==nil and fmt or format(fmt,arg,...))
13780 for i=1,10 do
13781  local f=openfile(whereto,"a") 
13782  if f then
13783   f:write(message)
13784   f:close()
13785   break
13786  else
13787   sleep(0.1)
13788  end
13789 end
13790end
13791local report_system=logs.reporter("system","logs")
13792if utilities then
13793 utilities.report=report_system
13794end
13795if package.helpers.report then
13796 package.helpers.report=logs.reporter("package loader") 
13797end
13798
13799
13800end -- of closure
13801
13802do -- create closure to overcome 200 locals limit
13803
13804package.loaded["trac-inf"] = package.loaded["trac-inf"] or true
13805
13806-- original size: 9740, stripped down to: 7296
13807
13808if not modules then modules={} end modules ['trac-inf']={
13809 version=1.001,
13810 comment="companion to trac-inf.mkiv",
13811 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
13812 copyright="PRAGMA ADE / ConTeXt Development Team",
13813 license="see context related readme files"
13814}
13815local type,tonumber,select=type,tonumber,select
13816local format,lower,find=string.format,string.lower,string.find
13817local concat=table.concat
13818local clock=os.gettimeofday or os.clock 
13819local setmetatableindex=table.setmetatableindex
13820local serialize=table.serialize
13821local formatters=string.formatters
13822statistics=statistics or {}
13823local statistics=statistics
13824statistics.enable=true
13825statistics.threshold=0.01
13826local statusinfo,n,registered,timers={},0,{},{}
13827setmetatableindex(timers,function(t,k)
13828 local v={ timing=0,loadtime=0,offset=0 }
13829 t[k]=v
13830 return v
13831end)
13832local function hastiming(instance)
13833 return instance and timers[instance]
13834end
13835local function resettiming(instance)
13836 timers[instance or "notimer"]={ timing=0,loadtime=0,offset=0 }
13837end
13838local ticks=clock
13839local seconds=function(n) return n or 0 end
13840if os.type~="windows" then
13841elseif lua.getpreciseticks then
13842 ticks=lua.getpreciseticks
13843 seconds=lua.getpreciseseconds
13844elseif FFISUPPORTED then
13845 local okay,kernel=pcall(ffi.load,"kernel32")
13846 if kernel then
13847  local tonumber=ffi.number or tonumber
13848  ffi.cdef[[
13849            int QueryPerformanceFrequency(int64_t *lpFrequency);
13850            int QueryPerformanceCounter(int64_t *lpPerformanceCount);
13851        ]]
13852  local target=ffi.new("__int64[1]")
13853  ticks=function()
13854   if kernel.QueryPerformanceCounter(target)==1 then
13855    return tonumber(target[0])
13856   else
13857    return 0
13858   end
13859  end
13860  local target=ffi.new("__int64[1]")
13861  seconds=function(ticks)
13862   if kernel.QueryPerformanceFrequency(target)==1 then
13863    return ticks/tonumber(target[0])
13864   else
13865    return 0
13866   end
13867  end
13868 end
13869else
13870end
13871local function starttiming(instance,reset)
13872 local timer=timers[instance or "notimer"]
13873 local it=timer.timing
13874 if reset then
13875  it=0
13876  timer.loadtime=0
13877 end
13878 if it==0 then
13879  timer.starttime=ticks()
13880  if not timer.loadtime then
13881   timer.loadtime=0
13882  end
13883 end
13884 timer.timing=it+1
13885end
13886local function stoptiming(instance)
13887 local timer=timers[instance or "notimer"]
13888 local it=timer.timing
13889 if it>1 then
13890  timer.timing=it-1
13891 else
13892  local starttime=timer.starttime
13893  if starttime and starttime>0 then
13894   local stoptime=ticks()
13895   local loadtime=stoptime-starttime
13896   timer.stoptime=stoptime
13897   timer.loadtime=timer.loadtime+loadtime
13898   timer.timing=0
13899   timer.starttime=0
13900  end
13901 end
13902end
13903local function benchmarktimer(instance)
13904 local timer=timers[instance or "notimer"]
13905 local it=timer.timing
13906 if it>1 then
13907  timer.timing=it-1
13908 else
13909  local starttime=timer.starttime
13910  if starttime and starttime>0 then
13911   timer.offset=ticks()-starttime
13912  else
13913   timer.offset=0
13914  end
13915 end
13916end
13917local function elapsed(instance)
13918 if type(instance)=="number" then
13919  return instance
13920 else
13921  local timer=timers[instance or "notimer"]
13922  return timer and seconds(timer.loadtime-2*(timer.offset or 0)) or 0
13923 end
13924end
13925local function currenttime(instance)
13926 if type(instance)=="number" then
13927  return instance
13928 else
13929  local timer=timers[instance or "notimer"]
13930  local it=timer.timing
13931  if it>1 then
13932  else
13933   local starttime=timer.starttime
13934   if starttime and starttime>0 then
13935    return seconds(timer.loadtime+ticks()-starttime-2*(timer.offset or 0))
13936   end
13937  end
13938  return 0
13939 end
13940end
13941local function elapsedtime(instance)
13942 return format("%0.3f",elapsed(instance))
13943end
13944local function elapsedindeed(instance)
13945 return elapsed(instance)>statistics.threshold
13946end
13947local function elapsedseconds(instance,rest) 
13948 if elapsedindeed(instance) then
13949  return format("%0.3f seconds %s",elapsed(instance),rest or "")
13950 end
13951end
13952statistics.hastiming=hastiming
13953statistics.resettiming=resettiming
13954statistics.starttiming=starttiming
13955statistics.stoptiming=stoptiming
13956statistics.currenttime=currenttime
13957statistics.elapsed=elapsed
13958statistics.elapsedtime=elapsedtime
13959statistics.elapsedindeed=elapsedindeed
13960statistics.elapsedseconds=elapsedseconds
13961statistics.benchmarktimer=benchmarktimer
13962function statistics.register(tag,fnc)
13963 if statistics.enable and type(fnc)=="function" then
13964  local rt=registered[tag] or (#statusinfo+1)
13965  statusinfo[rt]={ tag,fnc }
13966  registered[tag]=rt
13967  if #tag>n then n=#tag end
13968 end
13969end
13970local report=logs.reporter("mkiv lua stats")
13971function statistics.show()
13972 if statistics.enable then
13973  local register=statistics.register
13974  register("used platform",function()
13975   return format("%s, type: %s, binary subtree: %s",
13976    os.platform or "unknown",os.type or "unknown",environment.texos or "unknown")
13977  end)
13978  register("used engine",function()
13979   return format("%s version: %s, functionality level: %s, banner: %s",
13980    LUATEXENGINE,LUATEXVERSION,LUATEXFUNCTIONALITY,lower(status.banner))
13981  end)
13982  register("used hash slots",function()
13983   return format("%s of %s + %s",status.cs_count,status.hash_size,status.hash_extra)
13984  end)
13985  register("callbacks",statistics.callbacks)
13986  if JITSUPPORTED then
13987   local jitstatus=jit.status
13988   if jitstatus then
13989    local jitstatus={ jitstatus() }
13990    if jitstatus[1] then
13991     register("luajit options",concat(jitstatus," ",2))
13992    end
13993   end
13994  end
13995  register("lua properties",function()
13996   local hash=2^status.luatex_hashchars
13997   local mask=load([[τεχ = 1]]) and "utf" or "ascii"
13998   return format("engine: %s %s, used memory: %s, hash chars: min(%i,40), symbol mask: %s (%s)",
13999    jit and "luajit" or "lua",LUAVERSION,statistics.memused(),hash,mask,mask=="utf" and "τεχ" or "tex")
14000  end)
14001  register("runtime",statistics.runtime)
14002  logs.newline() 
14003  for i=1,#statusinfo do
14004   local s=statusinfo[i]
14005   local r=s[2]()
14006   if r then
14007    report("%s: %s",s[1],r)
14008   end
14009  end
14010  statistics.enable=false
14011 end
14012end
14013function statistics.memused() 
14014 local round=math.round or math.floor
14015 return format("%s MB, ctx: %s MB, max: %s MB",
14016  round(collectgarbage("count")/1000),
14017  round(status.luastate_bytes/1000000),
14018  status.luastate_bytes_max and round(status.luastate_bytes_max/1000000) or "unknown"
14019 )
14020end
14021starttiming(statistics)
14022function statistics.formatruntime(runtime) 
14023 return format("%s seconds",runtime)   
14024end
14025function statistics.runtime()
14026 stoptiming(statistics)
14027 local runtime=lua.getruntime and lua.getruntime() or elapsedtime(statistics)
14028 return statistics.formatruntime(runtime)
14029end
14030local report=logs.reporter("system")
14031function statistics.timed(action,all)
14032 starttiming("run")
14033 action()
14034 stoptiming("run")
14035 local runtime=tonumber(elapsedtime("run"))
14036 if all then
14037  local alltime=tonumber(lua.getruntime and lua.getruntime() or elapsedtime(statistics))
14038  if alltime and alltime>0 then
14039   report("total runtime: %0.3f seconds of %0.3f seconds",runtime,alltime)
14040   return
14041  end
14042 end
14043 report("total runtime: %0.3f seconds",runtime)
14044end
14045function statistics.tracefunction(base,tag,...)
14046 for i=1,select("#",...) do
14047  local name=select(i,...)
14048  local stat={}
14049  local func=base[name]
14050  setmetatableindex(stat,function(t,k) t[k]=0 return 0 end)
14051  base[name]=function(n,k,v) stat[k]=stat[k]+1 return func(n,k,v) end
14052  statistics.register(formatters["%s.%s"](tag,name),function() return serialize(stat,"calls") end)
14053 end
14054end
14055function status.getreadstate()
14056 return {
14057  filename=status.filename   or "?",
14058  linenumber=status.linenumber or 0,
14059  iocode=status.inputid or 0,
14060 }
14061end
14062
14063
14064end -- of closure
14065
14066do -- create closure to overcome 200 locals limit
14067
14068package.loaded["trac-pro"] = package.loaded["trac-pro"] or true
14069
14070-- original size: 5841, stripped down to: 3352
14071
14072if not modules then modules={} end modules ['trac-pro']={
14073 version=1.001,
14074 comment="companion to luat-lib.mkiv",
14075 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
14076 copyright="PRAGMA ADE / ConTeXt Development Team",
14077 license="see context related readme files"
14078}
14079local getmetatable,setmetatable,rawset,type,next=getmetatable,setmetatable,rawset,type,next
14080local trace_namespaces=false  trackers.register("system.namespaces",function(v) trace_namespaces=v end)
14081local report_system=logs.reporter("system","protection")
14082namespaces=namespaces or {}
14083local namespaces=namespaces
14084local registered={}
14085local function report_index(k,name)
14086 if trace_namespaces then
14087  report_system("reference to %a in protected namespace %a: %s",k,name)
14088  debugger.showtraceback(report_system)
14089 else
14090  report_system("reference to %a in protected namespace %a",k,name)
14091 end
14092end
14093local function report_newindex(k,name)
14094 if trace_namespaces then
14095  report_system("assignment to %a in protected namespace %a: %s",k,name)
14096  debugger.showtraceback(report_system)
14097 else
14098  report_system("assignment to %a in protected namespace %a",k,name)
14099 end
14100end
14101local function register(name)
14102 local data=name=="global" and _G or _G[name]
14103 if not data then
14104  return 
14105 end
14106 registered[name]=data
14107 local m=getmetatable(data)
14108 if not m then
14109  m={}
14110  setmetatable(data,m)
14111 end
14112 local index,newindex={},{}
14113 m.__saved__index=m.__index
14114 m.__no__index=function(t,k)
14115  if not index[k] then
14116   index[k]=true
14117   report_index(k,name)
14118  end
14119  return nil
14120 end
14121 m.__saved__newindex=m.__newindex
14122 m.__no__newindex=function(t,k,v)
14123  if not newindex[k] then
14124   newindex[k]=true
14125   report_newindex(k,name)
14126  end
14127  rawset(t,k,v)
14128 end
14129 m.__protection__depth=0
14130end
14131local function private(name) 
14132 local data=registered[name]
14133 if not data then
14134  data=_G[name]
14135  if not data then
14136   data={}
14137   _G[name]=data
14138  end
14139  register(name)
14140 end
14141 return data
14142end
14143local function protect(name)
14144 local data=registered[name]
14145 if not data then
14146  return
14147 end
14148 local m=getmetatable(data)
14149 local pd=m.__protection__depth
14150 if pd>0 then
14151  m.__protection__depth=pd+1
14152 else
14153  m.__save_d_index,m.__saved__newindex=m.__index,m.__newindex
14154  m.__index,m.__newindex=m.__no__index,m.__no__newindex
14155  m.__protection__depth=1
14156 end
14157end
14158local function unprotect(name)
14159 local data=registered[name]
14160 if not data then
14161  return
14162 end
14163 local m=getmetatable(data)
14164 local pd=m.__protection__depth
14165 if pd>1 then
14166  m.__protection__depth=pd-1
14167 else
14168  m.__index,m.__newindex=m.__saved__index,m.__saved__newindex
14169  m.__protection__depth=0
14170 end
14171end
14172local function protectall()
14173 for name,_ in next,registered do
14174  if name~="global" then
14175   protect(name)
14176  end
14177 end
14178end
14179local function unprotectall()
14180 for name,_ in next,registered do
14181  if name~="global" then
14182   unprotect(name)
14183  end
14184 end
14185end
14186namespaces.register=register  
14187namespaces.private=private   
14188namespaces.protect=protect
14189namespaces.unprotect=unprotect
14190namespaces.protectall=protectall
14191namespaces.unprotectall=unprotectall
14192namespaces.private("namespaces") registered={} register("global") 
14193directives.register("system.protect",function(v)
14194 if v then
14195  protectall()
14196 else
14197  unprotectall()
14198 end
14199end)
14200directives.register("system.checkglobals",function(v)
14201 if v then
14202  report_system("enabling global namespace guard")
14203  protect("global")
14204 else
14205  report_system("disabling global namespace guard")
14206  unprotect("global")
14207 end
14208end)
14209
14210
14211end -- of closure
14212
14213do -- create closure to overcome 200 locals limit
14214
14215package.loaded["util-lua"] = package.loaded["util-lua"] or true
14216
14217-- original size: 7166, stripped down to: 5009
14218
14219if not modules then modules={} end modules ['util-lua']={
14220 version=1.001,
14221 comment="companion to luat-lib.mkiv",
14222 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
14223 comment="the strip code is written by Peter Cawley",
14224 copyright="PRAGMA ADE / ConTeXt Development Team",
14225 license="see context related readme files"
14226}
14227local rep,sub,byte,dump,format=string.rep,string.sub,string.byte,string.dump,string.format
14228local load,loadfile,type,collectgarbage=load,loadfile,type,collectgarbage
14229utilities=utilities or {}
14230utilities.lua=utilities.lua or {}
14231local luautilities=utilities.lua
14232local report_lua=logs.reporter("system","lua")
14233local report_mem=logs.reporter("system","lua memory")
14234local tracestripping=false
14235local tracememory=false
14236luautilities.stripcode=true  
14237luautilities.alwaysstripcode=false 
14238luautilities.nofstrippedchunks=0
14239luautilities.nofstrippedbytes=0
14240local strippedchunks={} 
14241luautilities.strippedchunks=strippedchunks
14242if not LUATEXENGINE then
14243 LUATEXENGINE=status.luatex_engine and string.lower(status.luatex_engine)
14244 JITSUPPORTED=LUATEXENGINE=="luajittex" or jit
14245 CONTEXTLMTXMODE=CONTEXTLMTXMODE or (LUATEXENGINE=="luametatex" and 1) or 0
14246end
14247luautilities.suffixes={
14248 tma="tma",
14249 tmc=(CONTEXTLMTXMODE and CONTEXTLMTXMODE>0 and "tmd") or (jit and "tmb") or "tmc",
14250 lua="lua",
14251 lmt="lmt",
14252 luc=(CONTEXTLMTXMODE and CONTEXTLMTXMODE>0 and "lud") or (jit and "lub") or "luc",
14253 lui="lui",
14254 luv="luv",
14255 luj="luj",
14256 tua="tua",
14257 tuc=(CONTEXTLMTXMODE and CONTEXTLMTXMODE>0 and "tud") or (jit and "tub") or "tuc",
14258}
14259local function register(name) 
14260 if tracestripping then
14261  report_lua("stripped bytecode from %a",name or "unknown")
14262 end
14263 strippedchunks[#strippedchunks+1]=name
14264 luautilities.nofstrippedchunks=luautilities.nofstrippedchunks+1
14265end
14266local function stupidcompile(luafile,lucfile,strip)
14267 local code=io.loaddata(luafile)
14268 if code and code~="" then
14269  code=load(code)
14270  if code then
14271   code=dump(code,strip and luautilities.stripcode or luautilities.alwaysstripcode)
14272   if code and code~="" then
14273    register(name)
14274    io.savedata(lucfile,code)
14275    return true,0
14276   end
14277  else
14278   report_lua("fatal error %a in file %a",1,luafile)
14279  end
14280 else
14281  report_lua("fatal error %a in file %a",2,luafile)
14282 end
14283 return false,0
14284end
14285function luautilities.loadedluacode(fullname,forcestrip,name,macros)
14286 name=name or fullname
14287 if macros then
14288  macros=lua.macros
14289 end
14290 local code,message
14291 if macros then
14292  code,message=macros.loaded(fullname,true,false)
14293 else
14294  code,message=loadfile(fullname)
14295 end
14296 if code then
14297  code()
14298 else
14299  report_lua("loading of file %a failed:\n\t%s",fullname,message or "no message")
14300  code,message=loadfile(fullname)
14301 end
14302 if forcestrip and luautilities.stripcode then
14303  if type(forcestrip)=="function" then
14304   forcestrip=forcestrip(fullname)
14305  end
14306  if forcestrip or luautilities.alwaysstripcode then
14307   register(name)
14308   return load(dump(code,true)),0
14309  else
14310   return code,0
14311  end
14312 elseif luautilities.alwaysstripcode then
14313  register(name)
14314  return load(dump(code,true)),0
14315 else
14316  return code,0
14317 end
14318end
14319function luautilities.strippedloadstring(code,name,forcestrip) 
14320 local code,message=load(code)
14321 if not code then
14322  report_lua("loading of file %a failed:\n\t%s",name,message or "no message")
14323 end
14324 if forcestrip and luautilities.stripcode or luautilities.alwaysstripcode then
14325  register(name)
14326  return load(dump(code,true)),0 
14327 else
14328  return code,0
14329 end
14330end
14331function luautilities.loadstring(code,name) 
14332 local code,message=load(code)
14333 if not code then
14334  report_lua("loading of file %a failed:\n\t%s",name,message or "no message")
14335 end
14336 return code,0
14337end
14338function luautilities.compile(luafile,lucfile,cleanup,strip,fallback) 
14339 report_lua("compiling %a into %a",luafile,lucfile)
14340 os.remove(lucfile)
14341 local done=stupidcompile(luafile,lucfile,strip~=false)
14342 if done then
14343  report_lua("dumping %a into %a stripped",luafile,lucfile)
14344  if cleanup==true and lfs.isfile(lucfile) and lfs.isfile(luafile) then
14345   report_lua("removing %a",luafile)
14346   os.remove(luafile)
14347  end
14348 end
14349 return done
14350end
14351function luautilities.loadstripped(...)
14352 local l=load(...)
14353 if l then
14354  return load(dump(l,true))
14355 end
14356end
14357local finalizers={}
14358setmetatable(finalizers,{
14359 __gc=function(t)
14360  for i=1,#t do
14361   pcall(t[i]) 
14362  end
14363 end
14364} )
14365function luautilities.registerfinalizer(f)
14366 finalizers[#finalizers+1]=f
14367end
14368function luautilities.checkmemory(previous,threshold,trace) 
14369 local current=collectgarbage("count")
14370 if previous then
14371  local checked=(threshold or 64)*1024
14372  local delta=current-previous
14373  if current-previous>checked then
14374   collectgarbage("collect")
14375   local afterwards=collectgarbage("count")
14376   if trace or tracememory then
14377    report_mem("previous %r MB, current %r MB, delta %r MB, threshold %r MB, afterwards %r MB",
14378     previous/1024,current/1024,delta/1024,threshold,afterwards)
14379   end
14380   return afterwards
14381  elseif trace or tracememory then
14382   report_mem("previous %r MB, current %r MB, delta %r MB, threshold %r MB",
14383    previous/1024,current/1024,delta/1024,threshold)
14384  end
14385 end
14386 return current
14387end
14388
14389
14390end -- of closure
14391
14392do -- create closure to overcome 200 locals limit
14393
14394package.loaded["util-deb"] = package.loaded["util-deb"] or true
14395
14396-- original size: 10416, stripped down to: 7076
14397
14398if not modules then modules={} end modules ['util-deb']={
14399 version=1.001,
14400 comment="companion to luat-lib.mkiv",
14401 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
14402 copyright="PRAGMA ADE / ConTeXt Development Team",
14403 license="see context related readme files"
14404}
14405local type,next,tostring,tonumber=type,next,tostring,tonumber
14406local format,find,sub,gsub=string.format,string.find,string.sub,string.gsub
14407local insert,remove,sort=table.insert,table.remove,table.sort
14408local setmetatableindex=table.setmetatableindex
14409utilities=utilities or {}
14410local debugger=utilities.debugger or {}
14411utilities.debugger=debugger
14412local report=logs.reporter("debugger")
14413local ticks=os.gettimeofday or os.clock
14414local seconds=function(n) return n or 0 end
14415local overhead=0
14416local dummycalls=10*1000
14417local nesting=0
14418local names={}
14419local initialize=false
14420if lua.getpreciseticks then
14421 initialize=function()
14422  ticks=lua.getpreciseticks
14423  seconds=lua.getpreciseseconds
14424  initialize=false
14425 end
14426elseif not (FFISUPPORTED and ffi) then
14427elseif os.type=="windows" then
14428 initialize=function()
14429  local kernel=ffilib("kernel32","system") 
14430  if kernel then
14431   local tonumber=ffi.number or tonumber
14432   ffi.cdef[[
14433                int QueryPerformanceFrequency(int64_t *lpFrequency);
14434                int QueryPerformanceCounter(int64_t *lpPerformanceCount);
14435            ]]
14436   local target=ffi.new("__int64[1]")
14437   ticks=function()
14438    if kernel.QueryPerformanceCounter(target)==1 then
14439     return tonumber(target[0])
14440    else
14441     return 0
14442    end
14443   end
14444   local target=ffi.new("__int64[1]")
14445   seconds=function(ticks)
14446    if kernel.QueryPerformanceFrequency(target)==1 then
14447     return ticks/tonumber(target[0])
14448    else
14449     return 0
14450    end
14451   end
14452  end
14453  initialize=false
14454 end
14455elseif os.type=="unix" then
14456 initialize=function()
14457  local C=ffi.C
14458  local tonumber=ffi.number or tonumber
14459  ffi.cdef [[
14460            /* what a mess */
14461            typedef int clk_id_t;
14462            typedef enum { CLOCK_REALTIME, CLOCK_MONOTONIC, CLOCK_PROCESS_CPUTIME_ID } clk_id;
14463            typedef struct timespec { long sec; long nsec; } ctx_timespec;
14464            int clock_gettime(clk_id_t timerid, struct timespec *t);
14465        ]]
14466  local target=ffi.new("ctx_timespec[?]",1)
14467  local clock=C.CLOCK_PROCESS_CPUTIME_ID
14468  ticks=function ()
14469   C.clock_gettime(clock,target)
14470   return tonumber(target[0].sec*1000000000+target[0].nsec)
14471  end
14472  seconds=function(ticks)
14473   return ticks/1000000000
14474  end
14475  initialize=false
14476 end
14477end
14478setmetatableindex(names,function(t,name)
14479 local v=setmetatableindex(function(t,source)
14480  local v=setmetatableindex(function(t,line)
14481   local v={ total=0,count=0,nesting=0 }
14482   t[line]=v
14483   return v
14484  end)
14485  t[source]=v
14486  return v
14487 end)
14488 t[name]=v
14489 return v
14490end)
14491local getinfo=nil
14492local sethook=nil
14493local function hook(where)
14494 local f=getinfo(2,"nSl")
14495 if f then
14496  local source=f.short_src
14497  if not source then
14498   return
14499  end
14500  local line=f.linedefined or 0
14501  local name=f.name
14502  if not name then
14503   local what=f.what
14504   if what=="C" then
14505    name="<anonymous>"
14506   else
14507    name=f.namewhat or what or "<unknown>"
14508   end
14509  end
14510  local data=names[name][source][line]
14511  if where=="call" then
14512   local nesting=data.nesting
14513   if nesting==0 then
14514    data.count=data.count+1
14515    insert(data,ticks())
14516    data.nesting=1
14517   else
14518    data.nesting=nesting+1
14519   end
14520  elseif where=="return" then
14521   local nesting=data.nesting
14522   if nesting==1 then
14523    local t=remove(data)
14524    if t then
14525     data.total=data.total+ticks()-t
14526    end
14527    data.nesting=0
14528   else
14529    data.nesting=nesting-1
14530   end
14531  end
14532 end
14533end
14534function debugger.showstats(printer,threshold)
14535 local printer=printer or report
14536 local calls=0
14537 local functions=0
14538 local dataset={}
14539 local length=0
14540 local realtime=0
14541 local totaltime=0
14542 local threshold=threshold or 0
14543 for name,sources in next,names do
14544  for source,lines in next,sources do
14545   for line,data in next,lines do
14546    local count=data.count
14547    if count>threshold then
14548     if #name>length then
14549      length=#name
14550     end
14551     local total=data.total
14552     local real=total
14553     if real>0 then
14554      real=total-(count*overhead/dummycalls)
14555      if real<0 then
14556       real=0
14557      end
14558      realtime=realtime+real
14559     end
14560     totaltime=totaltime+total
14561     dataset[#dataset+1]={ real,total,count,name,source,line<0 and 0 or line }
14562    end
14563   end
14564  end
14565 end
14566 sort(dataset,function(a,b)
14567  if a[1]==b[1] then
14568   if a[2]==b[2] then
14569    if a[3]==b[3] then
14570     if a[4]==b[4] then
14571      if a[5]==b[5] then
14572       return a[6]<b[6]
14573      else
14574       return a[5]<b[5]
14575      end
14576     else
14577      return a[4]<b[4]
14578     end
14579    else
14580     return b[3]<a[3]
14581    end
14582   else
14583    return b[2]<a[2]
14584   end
14585  else
14586   return b[1]<a[1]
14587  end
14588 end)
14589 if length>50 then
14590  length=50
14591 end
14592 local fmt=string.formatters["%4.9k s  %3.3k %%  %4.9k s  %3.3k %%  %8i #  %-"..length.."s  %4i  %s"]
14593 for i=1,#dataset do
14594  local data=dataset[i]
14595  local real=data[1]
14596  local total=data[2]
14597  local count=data[3]
14598  local name=data[4]
14599  local source=data[5]
14600  local line=data[6]
14601  calls=calls+count
14602  functions=functions+1
14603  name=gsub(name,"%s+"," ")
14604  if #name>length then
14605   name=sub(name,1,length)
14606  end
14607  printer(fmt(seconds(total),100*total/totaltime,seconds(real),100*real/realtime,count,name,line,source))
14608 end
14609 printer("")
14610 printer(format("functions : %i",functions))
14611 printer(format("calls     : %i",calls))
14612 printer(format("overhead  : %f",seconds(overhead/1000)))
14613end
14614local function getdebug()
14615 if sethook and getinfo then
14616  return
14617 end
14618 if not debug then
14619  local okay
14620  okay,debug=pcall(require,"debug")
14621 end
14622 if type(debug)~="table" then
14623  return
14624 end
14625 getinfo=debug.getinfo
14626 sethook=debug.sethook
14627 if type(getinfo)~="function" then
14628  getinfo=nil
14629 end
14630 if type(sethook)~="function" then
14631  sethook=nil
14632 end
14633end
14634function debugger.savestats(filename,threshold)
14635 local f=io.open(filename,'w')
14636 if f then
14637  debugger.showstats(function(str) f:write(str,"\n") end,threshold)
14638  f:close()
14639 end
14640end
14641function debugger.enable()
14642 getdebug()
14643 if sethook and getinfo and nesting==0 then
14644  running=true
14645  if initialize then
14646   initialize()
14647  end
14648  sethook(hook,"cr")
14649  local function dummy() end
14650  local t=ticks()
14651  for i=1,dummycalls do
14652   dummy()
14653  end
14654  overhead=ticks()-t
14655 end
14656 if nesting>0 then
14657  nesting=nesting+1
14658 end
14659end
14660function debugger.disable()
14661 if nesting>0 then
14662  nesting=nesting-1
14663 end
14664 if sethook and getinfo and nesting==0 then
14665  sethook()
14666 end
14667end
14668local function showtraceback(rep) 
14669 getdebug()
14670 if getinfo then
14671  local level=2 
14672  local reporter=rep or report
14673  while true do
14674   local info=getinfo(level,"Sl")
14675   if not info then
14676    break
14677   elseif info.what=="C" then
14678    reporter("%2i : %s",level-1,"C function")
14679   else
14680    reporter("%2i : %s : %s",level-1,info.short_src,info.currentline)
14681   end
14682   level=level+1
14683  end
14684 end
14685end
14686debugger.showtraceback=showtraceback
14687if luac then
14688 local show,dump=luac.print,string.dump
14689 function luac.inspect(v)
14690  if type(v)=="function" then
14691   local ok,str=xpcall(dump,function() end,v)
14692   if ok then
14693    v=str
14694   end
14695  end
14696  if type(v)=="string" then
14697   show(v,true)
14698  else
14699   print(v)
14700  end
14701 end
14702end
14703
14704
14705end -- of closure
14706
14707do -- create closure to overcome 200 locals limit
14708
14709package.loaded["util-tpl"] = package.loaded["util-tpl"] or true
14710
14711-- original size: 7722, stripped down to: 4212
14712
14713if not modules then modules={} end modules ['util-tpl']={
14714 version=1.001,
14715 comment="companion to luat-lib.mkiv",
14716 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
14717 copyright="PRAGMA ADE / ConTeXt Development Team",
14718 license="see context related readme files"
14719}
14720utilities.templates=utilities.templates or {}
14721local templates=utilities.templates
14722local trace_template=false  trackers.register("templates.trace",function(v) trace_template=v end)
14723local report_template=logs.reporter("template")
14724local tostring,next=tostring,next
14725local format,sub,byte=string.format,string.sub,string.byte
14726local P,C,R,Cs,Cc,Carg,lpegmatch,lpegpatterns=lpeg.P,lpeg.C,lpeg.R,lpeg.Cs,lpeg.Cc,lpeg.Carg,lpeg.match,lpeg.patterns
14727local formatters=string.formatters
14728local replacer
14729local function replacekey(k,t,how,recursive)
14730 local v=t[k]
14731 if not v then
14732  if trace_template then
14733   report_template("unknown key %a",k)
14734  end
14735  return ""
14736 else
14737  v=tostring(v)
14738  if trace_template then
14739   report_template("setting key %a to value %a",k,v)
14740  end
14741  if recursive then
14742   return lpegmatch(replacer,v,1,t,how,recursive)
14743  else
14744   return v
14745  end
14746 end
14747end
14748local sqlescape=lpeg.replacer {
14749 { "'","''"   },
14750 { "\\","\\\\" },
14751 { "\r\n","\\n"  },
14752 { "\r","\\n"  },
14753}
14754local sqlquoted=Cs(Cc("'")*sqlescape*Cc("'"))
14755lpegpatterns.sqlescape=sqlescape
14756lpegpatterns.sqlquoted=sqlquoted
14757local luaescape=lpegpatterns.luaescape
14758local escapers={
14759 lua=function(s)
14760  return lpegmatch(luaescape,s)
14761 end,
14762 sql=function(s)
14763  return lpegmatch(sqlescape,s)
14764 end,
14765}
14766local quotedescapers={
14767 lua=function(s)
14768  return format("%q",s)
14769 end,
14770 sql=function(s)
14771  return lpegmatch(sqlquoted,s)
14772 end,
14773}
14774local luaescaper=escapers.lua
14775local quotedluaescaper=quotedescapers.lua
14776local function replacekeyunquoted(s,t,how,recurse) 
14777 if how==false then
14778  return replacekey(s,t,how,recurse)
14779 else
14780  local escaper=how and escapers[how] or luaescaper
14781  return escaper(replacekey(s,t,how,recurse))
14782 end
14783end
14784local function replacekeyquoted(s,t,how,recurse) 
14785 if how==false then
14786  return replacekey(s,t,how,recurse)
14787 else
14788  local escaper=how and quotedescapers[how] or quotedluaescaper
14789  return escaper(replacekey(s,t,how,recurse))
14790 end
14791end
14792local function replaceoptional(l,m,r,t,how,recurse)
14793 local v=t[l]
14794 return v and v~="" and lpegmatch(replacer,r,1,t,how or "lua",recurse or false) or ""
14795end
14796local function replaceformatted(l,m,r,t,how,recurse)
14797 local v=t[r]
14798 return v and formatters[l](v)
14799end
14800local single=P("%")  
14801local double=P("%%") 
14802local lquoted=P("%[") 
14803local rquoted=P("]%") 
14804local lquotedq=P("%(") 
14805local rquotedq=P(")%") 
14806local escape=double/'%%'
14807local nosingle=single/''
14808local nodouble=double/''
14809local nolquoted=lquoted/''
14810local norquoted=rquoted/''
14811local nolquotedq=lquotedq/''
14812local norquotedq=rquotedq/''
14813local nolformatted=P(":")/"%%"
14814local norformatted=P(":")/""
14815local noloptional=P("%?")/''
14816local noroptional=P("?%")/''
14817local nomoptional=P(":")/''
14818local args=Carg(1)*Carg(2)*Carg(3)
14819local key=nosingle*((C((1-nosingle)^1)*args)/replacekey)*nosingle
14820local quoted=nolquotedq*((C((1-norquotedq)^1)*args)/replacekeyquoted)*norquotedq
14821local unquoted=nolquoted*((C((1-norquoted)^1)*args)/replacekeyunquoted)*norquoted
14822local optional=noloptional*((C((1-nomoptional)^1)*nomoptional*C((1-noroptional)^1)*args)/replaceoptional)*noroptional
14823local formatted=nosingle*((Cs(nolformatted*(1-norformatted )^1)*norformatted*C((1-nosingle)^1)*args)/replaceformatted)*nosingle
14824local any=P(1)
14825   replacer=Cs((unquoted+quoted+formatted+escape+optional+key+any)^0)
14826local function replace(str,mapping,how,recurse)
14827 if mapping and str then
14828  return lpegmatch(replacer,str,1,mapping,how or "lua",recurse or false) or str
14829 else
14830  return str
14831 end
14832end
14833templates.replace=replace
14834function templates.replacer(str,how,recurse) 
14835 return function(mapping)
14836  return lpegmatch(replacer,str,1,mapping,how or "lua",recurse or false) or str
14837 end
14838end
14839function templates.load(filename,mapping,how,recurse)
14840 local data=io.loaddata(filename) or ""
14841 if mapping and next(mapping) then
14842  return replace(data,mapping,how,recurse)
14843 else
14844  return data
14845 end
14846end
14847function templates.resolve(t,mapping,how,recurse)
14848 if not mapping then
14849  mapping=t
14850 end
14851 for k,v in next,t do
14852  t[k]=replace(v,mapping,how,recurse)
14853 end
14854 return t
14855end
14856
14857
14858end -- of closure
14859
14860do -- create closure to overcome 200 locals limit
14861
14862package.loaded["util-sbx"] = package.loaded["util-sbx"] or true
14863
14864-- original size: 21376, stripped down to: 13435
14865
14866if not modules then modules={} end modules ['util-sbx']={
14867 version=1.001,
14868 comment="companion to luat-lib.mkiv",
14869 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
14870 copyright="PRAGMA ADE / ConTeXt Development Team",
14871 license="see context related readme files"
14872}
14873if not sandbox then require("l-sandbox") end 
14874local next,type=next,type
14875local replace=utilities.templates.replace
14876local collapsepath=file.collapsepath
14877local expandname=dir.expandname
14878local sortedhash=table.sortedhash
14879local lpegmatch=lpeg.match
14880local platform=os.type
14881local P,S,C=lpeg.P,lpeg.S,lpeg.C
14882local gsub=string.gsub
14883local lower=string.lower
14884local find=string.find
14885local concat=string.concat
14886local unquoted=string.unquoted
14887local optionalquoted=string.optionalquoted
14888local basename=file.basename
14889local nameonly=file.nameonly
14890local sandbox=sandbox
14891local validroots={}
14892local validrunners={}
14893local validbinaries=true 
14894local validlibraries=true 
14895local validators={}
14896local finalized=nil
14897local trace=false
14898local p_validroot=nil
14899local p_split=lpeg.firstofsplit(" ")
14900local report=logs.reporter("sandbox")
14901trackers.register("sandbox",function(v) trace=v end) 
14902sandbox.setreporter(report)
14903sandbox.finalizer {
14904 category="files",
14905 action=function()
14906  finalized=true
14907 end
14908}
14909local function registerroot(root,what) 
14910 if finalized then
14911  report("roots are already finalized")
14912 else
14913  if type(root)=="table" then
14914   root,what=root[1],root[2]
14915  end
14916  if type(root)=="string" and root~="" then
14917   root=collapsepath(expandname(root))
14918   if what=="r" or what=="ro" or what=="readable" then
14919    what="read"
14920   elseif what=="w" or what=="wo" or what=="writable" then
14921    what="write"
14922   end
14923   validroots[root]=what=="write" or false
14924  end
14925 end
14926end
14927sandbox.finalizer {
14928 category="files",
14929 action=function() 
14930  if p_validroot then
14931   report("roots are already initialized")
14932  else
14933   sandbox.registerroot(".","write")
14934   for name in sortedhash(validroots) do
14935    if p_validroot then
14936     p_validroot=P(name)+p_validroot
14937    else
14938     p_validroot=P(name)
14939    end
14940   end
14941   p_validroot=p_validroot/validroots
14942  end
14943 end
14944}
14945local function registerbinary(name)
14946 if finalized then
14947  report("binaries are already finalized")
14948 elseif type(name)=="string" and name~="" then
14949  if not validbinaries then
14950   return
14951  end
14952  if validbinaries==true then
14953   validbinaries={ [name]=true }
14954  else
14955   validbinaries[name]=true
14956  end
14957 elseif name==true then
14958  validbinaries={}
14959 end
14960end
14961local function registerlibrary(name)
14962 if finalized then
14963  report("libraries are already finalized")
14964 elseif type(name)=="string" and name~="" then
14965  if not validlibraries then
14966   return
14967  end
14968  if validlibraries==true then
14969   validlibraries={ [nameonly(name)]=true }
14970  else
14971   validlibraries[nameonly(name)]=true
14972  end
14973 elseif name==true then
14974  validlibraries={}
14975 end
14976end
14977local p_write=S("wa")    p_write=(1-p_write)^0*p_write
14978local p_path=S("\\/~$%:")  p_path=(1-p_path )^0*p_path  
14979local function normalized(name) 
14980 if platform=="windows" then
14981  name=gsub(name,"/","\\")
14982 end
14983 return name
14984end
14985function sandbox.possiblepath(name)
14986 return lpegmatch(p_path,name) and true or false
14987end
14988local filenamelogger=false
14989function sandbox.setfilenamelogger(l)
14990 filenamelogger=type(l)=="function" and l or false
14991end
14992local function validfilename(name,what)
14993 if p_validroot and type(name)=="string" and lpegmatch(p_path,name) then
14994  local asked=collapsepath(expandname(name))
14995  local okay=lpegmatch(p_validroot,asked)
14996  if okay==true then
14997   if filenamelogger then
14998    filenamelogger(name,"w",asked,true)
14999   end
15000   return name
15001  elseif okay==false then
15002   if not what then
15003    if filenamelogger then
15004     filenamelogger(name,"r",asked,true)
15005    end
15006    return name
15007   elseif lpegmatch(p_write,what) then
15008    if filenamelogger then
15009     filenamelogger(name,"w",asked,false)
15010    end
15011    return 
15012   else
15013    if filenamelogger then
15014     filenamelogger(name,"r",asked,true)
15015    end
15016    return name
15017   end
15018  elseif filenamelogger then
15019   filenamelogger(name,"*",name,false)
15020  end
15021 else
15022  return name
15023 end
15024end
15025local function readable(name,finalized)
15026 return validfilename(name,"r")
15027end
15028local function normalizedreadable(name,finalized)
15029 local valid=validfilename(name,"r")
15030 if valid then
15031  return normalized(valid)
15032 end
15033end
15034local function writeable(name,finalized)
15035 return validfilename(name,"w")
15036end
15037local function normalizedwriteable(name,finalized)
15038 local valid=validfilename(name,"w")
15039 if valid then
15040  return normalized(valid)
15041 end
15042end
15043validators.readable=readable
15044validators.writeable=normalizedwriteable
15045validators.normalizedreadable=normalizedreadable
15046validators.normalizedwriteable=writeable
15047validators.filename=readable
15048table.setmetatableindex(validators,function(t,k)
15049 if k then
15050  t[k]=readable
15051 end
15052 return readable
15053end)
15054function validators.string(s,finalized)
15055 if finalized and suspicious(s) then
15056  return ""
15057 else
15058  return s
15059 end
15060end
15061function validators.cache(s)
15062 if finalized then
15063  return basename(s)
15064 else
15065  return s
15066 end
15067end
15068function validators.url(s)
15069 if finalized and find("^file:") then
15070  return ""
15071 else
15072  return s
15073 end
15074end
15075local function filehandlerone(action,one,...)
15076 local checkedone=validfilename(one)
15077 if checkedone then
15078  return action(one,...)
15079 else
15080 end
15081end
15082local function filehandlertwo(action,one,two,...)
15083 local checkedone=validfilename(one)
15084 if checkedone then
15085  local checkedtwo=validfilename(two)
15086  if checkedtwo then
15087   return action(one,two,...)
15088  else
15089  end
15090 else
15091 end
15092end
15093local function iohandler(action,one,...)
15094 if type(one)=="string" then
15095  local checkedone=validfilename(one)
15096  if checkedone then
15097   return action(one,...)
15098  end
15099 elseif one then
15100  return action(one,...)
15101 else
15102  return action()
15103 end
15104end
15105local osexecute=sandbox.original(os.execute)
15106local iopopen=sandbox.original(io.popen)
15107local reported={}
15108local function validcommand(name,program,template,checkers,defaults,variables,reporter,strict)
15109 if validbinaries~=false and (validbinaries==true or validbinaries[program]) then
15110  local binpath=nil
15111  if variables then
15112   for variable,value in next,variables do
15113    local chktype=checkers[variable]
15114    if chktype=="verbose" then
15115    else
15116     local checker=validators[chktype]
15117     if checker and type(value)=="string" then
15118      value=checker(unquoted(value),strict)
15119      if value then
15120       variables[variable]=optionalquoted(value)
15121      else
15122       report("variable %a with value %a fails the check",variable,value)
15123       return
15124      end
15125     else
15126      report("variable %a has no checker",variable)
15127      return
15128     end
15129    end
15130   end
15131   for variable,default in next,defaults do
15132    local value=variables[variable]
15133    if not value or value=="" then
15134     local chktype=checkers[variable]
15135     if chktype=="verbose" then
15136     elseif type(default)=="string" then
15137      local checker=validators[chktype]
15138      if checker then
15139       default=checker(unquoted(default),strict)
15140       if default then
15141        variables[variable]=optionalquoted(default)
15142       else
15143        report("variable %a with default %a fails the check",variable,default)
15144        return
15145       end
15146      end
15147     end
15148    end
15149   end
15150   binpath=variables.binarypath
15151  end
15152  if type(binpath)=="string" and binpath~="" then
15153   program=binpath.."/"..program
15154  end
15155  local command=program.." "..replace(template,variables)
15156  if reporter then
15157   reporter("executing runner %a: %s",name,command)
15158  elseif trace then
15159   report("executing runner %a: %s",name,command)
15160  end
15161  return command
15162 elseif not reported[name] then
15163  report("executing program %a of runner %a is not permitted",program,name)
15164  reported[name]=true
15165 end
15166end
15167local runners={
15168 resultof=function(...)
15169  local command=validcommand(...)
15170  if command then
15171   if trace then
15172    report("resultof: %s",command)
15173   end
15174   local handle=iopopen(command,"rb") 
15175   if handle then
15176    local result=handle:read("*all") or ""
15177    handle:close()
15178    return result
15179   end
15180  end
15181 end,
15182 execute=function(...)
15183  local command=validcommand(...)
15184  if command then
15185   if trace then
15186    report("execute: %s",command)
15187   end
15188   local okay=osexecute(command)
15189   return okay
15190  end
15191 end,
15192 pipeto=function(...)
15193  local command=validcommand(...)
15194  if command then
15195   if trace then
15196    report("pipeto: %s",command)
15197   end
15198   return iopopen(command,"w") 
15199  end
15200 end,
15201 command=function(...)
15202  local command=validcommand(...)
15203  if command then
15204   if trace then
15205    report("command: %s",command)
15206   end
15207   return command
15208  end
15209 end,
15210}
15211function sandbox.registerrunner(specification)
15212 if type(specification)=="string" then
15213  local wrapped=validrunners[specification]
15214  inspect(table.sortedkeys(validrunners))
15215  if wrapped then
15216   return wrapped
15217  else
15218   report("unknown predefined runner %a",specification)
15219   return
15220  end
15221 end
15222 if type(specification)~="table" then
15223  report("specification should be a table (or string)")
15224  return
15225 end
15226 local name=specification.name
15227 if type(name)~="string" then
15228  report("invalid name, string expected",name)
15229  return
15230 end
15231 if validrunners[name] then
15232  report("invalid name, runner %a already defined",name)
15233  return
15234 end
15235 local program=specification.program
15236 if type(program)=="string" then
15237 elseif type(program)=="table" then
15238  program=program[platform] or program.default or program.unix
15239 end
15240 if type(program)~="string" or program=="" then
15241  report("invalid runner %a specified for platform %a",name,platform)
15242  return
15243 end
15244 local template=specification.template
15245 if not template then
15246  report("missing template for runner %a",name)
15247  return
15248 end
15249 local method=specification.method   or "execute"
15250 local checkers=specification.checkers or {}
15251 local defaults=specification.defaults or {}
15252 local runner=runners[method]
15253 if runner then
15254  local finalized=finalized 
15255  local wrapped=function(variables)
15256   return runner(name,program,template,checkers,defaults,variables,specification.reporter,finalized)
15257  end
15258  validrunners[name]=wrapped
15259  return wrapped
15260 else
15261  validrunners[name]=nil
15262  report("invalid method for runner %a",name)
15263 end
15264end
15265function sandbox.getrunner(name)
15266 return name and validrunners[name]
15267end
15268local function suspicious(str)
15269 return (find(str,"[/\\]") or find(command,"..",1,true)) and true or false
15270end
15271local function binaryrunner(action,command,...)
15272 if validbinaries==false then
15273  report("no binaries permitted, ignoring command: %s",command)
15274  return
15275 end
15276 if type(command)~="string" then
15277  report("command should be a string")
15278  return
15279 end
15280 local program=lpegmatch(p_split,command)
15281 if not program or program=="" then
15282  report("unable to filter binary from command: %s",command)
15283  return
15284 end
15285 if validbinaries==true then
15286 elseif not validbinaries[program] then
15287  report("binary not permitted, ignoring command: %s",command)
15288  return
15289 elseif suspicious(command) then
15290  report("/ \\ or .. found, ignoring command (use sandbox.registerrunner): %s",command)
15291  return
15292 end
15293 return action(command,...)
15294end
15295local function dummyrunner(action,command,...)
15296 if type(command)=="table" then
15297  command=concat(command," ",command[0] and 0 or 1)
15298 end
15299 report("ignoring command: %s",command)
15300end
15301sandbox.filehandlerone=filehandlerone
15302sandbox.filehandlertwo=filehandlertwo
15303sandbox.iohandler=iohandler
15304function sandbox.disablerunners()
15305 validbinaries=false
15306end
15307function sandbox.disablelibraries()
15308 validlibraries=false
15309end
15310if FFISUPPORTED and ffi then
15311 function sandbox.disablelibraries()
15312  validlibraries=false
15313  for k,v in next,ffi do
15314   if k~="gc" then
15315    ffi[k]=nil
15316   end
15317  end
15318 end
15319 local fiiload=ffi.load
15320 if fiiload then
15321  local reported={}
15322  function ffi.load(name,...)
15323   if validlibraries==false then
15324   elseif validlibraries==true then
15325    return fiiload(name,...)
15326   elseif validlibraries[nameonly(name)] then
15327    return fiiload(name,...)
15328   else
15329   end
15330   if not reported[name] then
15331    report("using library %a is not permitted",name)
15332    reported[name]=true
15333   end
15334   return nil
15335  end
15336 end
15337end
15338local overload=sandbox.overload
15339local register=sandbox.register
15340 overload(loadfile,filehandlerone,"loadfile") 
15341if io then
15342 overload(io.open,filehandlerone,"io.open")
15343 overload(io.popen,binaryrunner,"io.popen")
15344 overload(io.input,iohandler,"io.input")
15345 overload(io.output,iohandler,"io.output")
15346 overload(io.lines,filehandlerone,"io.lines")
15347end
15348if os then
15349 overload(os.execute,binaryrunner,"os.execute")
15350 overload(os.spawn,dummyrunner,"os.spawn") 
15351 overload(os.exec,dummyrunner,"os.exec")  
15352 overload(os.resultof,binaryrunner,"os.resultof")
15353 overload(os.pipeto,binaryrunner,"os.pipeto")
15354 overload(os.rename,filehandlertwo,"os.rename")
15355 overload(os.remove,filehandlerone,"os.remove")
15356end
15357if lfs then
15358 overload(lfs.chdir,filehandlerone,"lfs.chdir")
15359 overload(lfs.mkdir,filehandlerone,"lfs.mkdir")
15360 overload(lfs.rmdir,filehandlerone,"lfs.rmdir")
15361 overload(lfs.isfile,filehandlerone,"lfs.isfile")
15362 overload(lfs.isdir,filehandlerone,"lfs.isdir")
15363 overload(lfs.attributes,filehandlerone,"lfs.attributes")
15364 overload(lfs.dir,filehandlerone,"lfs.dir")
15365 overload(lfs.lock_dir,filehandlerone,"lfs.lock_dir")
15366 overload(lfs.touch,filehandlerone,"lfs.touch")
15367 overload(lfs.link,filehandlertwo,"lfs.link")
15368 overload(lfs.setmode,filehandlerone,"lfs.setmode")
15369 overload(lfs.readlink,filehandlerone,"lfs.readlink")
15370 overload(lfs.shortname,filehandlerone,"lfs.shortname")
15371 overload(lfs.symlinkattributes,filehandlerone,"lfs.symlinkattributes")
15372end
15373if zip then
15374 zip.open=register(zip.open,filehandlerone,"zip.open")
15375end
15376sandbox.registerroot=registerroot
15377sandbox.registerbinary=registerbinary
15378sandbox.registerlibrary=registerlibrary
15379sandbox.validfilename=validfilename
15380
15381
15382end -- of closure
15383
15384do -- create closure to overcome 200 locals limit
15385
15386package.loaded["util-mrg"] = package.loaded["util-mrg"] or true
15387
15388-- original size: 7819, stripped down to: 5881
15389
15390if not modules then modules={} end modules ['util-mrg']={
15391 version=1.001,
15392 comment="companion to luat-lib.mkiv",
15393 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
15394 copyright="PRAGMA ADE / ConTeXt Development Team",
15395 license="see context related readme files"
15396}
15397local gsub,format=string.gsub,string.format
15398local concat=table.concat
15399local type,next=type,next
15400local P,R,S,V,Ct,C,Cs,Cc,Cp,Cmt,Cb,Cg=lpeg.P,lpeg.R,lpeg.S,lpeg.V,lpeg.Ct,lpeg.C,lpeg.Cs,lpeg.Cc,lpeg.Cp,lpeg.Cmt,lpeg.Cb,lpeg.Cg
15401local lpegmatch,patterns=lpeg.match,lpeg.patterns
15402utilities=utilities or {}
15403local merger=utilities.merger or {}
15404utilities.merger=merger
15405merger.strip_comment=true
15406local report=logs.reporter("system","merge")
15407utilities.report=report
15408local m_begin_merge="begin library merge"
15409local m_end_merge="end library merge"
15410local m_begin_closure="do -- create closure to overcome 200 locals limit"
15411local m_end_closure="end -- of closure"
15412local m_pattern="%c+".."%-%-%s+"..m_begin_merge.."%c+(.-)%c+".."%-%-%s+"..m_end_merge.."%c+"
15413local m_format="\n\n-- "..m_begin_merge.."\n%s\n".."-- "..m_end_merge.."\n\n"
15414local m_faked="-- ".."created merged file".."\n\n".."-- "..m_begin_merge.."\n\n".."-- "..m_end_merge.."\n\n"
15415local m_report=[[
15416-- used libraries    : %s
15417-- skipped libraries : %s
15418-- original bytes    : %s
15419-- stripped bytes    : %s
15420]]
15421local m_preloaded=[[package.loaded[%q] = package.loaded[%q] or true]]
15422local function self_fake()
15423 return m_faked
15424end
15425local function self_nothing()
15426 return ""
15427end
15428local function self_load(name)
15429 local data=io.loaddata(name) or ""
15430 if data=="" then
15431  report("unknown file %a",name)
15432 else
15433  report("inserting file %a",name)
15434 end
15435 return data or ""
15436end
15437local space=patterns.space
15438local eol=patterns.newline
15439local equals=P("=")^0
15440local open=P("[")*Cg(equals,"init")*P("[")*P("\n")^-1
15441local close=P("]")*C(equals)*P("]")
15442local closeeq=Cmt(close*Cb("init"),function(s,i,a,b) return a==b end)
15443local longstring=open*(1-closeeq)^0*close
15444local quoted=patterns.quoted
15445local digit=patterns.digit
15446local emptyline=space^0*eol
15447local operator1=P("<=")+P(">=")+P("~=")+P("..")+S("/^<>=*+%%")
15448local operator2=S("*+/")
15449local operator3=S("-")
15450local operator4=P("..")
15451local separator=S(",;")
15452local ignore=(P("]")*space^1*P("=")*space^1*P("]"))/"]=["+(P("=")*space^1*P("{"))/"={"+(P("(")*space^1)/"("+(P("{")*(space+eol)^1*P("}"))/"{}"
15453local strings=quoted 
15454local longcmt=(emptyline^0*P("--")*longstring*emptyline^0)/""
15455local longstr=longstring
15456local comment=emptyline^0*P("--")*P("-")^0*(1-eol)^0*emptyline^1/"\n"
15457local optionalspaces=space^0/""
15458local mandatespaces=space^1/""
15459local optionalspacing=(eol+space)^0/""
15460local mandatespacing=(eol+space)^1/""
15461local pack=digit*space^1*operator4*optionalspacing+optionalspacing*operator1*optionalspacing+optionalspacing*operator2*optionalspaces+mandatespacing*operator3*mandatespaces+optionalspaces*separator*optionalspaces
15462local lines=emptyline^2/"\n"
15463local spaces=(space*space)/" "
15464local spaces=(space*space*space*space)/" "
15465local compact=Cs ((
15466 ignore+strings+longcmt+longstr+comment+pack+lines+spaces+1
15467)^1 )
15468local strip=Cs((emptyline^2/"\n"+1)^0)
15469local stripreturn=Cs((1-P("return")*space^1*P(1-space-eol)^1*(space+eol)^0*P(-1))^1)
15470function merger.compact(data)
15471 return lpegmatch(strip,lpegmatch(compact,data))
15472end
15473local function self_compact(data)
15474 local delta=0
15475 if merger.strip_comment then
15476  local before=#data
15477  data=lpegmatch(compact,data)
15478  data=lpegmatch(strip,data)
15479  local after=#data
15480  delta=before-after
15481  report("original size %s, compacted to %s, stripped %s",before,after,delta)
15482  data=format("-- original size: %s, stripped down to: %s\n\n%s",before,after,data)
15483 end
15484 return lpegmatch(stripreturn,data) or data,delta
15485end
15486local function self_save(name,data)
15487 if data~="" then
15488  io.savedata(name,data)
15489  report("saving %s with size %s",name,#data)
15490 end
15491end
15492local function self_swap(data,code)
15493 return data~="" and (gsub(data,m_pattern,function() return format(m_format,code) end,1)) or ""
15494end
15495local function self_libs(libs,list)
15496 local result,f,frozen,foundpath={},nil,false,nil
15497 result[#result+1]="\n"
15498 if type(libs)=='string' then libs={ libs } end
15499 if type(list)=='string' then list={ list } end
15500 for i=1,#libs do
15501  local lib=libs[i]
15502  for j=1,#list do
15503   local pth=gsub(list[j],"\\","/") 
15504   report("checking library path %a",pth)
15505   local name=pth.."/"..lib
15506   if lfs.isfile(name) then
15507    foundpath=pth
15508   end
15509  end
15510  if foundpath then break end
15511 end
15512 if foundpath then
15513  report("using library path %a",foundpath)
15514  local right,wrong,original,stripped={},{},0,0
15515  for i=1,#libs do
15516   local lib=libs[i]
15517   local fullname=foundpath.."/"..lib
15518   if lfs.isfile(fullname) then
15519    report("using library %a",fullname)
15520    local preloaded=file.nameonly(lib)
15521    local data=io.loaddata(fullname,true)
15522    original=original+#data
15523    local data,delta=self_compact(data)
15524    right[#right+1]=lib
15525    result[#result+1]=m_begin_closure
15526    result[#result+1]=format(m_preloaded,preloaded,preloaded)
15527    result[#result+1]=data
15528    result[#result+1]=m_end_closure
15529    stripped=stripped+delta
15530   else
15531    report("skipping library %a",fullname)
15532    wrong[#wrong+1]=lib
15533   end
15534  end
15535  right=#right>0 and concat(right," ") or "-"
15536  wrong=#wrong>0 and concat(wrong," ") or "-"
15537  report("used libraries: %a",right)
15538  report("skipped libraries: %a",wrong)
15539  report("original bytes: %a",original)
15540  report("stripped bytes: %a",stripped)
15541  result[#result+1]=format(m_report,right,wrong,original,stripped)
15542 else
15543  report("no valid library path found")
15544 end
15545 return concat(result,"\n\n")
15546end
15547function merger.selfcreate(libs,list,target)
15548 if target then
15549  self_save(target,self_swap(self_fake(),self_libs(libs,list)))
15550 end
15551end
15552function merger.selfmerge(name,libs,list,target)
15553 self_save(target or name,self_swap(self_load(name),self_libs(libs,list)))
15554end
15555function merger.selfclean(name)
15556 self_save(name,self_swap(self_load(name),self_nothing()))
15557end
15558
15559
15560end -- of closure
15561
15562do -- create closure to overcome 200 locals limit
15563
15564package.loaded["util-env"] = package.loaded["util-env"] or true
15565
15566-- original size: 10594, stripped down to: 5492
15567
15568if not modules then modules={} end modules ['util-env']={
15569 version=1.001,
15570 comment="companion to luat-lib.mkiv",
15571 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
15572 copyright="PRAGMA ADE / ConTeXt Development Team",
15573 license="see context related readme files"
15574}
15575local allocate,mark=utilities.storage.allocate,utilities.storage.mark
15576local format,sub,match,gsub,find=string.format,string.sub,string.match,string.gsub,string.find
15577local unquoted,quoted,optionalquoted=string.unquoted,string.quoted,string.optionalquoted
15578local concat,insert,remove=table.concat,table.insert,table.remove
15579local globfiles=dir.glob
15580environment=environment or {}
15581local environment=environment
15582os.setlocale(nil,nil) function os.setlocale() end
15583local validengines=allocate {
15584 ["luatex"]=true,
15585 ["luajittex"]=true,
15586}
15587local basicengines=allocate {
15588 ["luatex"]="luatex",
15589 ["texlua"]="luatex",
15590 ["texluac"]="luatex",
15591 ["luajittex"]="luajittex",
15592 ["texluajit"]="luajittex",
15593}
15594local luaengines=allocate {
15595 ["lua"]=true,
15596 ["luajit"]=true,
15597}
15598environment.validengines=validengines
15599environment.basicengines=basicengines
15600if not arg then
15601 environment.used_as_library=true
15602elseif luaengines[file.removesuffix(arg[-1])] then
15603elseif validengines[file.removesuffix(arg[0])] then
15604 if arg[1]=="--luaonly" then
15605  arg[-1]=arg[0]
15606  arg[ 0]=arg[2]
15607  for k=3,#arg do
15608   arg[k-2]=arg[k]
15609  end
15610  remove(arg) 
15611  remove(arg) 
15612 else
15613 end
15614 local originalzero=file.basename(arg[0])
15615 local specialmapping={ luatools=="base" }
15616 if originalzero~="mtxrun" and originalzero~="mtxrun.lua" then
15617    arg[0]=specialmapping[originalzero] or originalzero
15618    insert(arg,0,"--script")
15619    insert(arg,0,"mtxrun")
15620 end
15621end
15622environment.arguments=allocate()
15623environment.files=allocate()
15624environment.sortedflags=nil
15625function environment.initializearguments(arg)
15626 local arguments={}
15627 local files={}
15628 environment.arguments=arguments
15629 environment.files=files
15630 environment.sortedflags=nil
15631 for index=1,#arg do
15632  local argument=arg[index]
15633  if index>0 then
15634   local flag,value=match(argument,"^%-+(.-)=(.-)$")
15635   if flag then
15636    flag=gsub(flag,"^c:","")
15637    arguments[flag]=unquoted(value or "")
15638   else
15639    flag=match(argument,"^%-+(.+)")
15640    if flag then
15641     flag=gsub(flag,"^c:","")
15642     arguments[flag]=true
15643    else
15644     files[#files+1]=argument
15645    end
15646   end
15647  end
15648 end
15649 if not environment.ownname then
15650  if os.selfpath and os.selfname then
15651   environment.ownname=file.addsuffix(file.join(os.selfpath,os.selfname),"lua")
15652  end
15653 end
15654 environment.ownname=file.reslash(environment.ownname or arg[0] or 'unknown.lua')
15655end
15656function environment.setargument(name,value)
15657 environment.arguments[name]=value
15658end
15659function environment.getargument(name,partial)
15660 local arguments=environment.arguments
15661 local sortedflags=environment.sortedflags
15662 if arguments[name] then
15663  return arguments[name]
15664 elseif partial then
15665  if not sortedflags then
15666   sortedflags=allocate(table.sortedkeys(arguments))
15667   for k=1,#sortedflags do
15668    sortedflags[k]="^"..sortedflags[k]
15669   end
15670   environment.sortedflags=sortedflags
15671  end
15672  for k=1,#sortedflags do
15673   local v=sortedflags[k]
15674   if find(name,v) then
15675    return arguments[sub(v,2,#v)]
15676   end
15677  end
15678 end
15679 return nil
15680end
15681environment.argument=environment.getargument
15682function environment.splitarguments(separator) 
15683 local done,before,after=false,{},{}
15684 local originalarguments=environment.originalarguments
15685 for k=1,#originalarguments do
15686  local v=originalarguments[k]
15687  if not done and v==separator then
15688   done=true
15689  elseif done then
15690   after[#after+1]=v
15691  else
15692   before[#before+1]=v
15693  end
15694 end
15695 return before,after
15696end
15697function environment.reconstructcommandline(arg,noquote)
15698 local resolveprefix=resolvers.resolve 
15699 arg=arg or environment.originalarguments
15700 if noquote and #arg==1 then
15701  return unquoted(resolveprefix and resolveprefix(arg[1]) or arg[1])
15702 elseif #arg>0 then
15703  local result={}
15704  for i=1,#arg do
15705   result[i]=optionalquoted(resolveprefix and resolveprefix(arg[i]) or resolveprefix)
15706  end
15707  return concat(result," ")
15708 else
15709  return ""
15710 end
15711end
15712function environment.relativepath(path,root)
15713 if not path then
15714  path=""
15715 end
15716 if not file.is_rootbased_path(path) then
15717  if not root then
15718   root=file.pathpart(environment.ownscript or environment.ownname or ".")
15719  end
15720  if root=="" then
15721   root="."
15722  end
15723  path=root.."/"..path
15724 end
15725 return file.collapsepath(path,true)
15726end
15727if arg then
15728 local newarg,instring={},false
15729 for index=1,#arg do
15730  local argument=arg[index]
15731  if find(argument,"^\"") then
15732   if find(argument,"\"$") then
15733    newarg[#newarg+1]=gsub(argument,"^\"(.-)\"$","%1")
15734    instring=false
15735   else
15736    newarg[#newarg+1]=gsub(argument,"^\"","")
15737    instring=true
15738   end
15739  elseif find(argument,"\"$") then
15740   if instring then
15741    newarg[#newarg]=newarg[#newarg].." "..gsub(argument,"\"$","")
15742    instring=false
15743   else
15744    newarg[#newarg+1]=argument
15745   end
15746  elseif instring then
15747   newarg[#newarg]=newarg[#newarg].." "..argument
15748  else
15749   newarg[#newarg+1]=argument
15750  end
15751 end
15752 for i=1,-5,-1 do
15753  newarg[i]=arg[i]
15754 end
15755 environment.initializearguments(newarg)
15756 environment.originalarguments=mark(newarg)
15757 environment.rawarguments=mark(arg)
15758 arg={} 
15759end
15760function environment.globfiles(files)
15761 if not files then
15762  files=environment.files
15763 end
15764 if files then
15765  local globbed={}
15766  for i=1,#files do
15767   local f=files[i]
15768   if find(f,"%*") then
15769    local g=globfiles(f)
15770    if g then
15771     for i=1,#g do
15772      globbed[#globbed+1]=g[i]
15773     end
15774    end
15775   else
15776    globbed[#globbed+1]=f
15777   end
15778  end
15779  return globbed
15780 end
15781end
15782
15783
15784end -- of closure
15785
15786do -- create closure to overcome 200 locals limit
15787
15788package.loaded["luat-env"] = package.loaded["luat-env"] or true
15789
15790-- original size: 6293, stripped down to: 4141
15791
15792 if not modules then modules={} end modules ['luat-env']={
15793 version=1.001,
15794 comment="companion to luat-lib.mkiv",
15795 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
15796 copyright="PRAGMA ADE / ConTeXt Development Team",
15797 license="see context related readme files"
15798}
15799local rawset,loadfile=rawset,loadfile
15800local gsub=string.gsub
15801local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
15802local report_lua=logs.reporter("resolvers","lua")
15803local luautilities=utilities.lua
15804local luasuffixes=luautilities.suffixes
15805local texgettoks=tex and tex.gettoks
15806environment=environment or {}
15807local environment=environment
15808local mt={
15809 __index=function(_,k)
15810  if k=="version" then
15811   local version=texgettoks and texgettoks("contextversiontoks")
15812   if version and version~="" then
15813    rawset(environment,"version",version)
15814    return version
15815   else
15816    return "unknown"
15817   end
15818  elseif k=="jobname" or k=="formatname" then
15819   local name=tex and tex[k]
15820   if name or name=="" then
15821    rawset(environment,k,name)
15822    return name
15823   else
15824    return "unknown"
15825   end
15826  elseif k=="outputfilename" then
15827   local name=environment.jobname
15828   rawset(environment,k,name)
15829   return name
15830  end
15831 end
15832}
15833setmetatable(environment,mt)
15834function environment.texfile(filename)
15835 return resolvers.findfile(filename,'tex')
15836end
15837function environment.luafile(filename) 
15838 if CONTEXTLMTXMODE and CONTEXTLMTXMODE>0 and file.suffix(filename)=="lua" then
15839  local resolved=resolvers.findfile(file.replacesuffix(filename,"lmt")) or ""
15840  if resolved~="" then
15841   return resolved
15842  end
15843 end
15844 local resolved=resolvers.findfile(filename,'tex') or ""
15845 if resolved~="" then
15846  return resolved
15847 end
15848 resolved=resolvers.findfile(filename,'texmfscripts') or ""
15849 if resolved~="" then
15850  return resolved
15851 end
15852 return resolvers.findfile(filename,'luatexlibs') or ""
15853end
15854local stripindeed=false  directives.register("system.compile.strip",function(v) stripindeed=v end)
15855local function strippable(filename)
15856 if stripindeed then
15857  local modu=modules[file.nameonly(filename)]
15858  return modu and modu.dataonly
15859 else
15860  return false
15861 end
15862end
15863function environment.luafilechunk(filename,silent,macros,optional) 
15864 filename=file.replacesuffix(filename,"lua")
15865 local fullname=environment.luafile(filename)
15866 if fullname and fullname~="" then
15867  local data=luautilities.loadedluacode(fullname,strippable,filename,macros)
15868  if not silent then
15869   report_lua("loading file %a %s",fullname,not data and "failed" or "succeeded")
15870  end
15871  return data
15872 else
15873  if not optional and not silent then
15874   report_lua("unknown file %a",filename)
15875  end
15876  return nil
15877 end
15878end
15879function environment.loadluafile(filename,version)
15880 local lucname,luaname,chunk
15881 local basename=file.removesuffix(filename)
15882 if basename==filename then
15883  luaname=file.addsuffix(basename,luasuffixes.lua)
15884  lucname=file.addsuffix(basename,luasuffixes.luc)
15885 else
15886  luaname=filename 
15887  lucname=nil
15888 end
15889 local fullname=(lucname and environment.luafile(lucname)) or ""
15890 if fullname~="" then
15891  if trace_locating then
15892   report_lua("loading %a",fullname)
15893  end
15894  chunk=loadfile(fullname) 
15895 end
15896 if chunk then
15897  chunk()
15898  if version then
15899   local v=version 
15900   if modules and modules[filename] then
15901    v=modules[filename].version 
15902   elseif versions and versions[filename] then
15903    v=versions[filename]  
15904   end
15905   if v==version then
15906    return true
15907   else
15908    if trace_locating then
15909     report_lua("version mismatch for %a, lua version %a, luc version %a",filename,v,version)
15910    end
15911    environment.loadluafile(filename)
15912   end
15913  else
15914   return true
15915  end
15916 end
15917 fullname=(luaname and environment.luafile(luaname)) or ""
15918 if fullname~="" then
15919  if trace_locating then
15920   report_lua("loading %a",fullname)
15921  end
15922  chunk=loadfile(fullname) 
15923  if not chunk then
15924   if trace_locating then
15925    report_lua("unknown file %a",filename)
15926   end
15927  else
15928   chunk()
15929   return true
15930  end
15931 end
15932 return false
15933end
15934environment.filenames=setmetatable({},{
15935 __index=function(t,k)
15936  local v=environment.files[k]
15937  if v then
15938   return (gsub(v,"%.+$",""))
15939  end
15940 end,
15941 __newindex=function(t,k)
15942 end,
15943 __len=function(t)
15944  return #environment.files
15945 end,
15946} )
15947
15948
15949end -- of closure
15950
15951do -- create closure to overcome 200 locals limit
15952
15953package.loaded["util-zip"] = package.loaded["util-zip"] or true
15954
15955-- original size: 33051, stripped down to: 16324
15956
15957if not modules then modules={} end modules ['util-zip']={
15958 version=1.001,
15959 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
15960 copyright="PRAGMA ADE / ConTeXt Development Team",
15961 license="see context related readme files"
15962}
15963local type,tostring,tonumber=type,tostring,tonumber
15964local sort,concat=table.sort,table.concat
15965local find,format,sub,gsub=string.find,string.format,string.sub,string.gsub
15966local osdate,ostime,osclock=os.date,os.time,os.clock
15967local ioopen=io.open
15968local loaddata,savedata=io.loaddata,io.savedata
15969local filejoin,isdir,dirname,mkdirs=file.join,lfs.isdir,file.dirname,dir.mkdirs
15970local suffix,suffixes=file.suffix,file.suffixes
15971local openfile=io.open
15972gzip=gzip or {} 
15973if not zlib then
15974 zlib=xzip 
15975elseif not xzip then
15976 xzip=zlib
15977end
15978local files=utilities.files
15979local openfile=files.open
15980local closefile=files.close
15981local getsize=files.size
15982local readstring=files.readstring
15983local readcardinal2=files.readcardinal2le
15984local readcardinal4=files.readcardinal4le
15985local setposition=files.setposition
15986local getposition=files.getposition
15987local skipbytes=files.skip
15988local band=bit32.band
15989local rshift=bit32.rshift
15990local lshift=bit32.lshift
15991local zlibdecompress=zlib.decompress
15992local zlibdecompresssize=zlib.decompresssize
15993local zlibchecksum=zlib.crc32
15994if not CONTEXTLMTXMODE or CONTEXTLMTXMODE==0 then
15995 local cs=zlibchecksum
15996 zlibchecksum=function(str,n) return cs(n or 0,str) end
15997end
15998local decompress=function(source)   return zlibdecompress (source,-15)   end 
15999local decompresssize=function(source,targetsize) return zlibdecompresssize(source,targetsize,-15) end 
16000local calculatecrc=function(buffer,initial) return zlibchecksum   (initial or 0,buffer)   end
16001local zipfiles={}
16002utilities.zipfiles=zipfiles
16003local openzipfile,closezipfile,unzipfile,foundzipfile,getziphash,getziplist  do
16004 function openzipfile(name)
16005  return {
16006   name=name,
16007   handle=openfile(name,0),
16008  }
16009 end
16010 local function update(handle,data)
16011  position=data.offset
16012  setposition(handle,position)
16013  local signature=readstring(handle,4)
16014  if signature=="PK\3\4" then
16015   local version=readcardinal2(handle)
16016   local flag=readcardinal2(handle)
16017   local method=readcardinal2(handle)
16018          skipbytes(handle,4)
16019   local crc32=readcardinal4(handle)
16020   local compressed=readcardinal4(handle)
16021   local uncompressed=readcardinal4(handle)
16022   local namelength=readcardinal2(handle)
16023   local extralength=readcardinal2(handle)
16024   local filename=readstring(handle,namelength)
16025   local descriptor=band(flag,8)~=0
16026   local encrypted=band(flag,1)~=0
16027   local acceptable=method==0 or method==8
16028   local skipped=0
16029   local size=0
16030   if encrypted then
16031    size=readcardinal2(handle)
16032    skipbytes(handle,size)
16033    skipped=skipped+size+2
16034    skipbytes(8)
16035    skipped=skipped+8
16036    size=readcardinal2(handle)
16037    skipbytes(handle,size)
16038    skipped=skipped+size+2
16039    size=readcardinal4(handle)
16040    skipbytes(handle,size)
16041    skipped=skipped+size+4
16042    size=readcardinal2(handle)
16043    skipbytes(handle,size)
16044    skipped=skipped+size+2
16045   end
16046   if acceptable then
16047     if        filename~=data.filename  then
16048    else
16049     position=position+30+namelength+extralength+skipped
16050     data.position=position
16051     return position
16052    end
16053   else
16054   end
16055  end
16056  data.position=false
16057  return false
16058 end
16059 local function collect(z)
16060  if not z.list then
16061   local list={}
16062   local hash={}
16063   local position=0
16064   local index=0
16065   local handle=z.handle
16066   local size=getsize(handle)
16067   for i=size-4,size-64*1024,-1 do
16068    setposition(handle,i)
16069    local enddirsignature=readcardinal4(handle)
16070    if enddirsignature==0x06054B50 then
16071     local thisdisknumber=readcardinal2(handle)
16072     local centraldisknumber=readcardinal2(handle)
16073     local thisnofentries=readcardinal2(handle)
16074     local totalnofentries=readcardinal2(handle)
16075     local centralsize=readcardinal4(handle)
16076     local centraloffset=readcardinal4(handle)
16077     local commentlength=readcardinal2(handle)
16078     local comment=readstring(handle,length)
16079     if size-i>=22 then
16080      if thisdisknumber==centraldisknumber then
16081       setposition(handle,centraloffset)
16082       while true do
16083        if readcardinal4(handle)==0x02014B50 then
16084                skipbytes(handle,4)
16085         local flag=readcardinal2(handle)
16086         local method=readcardinal2(handle)
16087                skipbytes(handle,4)
16088         local crc32=readcardinal4(handle)
16089         local compressed=readcardinal4(handle)
16090         local uncompressed=readcardinal4(handle)
16091         local namelength=readcardinal2(handle)
16092         local extralength=readcardinal2(handle)
16093         local commentlength=readcardinal2(handle)
16094                skipbytes(handle,8)
16095         local headeroffset=readcardinal4(handle)
16096         local filename=readstring(handle,namelength)
16097                skipbytes(handle,extralength+commentlength)
16098         local descriptor=band(flag,8)~=0
16099         local encrypted=band(flag,1)~=0
16100         local acceptable=method==0 or method==8
16101         if acceptable then
16102          index=index+1
16103          local data={
16104           filename=filename,
16105           index=index,
16106           position=nil,
16107           method=method,
16108           compressed=compressed,
16109           uncompressed=uncompressed,
16110           crc32=crc32,
16111           encrypted=encrypted,
16112           offset=headeroffset,
16113          }
16114          hash[filename]=data
16115          list[index]=data
16116         end
16117        else
16118         break
16119        end
16120       end
16121      end
16122      break
16123     end
16124    end
16125   end
16126   z.list=list
16127   z.hash=hash
16128  end
16129 end
16130 function getziplist(z)
16131  local list=z.list
16132  if not list then
16133   collect(z)
16134  end
16135  return z.list
16136 end
16137 function getziphash(z)
16138  local hash=z.hash
16139  if not hash then
16140   collect(z)
16141  end
16142  return z.hash
16143 end
16144 function foundzipfile(z,name)
16145  return getziphash(z)[name]
16146 end
16147 function closezipfile(z)
16148  local f=z.handle
16149  if f then
16150   closefile(f)
16151   z.handle=nil
16152  end
16153 end
16154 function unzipfile(z,filename,check)
16155  local hash=z.hash
16156  if not hash then
16157   hash=zipfiles.hash(z)
16158  end
16159  local data=hash[filename] 
16160  if not data then
16161  end
16162  if data then
16163   local handle=z.handle
16164   local position=data.position
16165   local compressed=data.compressed
16166   if position==nil then
16167    position=update(handle,data)
16168   end
16169   if position and compressed>0 then
16170    setposition(handle,position)
16171    local result=readstring(handle,compressed)
16172    if data.method==8 then
16173     if decompresssize then
16174      result=decompresssize(result,data.uncompressed)
16175     else
16176      result=decompress(result)
16177     end
16178    end
16179    if check and data.crc32~=calculatecrc(result) then
16180     print("checksum mismatch")
16181     return ""
16182    end
16183    return result
16184   else
16185    return ""
16186   end
16187  end
16188 end
16189 zipfiles.open=openzipfile
16190 zipfiles.close=closezipfile
16191 zipfiles.unzip=unzipfile
16192 zipfiles.hash=getziphash
16193 zipfiles.list=getziplist
16194 zipfiles.found=foundzipfile
16195end
16196if xzip then 
16197 local writecardinal1=files.writebyte
16198 local writecardinal2=files.writecardinal2le
16199 local writecardinal4=files.writecardinal4le
16200 local logwriter=logs.writer
16201 local globpattern=dir.globpattern
16202 local compress=xzip.compress
16203 local checksum=xzip.crc32
16204 local function fromdostime(dostime,dosdate)
16205  return ostime {
16206   year=rshift(dosdate,9)+1980,
16207   month=band(rshift(dosdate,5),0x0F),
16208   day=band((dosdate   ),0x1F),
16209   hour=band(rshift(dostime,11)    ),
16210   min=band(rshift(dostime,5),0x3F),
16211   sec=band((dostime   ),0x1F),
16212  }
16213 end
16214 local function todostime(time)
16215  local t=osdate("*t",time)
16216  return
16217   lshift(t.year-1980,9)+lshift(t.month,5)+t.day,
16218   lshift(t.hour,11)+lshift(t.min,5)+rshift(t.sec,1)
16219 end
16220 local function openzip(filename,level,comment,verbose)
16221  local f=ioopen(filename,"wb")
16222  if f then
16223   return {
16224    filename=filename,
16225    handle=f,
16226    list={},
16227    level=tonumber(level) or 3,
16228    comment=tostring(comment),
16229    verbose=verbose,
16230    uncompressed=0,
16231    compressed=0,
16232   }
16233  end
16234 end
16235 local function writezip(z,name,data,level,time)
16236  local f=z.handle
16237  local list=z.list
16238  local level=tonumber(level) or z.level or 3
16239  local method=8
16240  local zipped=compress(data,level)
16241  local checksum=checksum(data)
16242  local verbose=z.verbose
16243  if not zipped then
16244   method=0
16245   zipped=data
16246  end
16247  local start=f:seek()
16248  local compressed=#zipped
16249  local uncompressed=#data
16250  z.compressed=z.compressed+compressed
16251  z.uncompressed=z.uncompressed+uncompressed
16252  if verbose then
16253   local pct=100*compressed/uncompressed
16254   if pct>=100 then
16255    logwriter(format("%10i        %s",uncompressed,name))
16256   else
16257    logwriter(format("%10i  %02.1f  %s",uncompressed,pct,name))
16258   end
16259  end
16260  f:write("\x50\x4b\x03\x04")
16261  writecardinal2(f,0)   
16262  writecardinal2(f,0)   
16263  writecardinal2(f,method)    
16264  writecardinal2(f,0)   
16265  writecardinal2(f,0)   
16266  writecardinal4(f,checksum)  
16267  writecardinal4(f,compressed)   
16268  writecardinal4(f,uncompressed) 
16269  writecardinal2(f,#name)  
16270  writecardinal2(f,0)
16271  f:write(name)      
16272  f:write(zipped)
16273  list[#list+1]={ #zipped,#data,name,checksum,start,time or 0 }
16274 end
16275 local function closezip(z)
16276  local f=z.handle
16277  local list=z.list
16278  local comment=z.comment
16279  local verbose=z.verbose
16280  local count=#list
16281  local start=f:seek()
16282  for i=1,count do
16283   local l=list[i]
16284   local compressed=l[1]
16285   local uncompressed=l[2]
16286   local name=l[3]
16287   local checksum=l[4]
16288   local start=l[5]
16289   local time=l[6]
16290   local date,time=todostime(time)
16291   f:write('\x50\x4b\x01\x02')
16292   writecardinal2(f,0)   
16293   writecardinal2(f,0)   
16294   writecardinal2(f,0)   
16295   writecardinal2(f,8)   
16296   writecardinal2(f,time)   
16297   writecardinal2(f,date)   
16298   writecardinal4(f,checksum)  
16299   writecardinal4(f,compressed)   
16300   writecardinal4(f,uncompressed) 
16301   writecardinal2(f,#name)  
16302   writecardinal2(f,0)   
16303   writecardinal2(f,0)   
16304   writecardinal2(f,0)   
16305   writecardinal2(f,0)   
16306   writecardinal4(f,0)   
16307   writecardinal4(f,start)  
16308   f:write(name)      
16309  end
16310  local stop=f:seek()
16311  local size=stop-start
16312  f:write('\x50\x4b\x05\x06')
16313  writecardinal2(f,0)   
16314  writecardinal2(f,0)   
16315  writecardinal2(f,count)  
16316  writecardinal2(f,count)  
16317  writecardinal4(f,size)   
16318  writecardinal4(f,start)  
16319  if type(comment)=="string" and comment~="" then
16320   writecardinal2(f,#comment) 
16321   f:write(comment)     
16322  else
16323   writecardinal2(f,0)
16324  end
16325  if verbose then
16326   local compressed=z.compressed
16327   local uncompressed=z.uncompressed
16328   local filename=z.filename
16329   local pct=100*compressed/uncompressed
16330   logwriter("")
16331   if pct>=100 then
16332    logwriter(format("%10i        %s",uncompressed,filename))
16333   else
16334    logwriter(format("%10i  %02.1f  %s",uncompressed,pct,filename))
16335   end
16336  end
16337  f:close()
16338 end
16339 local function zipdir(zipname,path,level,verbose)
16340  if type(zipname)=="table" then
16341   verbose=zipname.verbose
16342   level=zipname.level
16343   path=zipname.path
16344   zipname=zipname.zipname
16345  end
16346  if not zipname or zipname=="" then
16347   return
16348  end
16349  if not path or path=="" then
16350   path="."
16351  end
16352  if not isdir(path) then
16353   return
16354  end
16355  path=gsub(path,"\\+","/")
16356  path=gsub(path,"/+","/")
16357  local list={}
16358  local count=0
16359  globpattern(path,"",true,function(name,size,time)
16360   count=count+1
16361   list[count]={ name,time }
16362  end)
16363  sort(list,function(a,b)
16364   return a[1]<b[1]
16365  end)
16366  local zipf=openzip(zipname,level,comment,verbose)
16367  if zipf then
16368   local p=#path+2
16369   for i=1,count do
16370    local li=list[i]
16371    local name=li[1]
16372    local time=li[2]
16373    local data=loaddata(name)
16374    local name=sub(name,p,#name)
16375    writezip(zipf,name,data,level,time,verbose)
16376   end
16377   closezip(zipf)
16378  end
16379 end
16380 local function unzipdir(zipname,path,verbose,collect,validate)
16381  if type(zipname)=="table" then
16382   validate=zipname.validate
16383   collect=zipname.collect
16384   verbose=zipname.verbose
16385   path=zipname.path
16386   zipname=zipname.zipname
16387  end
16388  if not zipname or zipname=="" then
16389   return
16390  end
16391  if not path or path=="" then
16392   path="."
16393  end
16394  local z=openzipfile(zipname)
16395  if z then
16396   local list=getziplist(z)
16397   if list then
16398    local total=0
16399    local count=#list
16400    local step=number.idiv(count,10)
16401    local done=0
16402    local steps=verbose=="steps"
16403    local time=steps and osclock()
16404    if collect then
16405     collect={}
16406    else
16407     collect=false
16408    end
16409    for i=1,count do
16410     local l=list[i]
16411     local n=l.filename
16412     if not validate or validate(n) then
16413      local d=unzipfile(z,n) 
16414      if d then
16415       local p=filejoin(path,n)
16416       if mkdirs(dirname(p)) then
16417        if steps then
16418         total=total+#d
16419         done=done+1
16420         if done>=step then
16421          done=0
16422          logwriter(format("%4i files of %4i done, %10i bytes, %0.3f seconds",i,count,total,osclock()-time))
16423         end
16424        elseif verbose then
16425         logwriter(n)
16426        end
16427        savedata(p,d)
16428        if collect then
16429         collect[#collect+1]=p
16430        end
16431       end
16432      else
16433       logwriter(format("problem with file %s",n))
16434      end
16435     else
16436     end
16437    end
16438    if steps then
16439     logwriter(format("%4i files of %4i done, %10i bytes, %0.3f seconds",count,count,total,osclock()-time))
16440    end
16441    closezipfile(z)
16442    if collect then
16443     return collect
16444    end
16445   else
16446    closezipfile(z)
16447   end
16448  end
16449 end
16450 zipfiles.zipdir=zipdir
16451 zipfiles.unzipdir=unzipdir
16452end
16453local pattern="^\x1F\x8B\x08"
16454local gziplevel=3
16455function gzip.suffix(filename)
16456 local suffix,extra=suffixes(filename)
16457 local gzipped=extra=="gz"
16458 return suffix,gzipped
16459end
16460function gzip.compressed(s)
16461 return s and find(s,pattern)
16462end
16463local getdecompressed
16464local putcompressed
16465if gzip.compress then
16466 local gzipwindow=15+16 
16467 local compress=zlib.compress
16468 local decompress=zlib.decompress
16469 getdecompressed=function(str)
16470  return decompress(str,gzipwindow) 
16471 end
16472 putcompressed=function(str,level)
16473  return compress(str,level or gziplevel,nil,gzipwindow)
16474 end
16475else
16476 local gzipwindow=-15 
16477 local identifier="\x1F\x8B"
16478 local compress=zlib.compress
16479 local decompress=zlib.decompress
16480 local zlibchecksum=zlib.crc32
16481 if not CONTEXTLMTXMODE or CONTEXTLMTXMODE==0 then
16482  local cs=zlibchecksum
16483  zlibchecksum=function(str,n) return cs(n or 0,str) end
16484 end
16485 local streams=utilities.streams
16486 local openstream=streams.openstring
16487 local closestream=streams.close
16488 local getposition=streams.getposition
16489 local readbyte=streams.readbyte
16490 local readcardinal4=streams.readcardinal4le
16491 local readcardinal2=streams.readcardinal2le
16492 local readstring=streams.readstring
16493 local readcstring=streams.readcstring
16494 local skipbytes=streams.skip
16495 local tocardinal1=streams.tocardinal1
16496 local tocardinal4=streams.tocardinal4le
16497 getdecompressed=function(str)
16498  local s=openstream(str)
16499  local identifier=readstring(s,2)
16500  local method=readbyte(s,1)
16501  local flags=readbyte(s,1)
16502  local timestamp=readcardinal4(s)
16503  local compression=readbyte(s,1)
16504  local operating=readbyte(s,1)
16505  local isjusttext=band(flags,0x01)~=0 and true    or false
16506  local extrasize=band(flags,0x04)~=0 and readcardinal2(s) or 0
16507  local filename=band(flags,0x08)~=0 and readcstring(s)   or ""
16508  local comment=band(flags,0x10)~=0 and readcstring(s)   or ""
16509  local checksum=band(flags,0x02)~=0 and readcardinal2(s) or 0
16510  local compressed=readstring(s,#str)
16511  local data=decompress(compressed,gzipwindow) 
16512  return data
16513 end
16514 putcompressed=function(str,level,originalname)
16515  return concat {
16516   identifier,
16517   tocardinal1(0x08),
16518   tocardinal1(0x08),
16519   tocardinal4(os.time()),
16520   tocardinal1(0x02),
16521   tocardinal1(0xFF),
16522   (originalname or "unknownname").."\0",
16523   compress(str,level,nil,gzipwindow),
16524   tocardinal4(zlibchecksum(str)),
16525   tocardinal4(#str),
16526  }
16527 end
16528end
16529function gzip.load(filename)
16530 local f=openfile(filename,"rb")
16531 if not f then
16532 else
16533  local data=f:read("*all")
16534  f:close()
16535  if data and data~="" then
16536   if suffix(filename)=="gz" then
16537    data=getdecompressed(data)
16538   end
16539   return data
16540  end
16541 end
16542end
16543function gzip.save(filename,data,level,originalname)
16544 if suffix(filename)~="gz" then
16545  filename=filename..".gz"
16546 end
16547 local f=openfile(filename,"wb")
16548 if f then
16549  data=putcompressed(data or "",level or gziplevel,originalname)
16550  f:write(data)
16551  f:close()
16552  return #data
16553 end
16554end
16555function gzip.compress(s,level)
16556 if s and not find(s,pattern) then
16557  if not level then
16558   level=gziplevel
16559  elseif level<=0 then
16560   return s
16561  elseif level>9 then
16562   level=9
16563  end
16564  return putcompressed(s,level or gziplevel) or s
16565 end
16566end
16567function gzip.decompress(s)
16568 if s and find(s,pattern) then
16569  return getdecompressed(s)
16570 else
16571  return s
16572 end
16573end
16574
16575
16576end -- of closure
16577
16578do -- create closure to overcome 200 locals limit
16579
16580package.loaded["lxml-tab"] = package.loaded["lxml-tab"] or true
16581
16582-- original size: 62465, stripped down to: 36432
16583
16584if not modules then modules={} end modules ['lxml-tab']={
16585 version=1.001,
16586 comment="this module is the basis for the lxml-* ones",
16587 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
16588 copyright="PRAGMA ADE / ConTeXt Development Team",
16589 license="see context related readme files"
16590}
16591local trace_entities=false  trackers.register("xml.entities",function(v) trace_entities=v end)
16592local report_xml=logs and logs.reporter("xml","core") or function(...) print(string.format(...)) end
16593if lpeg.setmaxstack then lpeg.setmaxstack(1000) end 
16594xml=xml or {}
16595local xml=xml
16596local concat,remove,insert=table.concat,table.remove,table.insert
16597local type,next,setmetatable,getmetatable,tonumber,rawset,select=type,next,setmetatable,getmetatable,tonumber,rawset,select
16598local lower,find,match,gsub=string.lower,string.find,string.match,string.gsub
16599local sort=table.sort
16600local utfchar=utf.char
16601local lpegmatch,lpegpatterns=lpeg.match,lpeg.patterns
16602local P,S,R,C,V,C,Cs=lpeg.P,lpeg.S,lpeg.R,lpeg.C,lpeg.V,lpeg.C,lpeg.Cs
16603local formatters=string.formatters
16604do 
16605xml.xmlns=xml.xmlns or {}
16606local check=P(false)
16607local parse=check
16608function xml.registerns(namespace,pattern) 
16609 check=check+C(P(lower(pattern)))/namespace
16610 parse=P { P(check)+1*V(1) }
16611end
16612function xml.checkns(namespace,url)
16613 local ns=lpegmatch(parse,lower(url))
16614 if ns and namespace~=ns then
16615  xml.xmlns[namespace]=ns
16616 end
16617end
16618function xml.resolvens(url)
16619  return lpegmatch(parse,lower(url)) or ""
16620end
16621end
16622local nsremap,resolvens=xml.xmlns,xml.resolvens
16623local stack,level,top,at,xmlnms,errorstr
16624local entities,parameters
16625local strip,utfize,resolve,cleanup,resolve_predefined,unify_predefined
16626local dcache,hcache,acache
16627local mt,dt,nt
16628local currentfilename,currentline,linenumbers
16629local grammar_parsed_text_one
16630local grammar_parsed_text_two
16631local grammar_unparsed_text
16632local handle_hex_entity
16633local handle_dec_entity
16634local handle_any_entity_dtd
16635local handle_any_entity_text
16636local function preparexmlstate(settings)
16637 if settings then
16638  linenumbers=settings.linenumbers
16639  stack={}
16640  level=0
16641  top={}
16642  at={}
16643  mt={}
16644  dt={}
16645  nt=0   
16646  xmlns={}
16647  errorstr=nil
16648  strip=settings.strip_cm_and_dt
16649  utfize=settings.utfize_entities
16650  resolve=settings.resolve_entities   
16651  resolve_predefined=settings.resolve_predefined_entities 
16652  unify_predefined=settings.unify_predefined_entities   
16653  cleanup=settings.text_cleanup
16654  entities=settings.entities or {}
16655  currentfilename=settings.currentresource
16656  currentline=1
16657  parameters={}
16658  reported_at_errors={}
16659  dcache={}
16660  hcache={}
16661  acache={}
16662  if utfize==nil then
16663   settings.utfize_entities=true
16664   utfize=true
16665  end
16666  if resolve_predefined==nil then
16667   settings.resolve_predefined_entities=true
16668   resolve_predefined=true
16669  end
16670 else
16671  linenumbers=false
16672  stack=nil
16673  level=nil
16674  top=nil
16675  at=nil
16676  mt=nil
16677  dt=nil
16678  nt=nil
16679  xmlns=nil
16680  errorstr=nil
16681  strip=nil
16682  utfize=nil
16683  resolve=nil
16684  resolve_predefined=nil
16685  unify_predefined=nil
16686  cleanup=nil
16687  entities=nil
16688  parameters=nil
16689  reported_at_errors=nil
16690  dcache=nil
16691  hcache=nil
16692  acache=nil
16693  currentfilename=nil
16694  currentline=1
16695 end
16696end
16697local function initialize_mt(root)
16698 mt={ __index=root } 
16699end
16700function xml.setproperty(root,k,v)
16701 getmetatable(root).__index[k]=v
16702end
16703function xml.checkerror(top,toclose)
16704 return "" 
16705end
16706local checkns=xml.checkns
16707local function add_attribute(namespace,tag,value)
16708 if cleanup and value~="" then
16709  value=cleanup(value) 
16710 end
16711 if tag=="xmlns" then
16712  xmlns[#xmlns+1]=resolvens(value)
16713  at[tag]=value
16714 elseif namespace=="" then
16715  at[tag]=value
16716 elseif namespace=="xmlns" then
16717  checkns(tag,value)
16718  at["xmlns:"..tag]=value
16719 else
16720  at[namespace..":"..tag]=value
16721 end
16722end
16723local function add_empty(spacing,namespace,tag)
16724 if spacing~="" then
16725  nt=nt+1
16726  dt[nt]=spacing
16727 end
16728 local resolved=namespace=="" and xmlns[#xmlns] or nsremap[namespace] or namespace
16729 top=stack[level]
16730 dt=top.dt
16731 nt=#dt+1
16732 local t=linenumbers and {
16733  ns=namespace or "",
16734  rn=resolved,
16735  tg=tag,
16736  at=at,
16737  dt={},
16738  ni=nt,
16739  cf=currentfilename,
16740  cl=currentline,
16741  __p__=top,
16742 } or {
16743  ns=namespace or "",
16744  rn=resolved,
16745  tg=tag,
16746  at=at,
16747  dt={},
16748  ni=nt,
16749  __p__=top,
16750 }
16751 dt[nt]=t
16752 setmetatable(t,mt)
16753 if at.xmlns then
16754  remove(xmlns)
16755 end
16756 at={}
16757end
16758local function add_begin(spacing,namespace,tag)
16759 if spacing~="" then
16760  nt=nt+1
16761  dt[nt]=spacing
16762 end
16763 local resolved=namespace=="" and xmlns[#xmlns] or nsremap[namespace] or namespace
16764 dt={}
16765 top=linenumbers and {
16766  ns=namespace or "",
16767  rn=resolved,
16768  tg=tag,
16769  at=at,
16770  dt=dt,
16771  ni=nil,
16772  cf=currentfilename,
16773  cl=currentline,
16774  __p__=stack[level],
16775 } or {
16776  ns=namespace or "",
16777  rn=resolved,
16778  tg=tag,
16779  at=at,
16780  dt=dt,
16781  ni=nil,
16782  __p__=stack[level],
16783 }
16784 setmetatable(top,mt)
16785 nt=0
16786 level=level+1
16787 stack[level]=top
16788 at={}
16789end
16790local function add_end(spacing,namespace,tag)
16791 if spacing~="" then
16792  nt=nt+1
16793  dt[nt]=spacing
16794 end
16795 local toclose=stack[level]
16796 level=level-1
16797 top=stack[level]
16798 if level<1 then
16799  errorstr=formatters["unable to close %s %s"](tag,xml.checkerror(top,toclose) or "")
16800  report_xml(errorstr)
16801 elseif toclose.tg~=tag then 
16802  errorstr=formatters["unable to close %s with %s %s"](toclose.tg,tag,xml.checkerror(top,toclose) or "")
16803  report_xml(errorstr)
16804 end
16805 dt=top.dt
16806 nt=#dt+1
16807 dt[nt]=toclose
16808 toclose.ni=nt 
16809 if toclose.at.xmlns then
16810  remove(xmlns)
16811 end
16812end
16813local function add_text(text)
16814 if text=="" then
16815  return
16816 elseif cleanup then
16817  if nt>0 then
16818   local s=dt[nt]
16819   if type(s)=="string" then
16820    dt[nt]=s..cleanup(text)
16821   else
16822    nt=nt+1
16823    dt[nt]=cleanup(text)
16824   end
16825  else
16826   nt=1
16827   dt[1]=cleanup(text)
16828  end
16829 else
16830  if nt>0 then
16831   local s=dt[nt]
16832   if type(s)=="string" then
16833    dt[nt]=s..text
16834   else
16835    nt=nt+1
16836    dt[nt]=text
16837   end
16838  else
16839   nt=1
16840   dt[1]=text
16841  end
16842 end
16843end
16844local function add_special(what,spacing,text)
16845 if spacing~="" then
16846  nt=nt+1
16847  dt[nt]=spacing
16848 end
16849 if strip and (what=="@cm@" or what=="@dt@") then
16850 else
16851  nt=nt+1
16852  dt[nt]=linenumbers and {
16853   special=true,
16854   ns="",
16855   tg=what,
16856   ni=nil,
16857   dt={ text },
16858   cf=currentfilename,
16859   cl=currentline,
16860  } or {
16861   special=true,
16862   ns="",
16863   tg=what,
16864   ni=nil,
16865   dt={ text },
16866  }
16867 end
16868end
16869local function set_message(txt)
16870 errorstr="garbage at the end of the file: "..gsub(txt,"([ \n\r\t]*)","")
16871end
16872local function attribute_value_error(str)
16873 if not reported_at_errors[str] then
16874  report_xml("invalid attribute value %a",str)
16875  reported_at_errors[str]=true
16876  at._error_=str
16877 end
16878 return str
16879end
16880local function attribute_specification_error(str)
16881 if not reported_at_errors[str] then
16882  report_xml("invalid attribute specification %a",str)
16883  reported_at_errors[str]=true
16884  at._error_=str
16885 end
16886 return str
16887end
16888do
16889 local badentity="&" 
16890 xml.placeholders={
16891  unknown_dec_entity=function(str) return str=="" and badentity or formatters["&%s;"](str) end,
16892  unknown_hex_entity=function(str) return formatters["&#x%s;"](str) end,
16893  unknown_any_entity=function(str) return formatters["&#x%s;"](str) end,
16894 }
16895 local function fromhex(s)
16896  local n=tonumber(s,16)
16897  if n then
16898   return utfchar(n)
16899  else
16900   return formatters["h:%s"](s),true
16901  end
16902 end
16903 local function fromdec(s)
16904  local n=tonumber(s)
16905  if n then
16906   return utfchar(n)
16907  else
16908   return formatters["d:%s"](s),true
16909  end
16910 end
16911 local p_rest=(1-P(";"))^0
16912 local p_many=P(1)^0
16913 local parsedentity=P("&#")*(P("x")*(p_rest/fromhex)+(p_rest/fromdec))*P(";")*P(-1)+P ("#")*(P("x")*(p_many/fromhex)+(p_many/fromdec))
16914 xml.parsedentitylpeg=parsedentity
16915 local predefined_unified={
16916  [38]="&amp;",
16917  [42]="&quot;",
16918  [47]="&apos;",
16919  [74]="&lt;",
16920  [76]="&gt;",
16921 }
16922 local predefined_simplified={
16923  [38]="&",amp="&",
16924  [42]='"',quot='"',
16925  [47]="'",apos="'",
16926  [74]="<",lt="<",
16927  [76]=">",gt=">",
16928 }
16929 local nofprivates=0xF0000 
16930 local privates_u={ 
16931  [ [[&]] ]="&amp;",
16932  [ [["]] ]="&quot;",
16933  [ [[']] ]="&apos;",
16934  [ [[<]] ]="&lt;",
16935  [ [[>]] ]="&gt;",
16936 }
16937 local privates_p={ 
16938 }
16939 local privates_s={ 
16940  [ [["]] ]="&U+22;",
16941  [ [[#]] ]="&U+23;",
16942  [ [[$]] ]="&U+24;",
16943  [ [[%]] ]="&U+25;",
16944  [ [[&]] ]="&U+26;",
16945  [ [[']] ]="&U+27;",
16946  [ [[<]] ]="&U+3C;",
16947  [ [[>]] ]="&U+3E;",
16948  [ [[\]] ]="&U+5C;",
16949  [ [[{]] ]="&U+7B;",
16950  [ [[|]] ]="&U+7C;",
16951  [ [[}]] ]="&U+7D;",
16952  [ [[~]] ]="&U+7E;",
16953 }
16954 local privates_x={ 
16955  [ [["]] ]="&U+22;",
16956  [ [[#]] ]="&U+23;",
16957  [ [[$]] ]="&U+24;",
16958  [ [[%]] ]="&U+25;",
16959  [ [[']] ]="&U+27;",
16960  [ [[\]] ]="&U+5C;",
16961  [ [[{]] ]="&U+7B;",
16962  [ [[|]] ]="&U+7C;",
16963  [ [[}]] ]="&U+7D;",
16964  [ [[~]] ]="&U+7E;",
16965 }
16966 local privates_n={
16967 }
16968 utilities.storage.mark(privates_u)
16969 utilities.storage.mark(privates_p)
16970 utilities.storage.mark(privates_s)
16971 utilities.storage.mark(privates_x)
16972 utilities.storage.mark(privates_n)
16973 local escaped=utf.remapper(privates_u,"dynamic")
16974 local unprivatized=utf.remapper(privates_p,"dynamic")
16975 local unspecialized=utf.remapper(privates_s,"dynamic")
16976 local despecialized=utf.remapper(privates_x,"dynamic")
16977 xml.unprivatized=unprivatized
16978 xml.unspecialized=unspecialized
16979 xml.despecialized=despecialized
16980 xml.escaped=escaped
16981 local function unescaped(s)
16982  local p=privates_n[s]
16983  if not p then
16984   nofprivates=nofprivates+1
16985   p=utfchar(nofprivates)
16986   privates_n[s]=p
16987   s="&"..s..";" 
16988   privates_u[p]=s
16989   privates_p[p]=s
16990   privates_s[p]=s
16991  end
16992  return p
16993 end
16994 xml.privatetoken=unescaped
16995 xml.privatecodes=privates_n
16996 xml.specialcodes=privates_s
16997 function xml.addspecialcode(key,value)
16998  privates_s[key]=value or "&"..s..";"
16999 end
17000 handle_hex_entity=function(str)
17001  local h=hcache[str]
17002  if not h then
17003   local n=tonumber(str,16)
17004   h=unify_predefined and predefined_unified[n]
17005   if h then
17006    if trace_entities then
17007     report_xml("utfize, converting hex entity &#x%s; into %a",str,h)
17008    end
17009   elseif utfize then
17010    h=(n and utfchar(n)) or xml.unknown_hex_entity(str) or ""
17011    if not n then
17012     report_xml("utfize, ignoring hex entity &#x%s;",str)
17013    elseif trace_entities then
17014     report_xml("utfize, converting hex entity &#x%s; into %a",str,h)
17015    end
17016   else
17017    if trace_entities then
17018     report_xml("found entity &#x%s;",str)
17019    end
17020    h="&#x"..str..";"
17021   end
17022   hcache[str]=h
17023  end
17024  return h
17025 end
17026 handle_dec_entity=function(str)
17027  local d=dcache[str]
17028  if not d then
17029   local n=tonumber(str)
17030   d=unify_predefined and predefined_unified[n]
17031   if d then
17032    if trace_entities then
17033     report_xml("utfize, converting dec entity &#%s; into %a",str,d)
17034    end
17035   elseif utfize then
17036    d=(n and utfchar(n)) or placeholders.unknown_dec_entity(str) or ""
17037    if not n then
17038     report_xml("utfize, ignoring dec entity &#%s;",str)
17039    elseif trace_entities then
17040     report_xml("utfize, converting dec entity &#%s; into %a",str,d)
17041    end
17042   else
17043    if trace_entities then
17044     report_xml("found entity &#%s;",str)
17045    end
17046    d="&#"..str..";"
17047   end
17048   dcache[str]=d
17049  end
17050  return d
17051 end
17052 handle_any_entity_dtd=function(str)
17053  if resolve then
17054   local a=resolve_predefined and predefined_simplified[str] 
17055   if a then
17056    if trace_entities then
17057     report_xml("resolving entity &%s; to predefined %a",str,a)
17058    end
17059   else
17060    if type(resolve)=="function" then
17061     a=resolve(str,entities) or entities[str]
17062    else
17063     a=entities[str]
17064    end
17065    if a then
17066     if type(a)=="function" then
17067      if trace_entities then
17068       report_xml("expanding entity &%s; to function call",str)
17069      end
17070      a=a(str) or ""
17071     end
17072     a=lpegmatch(parsedentity,a) or a 
17073     if trace_entities then
17074      report_xml("resolving entity &%s; to internal %a",str,a)
17075     end
17076    else
17077     local unknown_any_entity=placeholders.unknown_any_entity
17078     if unknown_any_entity then
17079      a=unknown_any_entity(str) or ""
17080     end
17081     if a then
17082      if trace_entities then
17083       report_xml("resolving entity &%s; to external %s",str,a)
17084      end
17085     else
17086      if trace_entities then
17087       report_xml("keeping entity &%s;",str)
17088      end
17089      if str=="" then
17090       a=badentity
17091      else
17092       a="&"..str..";"
17093      end
17094     end
17095    end
17096   end
17097   return a
17098  else
17099   local a=acache[str]
17100   if not a then
17101    a=resolve_predefined and predefined_simplified[str]
17102    if a then
17103     acache[str]=a
17104     if trace_entities then
17105      report_xml("entity &%s; becomes %a",str,a)
17106     end
17107    elseif str=="" then
17108     if trace_entities then
17109      report_xml("invalid entity &%s;",str)
17110     end
17111     a=badentity
17112     acache[str]=a
17113    else
17114     if trace_entities then
17115      report_xml("entity &%s; is made private",str)
17116     end
17117     a=unescaped(str)
17118     acache[str]=a
17119    end
17120   end
17121   return a
17122  end
17123 end
17124 handle_any_entity_text=function(str)
17125  if resolve then
17126   local a=resolve_predefined and predefined_simplified[str]
17127   if a then
17128    if trace_entities then
17129     report_xml("resolving entity &%s; to predefined %a",str,a)
17130    end
17131   else
17132    if type(resolve)=="function" then
17133     a=resolve(str,entities) or entities[str]
17134    else
17135     a=entities[str]
17136    end
17137    if a then
17138     if type(a)=="function" then
17139      if trace_entities then
17140       report_xml("expanding entity &%s; to function call",str)
17141      end
17142      a=a(str) or ""
17143     end
17144     a=lpegmatch(grammar_parsed_text_two,a) or a
17145     if type(a)=="number" then
17146      return ""
17147     else
17148      a=lpegmatch(parsedentity,a) or a 
17149      if trace_entities then
17150       report_xml("resolving entity &%s; to internal %a",str,a)
17151      end
17152     end
17153     if trace_entities then
17154      report_xml("resolving entity &%s; to internal %a",str,a)
17155     end
17156    else
17157     local unknown_any_entity=placeholders.unknown_any_entity
17158     if unknown_any_entity then
17159      a=unknown_any_entity(str) or ""
17160     end
17161     if a then
17162      if trace_entities then
17163       report_xml("resolving entity &%s; to external %s",str,a)
17164      end
17165     else
17166      if trace_entities then
17167       report_xml("keeping entity &%s;",str)
17168      end
17169      if str=="" then
17170       a=badentity
17171      else
17172       a="&"..str..";"
17173      end
17174     end
17175    end
17176   end
17177   return a
17178  else
17179   local a=acache[str]
17180   if not a then
17181    a=resolve_predefined and predefined_simplified[str]
17182    if a then
17183     acache[str]=a
17184     if trace_entities then
17185      report_xml("entity &%s; becomes %a",str,a)
17186     end
17187    elseif str=="" then
17188     if trace_entities then
17189      report_xml("invalid entity &%s;",str)
17190     end
17191     a=badentity
17192     acache[str]=a
17193    else
17194     if trace_entities then
17195      report_xml("entity &%s; is made private",str)
17196     end
17197     a=unescaped(str)
17198     acache[str]=a
17199    end
17200   end
17201   return a
17202  end
17203 end
17204 local p_rest=(1-P(";"))^1
17205 local spec={
17206  [0x23]="\\Ux{23}",
17207  [0x24]="\\Ux{24}",
17208  [0x25]="\\Ux{25}",
17209  [0x5C]="\\Ux{5C}",
17210  [0x7B]="\\Ux{7B}",
17211  [0x7C]="\\Ux{7C}",
17212  [0x7D]="\\Ux{7D}",
17213  [0x7E]="\\Ux{7E}",
17214 }
17215 local hash=table.setmetatableindex(spec,function(t,k)
17216  local v=utfchar(k)
17217  t[k]=v
17218  return v
17219 end)
17220 local function fromuni(s)
17221  local n=tonumber(s,16)
17222  if n then
17223   return hash[n]
17224  else
17225   return formatters["u:%s"](s),true
17226  end
17227 end
17228 local function fromhex(s)
17229  local n=tonumber(s,16)
17230  if n then
17231   return hash[n]
17232  else
17233   return formatters["h:%s"](s),true
17234  end
17235 end
17236 local function fromdec(s)
17237  local n=tonumber(s)
17238  if n then
17239   return hash[n]
17240  else
17241   return formatters["d:%s"](s),true
17242  end
17243 end
17244 local reparsedentity=P("U+")*(p_rest/fromuni)+P("#")*(
17245   P("x")*(p_rest/fromhex)+p_rest/fromdec
17246  )
17247 local hash=table.setmetatableindex(function(t,k)
17248  local v=utfchar(k)
17249  t[k]=v
17250  return v
17251 end)
17252 local function fromuni(s)
17253  local n=tonumber(s,16)
17254  if n then
17255   return hash[n]
17256  else
17257   return formatters["u:%s"](s),true
17258  end
17259 end
17260 local function fromhex(s)
17261  local n=tonumber(s,16)
17262  if n then
17263   return hash[n]
17264  else
17265   return formatters["h:%s"](s),true
17266  end
17267 end
17268 local function fromdec(s)
17269  local n=tonumber(s)
17270  if n then
17271   return hash[n]
17272  else
17273   return formatters["d:%s"](s),true
17274  end
17275 end
17276 local unescapedentity=P("U+")*(p_rest/fromuni)+P("#")*(
17277   P("x")*(p_rest/fromhex)+p_rest/fromdec
17278  )
17279 xml.reparsedentitylpeg=reparsedentity   
17280 xml.unescapedentitylpeg=unescapedentity  
17281end
17282local escaped=xml.escaped
17283local unescaped=xml.unescaped
17284local placeholders=xml.placeholders
17285local function handle_end_entity(str)
17286 report_xml("error in entity, %a found without ending %a",str,";")
17287 return str
17288end
17289local function handle_crap_error(chr)
17290 report_xml("error in parsing, unexpected %a found ",chr)
17291 add_text(chr)
17292 return chr
17293end
17294local function handlenewline()
17295 currentline=currentline+1
17296end
17297local spacetab=S(' \t')
17298local space=S(' \r\n\t')
17299local newline=lpegpatterns.newline/handlenewline
17300local anything=P(1)
17301local open=P('<')
17302local close=P('>')
17303local squote=S("'")
17304local dquote=S('"')
17305local equal=P('=')
17306local slash=P('/')
17307local colon=P(':')
17308local semicolon=P(';')
17309local ampersand=P('&')
17310local valid_0=R("\128\255") 
17311local valid_1=R('az','AZ')+S('_')+valid_0
17312local valid_2=valid_1+R('09')+S('-.')
17313local valid=valid_1*valid_2^0
17314local name_yes=C(valid^1)*colon*C(valid^1)
17315local name_nop=C(P(true))*C(valid^1)
17316local name=name_yes+name_nop
17317local utfbom=lpegpatterns.utfbom 
17318local spacing=C(space^0)
17319local space_nl=spacetab+newline
17320local spacing_nl=Cs((space_nl)^0)
17321local anything_nl=newline+P(1)
17322local function weirdentity(k,v)
17323 if trace_entities then
17324  report_xml("registering %s entity %a as %a","weird",k,v)
17325 end
17326 parameters[k]=v
17327end
17328local function normalentity(k,v)
17329 if trace_entities then
17330  report_xml("registering %s entity %a as %a","normal",k,v)
17331 end
17332 entities[k]=v
17333end
17334local function systementity(k,v,n)
17335 if trace_entities then
17336  report_xml("registering %s entity %a as %a","system",k,v)
17337 end
17338 entities[k]=v
17339end
17340local function publicentity(k,v,n)
17341 if trace_entities then
17342  report_xml("registering %s entity %a as %a","public",k,v)
17343 end
17344 entities[k]=v
17345end
17346local function entityfile(pattern,k,v,n)
17347 if n then
17348  local okay,data
17349  local loadbinfile=resolvers and resolvers.loadbinfile
17350  if loadbinfile then
17351   okay,data=loadbinfile(n)
17352  else
17353   data=io.loaddata(n)
17354   okay=data and data~=""
17355  end
17356  if okay then
17357   if trace_entities then
17358    report_xml("loading public entities %a as %a from %a",k,v,n)
17359   end
17360   lpegmatch(pattern,data)
17361   return
17362  end
17363 end
17364 report_xml("ignoring public entities %a as %a from %a",k,v,n)
17365end
17366local function install(spacenewline,spacing,anything)
17367 local anyentitycontent=(1-open-semicolon-space-close-ampersand)^0
17368 local hexentitycontent=R("AF","af","09")^1
17369 local decentitycontent=R("09")^1
17370 local parsedentity=P("#")/""*(
17371         P("x")/""*(hexentitycontent/handle_hex_entity)+(decentitycontent/handle_dec_entity)
17372        )+(anyentitycontent/handle_any_entity_dtd) 
17373 local parsedentity_text=P("#")/""*(
17374         P("x")/""*(hexentitycontent/handle_hex_entity)+(decentitycontent/handle_dec_entity)
17375        )+(anyentitycontent/handle_any_entity_text) 
17376 local entity=(ampersand/"")*parsedentity*(semicolon/"")+ampersand*(anyentitycontent/handle_end_entity)
17377 local entity_text=(ampersand/"")*parsedentity_text*(semicolon/"")+ampersand*(anyentitycontent/handle_end_entity)
17378 local text_unparsed=Cs((anything-open)^1)
17379 local text_parsed=(Cs((anything-open-ampersand)^1)/add_text+Cs(entity_text)/add_text)^1
17380 local somespace=(spacenewline)^1
17381 local optionalspace=(spacenewline)^0
17382 local value=(squote*Cs((entity+(anything-squote))^0)*squote)+(dquote*Cs((entity+(anything-dquote))^0)*dquote) 
17383 local endofattributes=slash*close+close 
17384 local whatever=space*name*optionalspace*equal
17385 local wrongvalue=Cs(P(entity+(1-space-endofattributes))^1)/attribute_value_error
17386 local attributevalue=value+wrongvalue
17387 local attribute=(somespace*name*optionalspace*equal*optionalspace*attributevalue)/add_attribute
17388 local attributes=(attribute+somespace^-1*(((anything-endofattributes)^1)/attribute_specification_error))^0
17389 local parsedtext=text_parsed   
17390 local unparsedtext=text_unparsed/add_text
17391 local balanced=P { "["*((anything-S"[]")+V(1))^0*"]" }
17392 local emptyelement=(spacing*open*name*attributes*optionalspace*slash*close)/add_empty
17393 local beginelement=(spacing*open*name*attributes*optionalspace*close)/add_begin
17394 local endelement=(spacing*open*slash*name*optionalspace*close)/add_end
17395 local begincomment=open*P("!--")
17396 local endcomment=P("--")*close
17397 local begininstruction=open*P("?")
17398 local endinstruction=P("?")*close
17399 local begincdata=open*P("![CDATA[")
17400 local endcdata=P("]]")*close
17401 local someinstruction=C((anything-endinstruction)^0)
17402 local somecomment=C((anything-endcomment )^0)
17403 local somecdata=C((anything-endcdata   )^0)
17404 local begindoctype=open*P("!DOCTYPE")
17405 local enddoctype=close
17406 local beginset=P("[")
17407 local endset=P("]")
17408 local wrdtypename=C((anything-somespace-P(";"))^1)
17409 local doctypename=C((anything-somespace-close)^0)
17410 local elementdoctype=optionalspace*P("<!ELEMENT")*(anything-close)^0*close
17411 local basiccomment=begincomment*((anything-endcomment)^0)*endcomment
17412 local weirdentitytype=P("%")*(somespace*doctypename*somespace*value)/weirdentity
17413 local normalentitytype=(doctypename*somespace*value)/normalentity
17414 local publicentitytype=(doctypename*somespace*P("PUBLIC")*somespace*value)/publicentity
17415 local systementitytype=(doctypename*somespace*P("SYSTEM")*somespace*value*somespace*P("NDATA")*somespace*doctypename)/systementity
17416 local entitydoctype=optionalspace*P("<!ENTITY")*somespace*(systementitytype+publicentitytype+normalentitytype+weirdentitytype)*optionalspace*close
17417 local publicentityfile=(doctypename*somespace*P("PUBLIC")*somespace*value*(somespace*value)^0)/function(...)
17418  entityfile(entitydoctype,...)
17419 end
17420 local function weirdresolve(s)
17421  lpegmatch(entitydoctype,parameters[s])
17422 end
17423 local function normalresolve(s)
17424  lpegmatch(entitydoctype,entities[s])
17425 end
17426 local entityresolve=P("%")*(wrdtypename/weirdresolve )*P(";")+P("&")*(wrdtypename/normalresolve)*P(";")
17427 entitydoctype=entitydoctype+entityresolve
17428 local doctypeset=beginset*optionalspace*P(elementdoctype+entitydoctype+entityresolve+basiccomment+space)^0*optionalspace*endset
17429 local definitiondoctype=doctypename*somespace*doctypeset
17430 local publicdoctype=doctypename*somespace*P("PUBLIC")*somespace*value*somespace*value*somespace*doctypeset
17431 local systemdoctype=doctypename*somespace*P("SYSTEM")*somespace*value*somespace*doctypeset
17432 local simpledoctype=(anything-close)^1 
17433 local somedoctype=C((somespace*(publicentityfile+publicdoctype+systemdoctype+definitiondoctype+simpledoctype)*optionalspace)^0)
17434 local instruction=(spacing*begininstruction*someinstruction*endinstruction)/function(...) add_special("@pi@",...) end
17435 local comment=(spacing*begincomment*somecomment*endcomment )/function(...) add_special("@cm@",...) end
17436 local cdata=(spacing*begincdata*somecdata*endcdata   )/function(...) add_special("@cd@",...) end
17437 local doctype=(spacing*begindoctype*somedoctype*enddoctype )/function(...) add_special("@dt@",...) end
17438 local crap_parsed=anything-beginelement-endelement-emptyelement-begininstruction-begincomment-begincdata-ampersand
17439 local crap_unparsed=anything-beginelement-endelement-emptyelement-begininstruction-begincomment-begincdata
17440 local parsedcrap=Cs((crap_parsed^1+entity_text)^1)/handle_crap_error
17441 local parsedcrap=Cs((crap_parsed^1+entity_text)^1)/handle_crap_error
17442 local unparsedcrap=Cs((crap_unparsed     )^1)/handle_crap_error
17443 local trailer=space^0*(text_unparsed/set_message)^0
17444 local grammar_parsed_text_one=P { "preamble",
17445  preamble=utfbom^0*instruction^0*(doctype+comment+instruction)^0,
17446 }
17447 local grammar_parsed_text_two=P { "followup",
17448  followup=V("parent")*trailer,
17449  parent=beginelement*V("children")^0*endelement,
17450  children=parsedtext+V("parent")+emptyelement+comment+cdata+instruction+parsedcrap,
17451 }
17452 local grammar_unparsed_text=P { "preamble",
17453  preamble=utfbom^0*instruction^0*(doctype+comment+instruction)^0*V("parent")*trailer,
17454  parent=beginelement*V("children")^0*endelement,
17455  children=unparsedtext+V("parent")+emptyelement+comment+cdata+instruction+unparsedcrap,
17456 }
17457 return grammar_parsed_text_one,grammar_parsed_text_two,grammar_unparsed_text
17458end
17459local
17460 grammar_parsed_text_one_nop,
17461 grammar_parsed_text_two_nop,
17462 grammar_unparsed_text_nop=install(space,spacing,anything)
17463local
17464 grammar_parsed_text_one_yes,
17465 grammar_parsed_text_two_yes,
17466 grammar_unparsed_text_yes=install(space_nl,spacing_nl,anything_nl)
17467local function _xmlconvert_(data,settings,detail)
17468 settings=settings or {} 
17469 preparexmlstate(settings)
17470 if settings.linenumbers then
17471  grammar_parsed_text_one=grammar_parsed_text_one_yes
17472  grammar_parsed_text_two=grammar_parsed_text_two_yes
17473  grammar_unparsed_text=grammar_unparsed_text_yes
17474 else
17475  grammar_parsed_text_one=grammar_parsed_text_one_nop
17476  grammar_parsed_text_two=grammar_parsed_text_two_nop
17477  grammar_unparsed_text=grammar_unparsed_text_nop
17478 end
17479 local preprocessor=settings.preprocessor
17480 if data and data~="" and type(preprocessor)=="function" then
17481  data=preprocessor(data,settings) or data 
17482 end
17483 if settings.parent_root then
17484  mt=getmetatable(settings.parent_root)
17485 else
17486  initialize_mt(top)
17487 end
17488 level=level+1
17489 stack[level]=top
17490 top.dt={}
17491 dt=top.dt
17492 nt=0
17493 if not data or data=="" then
17494  errorstr="empty xml file"
17495 elseif data==true then
17496  errorstr=detail or "problematic xml file"
17497 elseif utfize or resolve then
17498  local m=lpegmatch(grammar_parsed_text_one,data)
17499  if m then
17500   m=lpegmatch(grammar_parsed_text_two,data,m)
17501  end
17502  if m then
17503  else
17504   errorstr="invalid xml file - parsed text"
17505  end
17506 elseif type(data)=="string" then
17507  if lpegmatch(grammar_unparsed_text,data) then
17508   errorstr=""
17509  else
17510   errorstr="invalid xml file - unparsed text"
17511  end
17512 else
17513  errorstr="invalid xml file - no text at all"
17514 end
17515 local result
17516 if errorstr and errorstr~="" then
17517  result={ dt={ { ns="",tg="error",dt={ errorstr },at={},er=true } } }
17518  setmetatable(result,mt)
17519  setmetatable(result.dt[1],mt)
17520  setmetatable(stack,mt)
17521  local errorhandler=settings.error_handler
17522  if errorhandler==false then
17523  else
17524   errorhandler=errorhandler or xml.errorhandler
17525   if errorhandler then
17526    local currentresource=settings.currentresource
17527    if currentresource and currentresource~="" then
17528     xml.errorhandler(formatters["load error in [%s]: %s"](currentresource,errorstr),currentresource)
17529    else
17530     xml.errorhandler(formatters["load error: %s"](errorstr))
17531    end
17532   end
17533  end
17534 else
17535  result=stack[1]
17536 end
17537 if not settings.no_root then
17538  result={ special=true,ns="",tg='@rt@',dt=result.dt,at={},entities=entities,settings=settings }
17539  setmetatable(result,mt)
17540  local rdt=result.dt
17541  for k=1,#rdt do
17542   local v=rdt[k]
17543   if type(v)=="table" and not v.special then 
17544    result.ri=k 
17545    v.__p__=result  
17546    break
17547   end
17548  end
17549 end
17550 if errorstr and errorstr~="" then
17551  result.error=true
17552 else
17553  errorstr=nil
17554 end
17555 result.statistics={
17556  errormessage=errorstr,
17557  entities={
17558   decimals=dcache,
17559   hexadecimals=hcache,
17560   names=acache,
17561   intermediates=parameters,
17562  }
17563 }
17564 preparexmlstate() 
17565 return result
17566end
17567local function xmlconvert(data,settings)
17568 local ok,result=pcall(function() return _xmlconvert_(data,settings) end)
17569 if ok then
17570  return result
17571 elseif type(result)=="string" then
17572  return _xmlconvert_(true,settings,result)
17573 else
17574  return _xmlconvert_(true,settings)
17575 end
17576end
17577xml.convert=xmlconvert
17578function xml.inheritedconvert(data,xmldata,cleanup) 
17579 local settings=xmldata.settings
17580 if settings then
17581  settings.parent_root=xmldata 
17582 end
17583 local xc=xmlconvert(data,settings) 
17584 if cleanup then
17585  local x=xc.dt
17586  if x then
17587   x=x[1]
17588   if x and x.tg=="@pi@" then
17589    local dt=x.dt
17590    local pi=dt and dt[1]
17591    if type(pi)=="string" and find(pi,"^xml") then
17592     remove(dt,1)
17593    end
17594   end
17595  end
17596 end
17597 return xc
17598end
17599function xml.is_valid(root)
17600 return root and root.dt and root.dt[1] and type(root.dt[1])=="table" and not root.dt[1].er
17601end
17602function xml.package(tag,attributes,data)
17603 local ns,tg=match(tag,"^(.-):?([^:]+)$")
17604 local t={ ns=ns,tg=tg,dt=data or "",at=attributes or {} }
17605 setmetatable(t,mt)
17606 return t
17607end
17608function xml.is_valid(root)
17609 return root and not root.error
17610end
17611xml.errorhandler=report_xml
17612function xml.load(filename,settings)
17613 local data=""
17614 if type(filename)=="string" then
17615  local f=io.open(filename,'r') 
17616  if f then
17617   data=f:read("*all") 
17618   f:close()
17619  end
17620 elseif filename then 
17621  data=filename:read("*all") 
17622 end
17623 if settings then
17624  settings.currentresource=filename
17625  local result=xmlconvert(data,settings)
17626  settings.currentresource=nil
17627  return result
17628 else
17629  return xmlconvert(data,{ currentresource=filename })
17630 end
17631end
17632local no_root={ no_root=true }
17633function xml.toxml(data)
17634 if type(data)=="string" then
17635  local root={ xmlconvert(data,no_root) }
17636  return (#root>1 and root) or root[1]
17637 else
17638  return data
17639 end
17640end
17641local function copy(old,p)
17642 if old then
17643  local new={}
17644  for k,v in next,old do
17645   local t=type(v)=="table"
17646   if k=="at" then
17647    local t={}
17648    for k,v in next,v do
17649     t[k]=v
17650    end
17651    new[k]=t
17652   elseif k=="dt" then
17653    v.__p__=nil
17654    local t={}
17655    for i=1,#v do
17656     local vi=v[i]
17657     if type(vi)=="table" then
17658      t[i]=copy(vi,new)
17659     else
17660      t[i]=vi
17661     end
17662    end
17663    new[k]=t
17664    t.__p__=p
17665   else
17666    new[k]=v 
17667   end
17668  end
17669  local mt=getmetatable(old)
17670  if mt then
17671   setmetatable(new,mt)
17672  end
17673  return new
17674 else
17675  return {}
17676 end
17677end
17678xml.copy=copy
17679function xml.checkbom(root) 
17680 if root.ri then
17681  local dt=root.dt
17682  for k=1,#dt do
17683   local v=dt[k]
17684   if type(v)=="table" and v.special and v.tg=="@pi@" and find(v.dt[1],"xml.*version=") then
17685    return
17686   end
17687  end
17688  insert(dt,1,{ special=true,ns="",tg="@pi@",dt={ "xml version='1.0' standalone='yes'" } } )
17689  insert(dt,2,"\n" )
17690 end
17691end
17692local f_attribute=formatters['%s=%q']
17693local function verbose_element(e,handlers,escape) 
17694 local handle=handlers.handle
17695 local serialize=handlers.serialize
17696 local ens=e.ns
17697 local etg=e.tg
17698 local eat=e.at
17699 local edt=e.dt
17700 local ern=e.rn
17701 local ats=eat and next(eat) and {}
17702 if ats then
17703  local n=0
17704  for k in next,eat do
17705   n=n+1
17706   ats[n]=k
17707  end
17708  if n==1 then
17709   local k=ats[1]
17710   ats=f_attribute(k,escaped(eat[k]))
17711  else
17712   sort(ats)
17713   for i=1,n do
17714    local k=ats[i]
17715    ats[i]=f_attribute(k,escaped(eat[k]))
17716   end
17717   ats=concat(ats," ")
17718  end
17719 end
17720 if ern and trace_entities and ern~=ens then
17721  ens=ern
17722 end
17723 local n=edt and #edt
17724 if ens~="" then
17725  if n and n>0 then
17726   if ats then
17727    handle("<",ens,":",etg," ",ats,">")
17728   else
17729    handle("<",ens,":",etg,">")
17730   end
17731   for i=1,n do
17732    local e=edt[i]
17733    if type(e)=="string" then
17734     handle(escaped(e))
17735    else
17736     serialize(e,handlers)
17737    end
17738   end
17739   handle("</",ens,":",etg,">")
17740  else
17741   if ats then
17742    handle("<",ens,":",etg," ",ats,"/>")
17743   else
17744    handle("<",ens,":",etg,"/>")
17745   end
17746  end
17747 else
17748  if n and n>0 then
17749   if ats then
17750    handle("<",etg," ",ats,">")
17751   else
17752    handle("<",etg,">")
17753   end
17754   for i=1,n do
17755    local e=edt[i]
17756    if type(e)=="string" then
17757     handle(escaped(e)) 
17758    else
17759     serialize(e,handlers)
17760    end
17761   end
17762   handle("</",etg,">")
17763  else
17764   if ats then
17765    handle("<",etg," ",ats,"/>")
17766   else
17767    handle("<",etg,"/>")
17768   end
17769  end
17770 end
17771end
17772local function verbose_pi(e,handlers)
17773 handlers.handle("<?",e.dt[1],"?>")
17774end
17775local function verbose_comment(e,handlers)
17776 handlers.handle("<!--",e.dt[1],"-->")
17777end
17778local function verbose_cdata(e,handlers)
17779 handlers.handle("<![CDATA[",e.dt[1],"]]>")
17780end
17781local function verbose_doctype(e,handlers)
17782 handlers.handle("<!DOCTYPE",e.dt[1],">") 
17783end
17784local function verbose_root(e,handlers)
17785 handlers.serialize(e.dt,handlers)
17786end
17787local function verbose_text(e,handlers)
17788 handlers.handle(escaped(e))
17789end
17790local function verbose_document(e,handlers)
17791 local serialize=handlers.serialize
17792 local functions=handlers.functions
17793 for i=1,#e do
17794  local ei=e[i]
17795  if type(ei)=="string" then
17796   functions["@tx@"](ei,handlers)
17797  else
17798   serialize(ei,handlers)
17799  end
17800 end
17801end
17802local function serialize(e,handlers,...)
17803 if e then
17804  local initialize=handlers.initialize
17805  local finalize=handlers.finalize
17806  local functions=handlers.functions
17807  if initialize then
17808   local state=initialize(...)
17809   if not state==true then
17810    return state
17811   end
17812  end
17813  local etg=e.tg
17814  if etg then
17815   (functions[etg] or functions["@el@"])(e,handlers)
17816  else
17817   functions["@dc@"](e,handlers) 
17818  end
17819  if finalize then
17820   return finalize()
17821  end
17822 end
17823end
17824local function xserialize(e,handlers)
17825 if e then
17826  local functions=handlers.functions
17827  local etg=e.tg
17828  if etg then
17829   (functions[etg] or functions["@el@"])(e,handlers)
17830  else
17831   functions["@dc@"](e,handlers)
17832  end
17833 end
17834end
17835local handlers={}
17836local function newhandlers(settings)
17837 local t=table.copy(handlers[settings and settings.parent or "verbose"] or {}) 
17838 if settings then
17839  for k,v in next,settings do
17840   if type(v)=="table" then
17841    local tk=t[k] if not tk then tk={} t[k]=tk end
17842    for kk,vv in next,v do
17843     tk[kk]=vv
17844    end
17845   else
17846    t[k]=v
17847   end
17848  end
17849  if settings.name then
17850   handlers[settings.name]=t
17851  end
17852 end
17853 utilities.storage.mark(t)
17854 return t
17855end
17856local nofunction=function() end
17857function xml.sethandlersfunction(handler,name,fnc)
17858 handler.functions[name]=fnc or nofunction
17859end
17860function xml.gethandlersfunction(handler,name)
17861 return handler.functions[name]
17862end
17863function xml.gethandlers(name)
17864 return handlers[name]
17865end
17866newhandlers {
17867 name="verbose",
17868 initialize=false,
17869 finalize=false,
17870 serialize=xserialize,
17871 handle=print,
17872 functions={
17873  ["@dc@"]=verbose_document,
17874  ["@dt@"]=verbose_doctype,
17875  ["@rt@"]=verbose_root,
17876  ["@el@"]=verbose_element,
17877  ["@pi@"]=verbose_pi,
17878  ["@cm@"]=verbose_comment,
17879  ["@cd@"]=verbose_cdata,
17880  ["@tx@"]=verbose_text,
17881 }
17882}
17883local result
17884local xmlfilehandler=newhandlers {
17885 name="file",
17886 initialize=function(name)
17887  result=io.open(name,"wb")
17888  return result
17889 end,
17890 finalize=function()
17891  result:close()
17892  return true
17893 end,
17894 handle=function(...)
17895  result:write(...)
17896 end,
17897}
17898function xml.save(root,name)
17899 serialize(root,xmlfilehandler,name)
17900end
17901local result,r,threshold={},0,512
17902local xmlstringhandler=newhandlers {
17903 name="string",
17904 initialize=function()
17905  r=0
17906  return result
17907 end,
17908 finalize=function()
17909  local done=concat(result,"",1,r)
17910  r=0
17911  if r>threshold then
17912   result={}
17913  end
17914  return done
17915 end,
17916 handle=function(...)
17917  for i=1,select("#",...) do
17918   r=r+1
17919   result[r]=select(i,...)
17920  end
17921 end,
17922}
17923local function xmltostring(root) 
17924 if not root then
17925  return ""
17926 elseif type(root)=="string" then
17927  return root
17928 else 
17929  return serialize(root,xmlstringhandler) or ""
17930 end
17931end
17932local function __tostring(root) 
17933 return (root and xmltostring(root)) or ""
17934end
17935initialize_mt=function(root) 
17936 mt={ __tostring=__tostring,__index=root }
17937end
17938xml.defaulthandlers=handlers
17939xml.newhandlers=newhandlers
17940xml.serialize=serialize
17941xml.tostring=xmltostring
17942local function xmlstring(e,handle)
17943 if not handle or (e.special and e.tg~="@rt@") then
17944 elseif e.tg then
17945  local edt=e.dt
17946  if edt then
17947   for i=1,#edt do
17948    xmlstring(edt[i],handle)
17949   end
17950  end
17951 else
17952  handle(e)
17953 end
17954end
17955xml.string=xmlstring
17956function xml.settings(e)
17957 while e do
17958  local s=e.settings
17959  if s then
17960   return s
17961  else
17962   e=e.__p__
17963  end
17964 end
17965 return nil
17966end
17967function xml.root(e)
17968 local r=e
17969 while e do
17970  e=e.__p__
17971  if e then
17972   r=e
17973  end
17974 end
17975 return r
17976end
17977function xml.parent(root)
17978 return root.__p__
17979end
17980function xml.body(root)
17981 return root.ri and root.dt[root.ri] or root 
17982end
17983function xml.name(root)
17984 if not root then
17985  return ""
17986 end
17987 local ns=root.ns
17988 local tg=root.tg
17989 if ns=="" then
17990  return tg
17991 else
17992  return ns..":"..tg
17993 end
17994end
17995function xml.erase(dt,k)
17996 if dt then
17997  if k then
17998   dt[k]=""
17999  else for k=1,#dt do
18000   dt[1]={ "" }
18001  end end
18002 end
18003end
18004function xml.assign(dt,k,root)
18005 if dt and k then
18006  dt[k]=type(root)=="table" and xml.body(root) or root
18007  return dt[k]
18008 else
18009  return xml.body(root)
18010 end
18011end
18012function xml.tocdata(e,wrapper) 
18013 local whatever=type(e)=="table" and xmltostring(e.dt) or e or ""
18014 if wrapper then
18015  whatever=formatters["<%s>%s</%s>"](wrapper,whatever,wrapper)
18016 end
18017 local t={ special=true,ns="",tg="@cd@",at={},rn="",dt={ whatever },__p__=e }
18018 setmetatable(t,getmetatable(e))
18019 e.dt={ t }
18020end
18021function xml.makestandalone(root)
18022 if root.ri then
18023  local dt=root.dt
18024  for k=1,#dt do
18025   local v=dt[k]
18026   if type(v)=="table" and v.special and v.tg=="@pi@" then
18027    local txt=v.dt[1]
18028    if find(txt,"xml.*version=") then
18029     v.dt[1]=txt.." standalone='yes'"
18030     break
18031    end
18032   end
18033  end
18034 end
18035 return root
18036end
18037function xml.kind(e)
18038 local dt=e and e.dt
18039 if dt then
18040  local n=#dt
18041  if n==1 then
18042   local d=dt[1]
18043   if d.special then
18044    local tg=d.tg
18045    if tg=="@cd@" then
18046     return "cdata"
18047    elseif tg=="@cm@" then
18048     return "comment"
18049    elseif tg=="@pi@" then
18050     return "instruction"
18051    elseif tg=="@dt@" then
18052     return "declaration"
18053    end
18054   elseif type(d)=="string" then
18055    return "text"
18056   end
18057   return "element"
18058  elseif n>0 then
18059   return "mixed"
18060  end
18061 end
18062 return "empty"
18063end
18064
18065
18066end -- of closure
18067
18068do -- create closure to overcome 200 locals limit
18069
18070package.loaded["lxml-lpt"] = package.loaded["lxml-lpt"] or true
18071
18072-- original size: 54738, stripped down to: 31395
18073
18074if not modules then modules={} end modules ['lxml-lpt']={
18075 version=1.001,
18076 comment="this module is the basis for the lxml-* ones",
18077 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
18078 copyright="PRAGMA ADE / ConTeXt Development Team",
18079 license="see context related readme files"
18080}
18081local concat,remove,insert=table.concat,table.remove,table.insert
18082local type,next,tonumber,tostring,setmetatable,load,select=type,next,tonumber,tostring,setmetatable,load,select
18083local format,upper,lower,gmatch,gsub,find,rep=string.format,string.upper,string.lower,string.gmatch,string.gsub,string.find,string.rep
18084local lpegmatch,lpegpatterns=lpeg.match,lpeg.patterns
18085local setmetatableindex=table.setmetatableindex
18086local formatters=string.formatters
18087local trace_lpath=false
18088local trace_lparse=false
18089local trace_lprofile=false
18090local report_lpath=logs.reporter("xml","lpath")
18091if trackers then
18092 trackers.register("xml.path",function(v)
18093  trace_lpath=v
18094 end)
18095 trackers.register("xml.parse",function(v)
18096  trace_lparse=v
18097 end)
18098 trackers.register("xml.profile",function(v)
18099  trace_lpath=v
18100  trace_lparse=v
18101  trace_lprofile=v
18102 end)
18103end
18104local xml=xml
18105local lpathcalls=0  function xml.lpathcalls () return lpathcalls  end
18106local lpathcached=0  function xml.lpathcached() return lpathcached end
18107xml.functions=xml.functions or {} 
18108local functions=xml.functions
18109xml.expressions=xml.expressions or {} 
18110local expressions=xml.expressions
18111xml.finalizers=xml.finalizers or {} 
18112local finalizers=xml.finalizers
18113xml.specialhandler=xml.specialhandler or {}
18114local specialhandler=xml.specialhandler
18115lpegpatterns.xml=lpegpatterns.xml or {}
18116local xmlpatterns=lpegpatterns.xml
18117finalizers.xml=finalizers.xml or {}
18118finalizers.tex=finalizers.tex or {}
18119local function fallback (t,name)
18120 local fn=finalizers[name]
18121 if fn then
18122  t[name]=fn
18123 else
18124  report_lpath("unknown sub finalizer %a",name)
18125  fn=function() end
18126 end
18127 return fn
18128end
18129setmetatableindex(finalizers.xml,fallback)
18130setmetatableindex(finalizers.tex,fallback)
18131xml.defaultprotocol="xml"
18132local apply_axis={}
18133apply_axis['root']=function(list)
18134 local collected={}
18135 for l=1,#list do
18136  local ll=list[l]
18137  local rt=ll
18138  while ll do
18139   ll=ll.__p__
18140   if ll then
18141    rt=ll
18142   end
18143  end
18144  collected[l]=rt
18145 end
18146 return collected
18147end
18148apply_axis['self']=function(list)
18149 return list
18150end
18151apply_axis['child']=function(list)
18152 local collected={}
18153 local c=0
18154 for l=1,#list do
18155  local ll=list[l]
18156  local dt=ll.dt
18157  if dt then 
18158   local n=#dt
18159   if n==0 then
18160    ll.en=0
18161   elseif n==1 then
18162    local dk=dt[1]
18163    if dk.tg then
18164     c=c+1
18165     collected[c]=dk
18166     dk.ni=1 
18167     dk.ei=1
18168     ll.en=1
18169    end
18170   else
18171    local en=0
18172    for k=1,#dt do
18173     local dk=dt[k]
18174     if dk.tg then
18175      c=c+1
18176      en=en+1
18177      collected[c]=dk
18178      dk.ni=k 
18179      dk.ei=en
18180     end
18181    end
18182    ll.en=en
18183   end
18184  end
18185 end
18186 return collected
18187end
18188local function collect(list,collected,c)
18189 local dt=list.dt
18190 if dt then
18191  local n=#dt
18192  if n==0 then
18193   list.en=0
18194  elseif n==1 then
18195   local dk=dt[1]
18196   if dk.tg then
18197    c=c+1
18198    collected[c]=dk
18199    dk.ni=1 
18200    dk.ei=1
18201    c=collect(dk,collected,c)
18202    list.en=1
18203   else
18204    list.en=0
18205   end
18206  else
18207   local en=0
18208   for k=1,n do
18209    local dk=dt[k]
18210    if dk.tg then
18211     c=c+1
18212     en=en+1
18213     collected[c]=dk
18214     dk.ni=k 
18215     dk.ei=en
18216     c=collect(dk,collected,c)
18217    end
18218   end
18219   list.en=en
18220  end
18221 end
18222 return c
18223end
18224apply_axis['descendant']=function(list)
18225 local collected={}
18226 local c=0
18227 for l=1,#list do
18228  c=collect(list[l],collected,c)
18229 end
18230 return collected
18231end
18232local function collect(list,collected,c)
18233 local dt=list.dt
18234 if dt then
18235  local n=#dt
18236  if n==0 then
18237   list.en=0
18238  elseif n==1 then
18239   local dk=dt[1]
18240   if dk.tg then
18241    c=c+1
18242    collected[c]=dk
18243    dk.ni=1 
18244    dk.ei=1
18245    c=collect(dk,collected,c)
18246    list.en=1
18247   end
18248  else
18249   local en=0
18250   for k=1,#dt do
18251    local dk=dt[k]
18252    if dk.tg then
18253     c=c+1
18254     en=en+1
18255     collected[c]=dk
18256     dk.ni=k 
18257     dk.ei=en
18258     c=collect(dk,collected,c)
18259    end
18260   end
18261   list.en=en
18262  end
18263 end
18264 return c
18265end
18266apply_axis['descendant-or-self']=function(list)
18267 local collected={}
18268 local c=0
18269 for l=1,#list do
18270  local ll=list[l]
18271  if ll.special~=true then 
18272   c=c+1
18273   collected[c]=ll
18274  end
18275  c=collect(ll,collected,c)
18276 end
18277 return collected
18278end
18279apply_axis['ancestor']=function(list)
18280 local collected={}
18281 local c=0
18282 for l=1,#list do
18283  local ll=list[l]
18284  while ll do
18285   ll=ll.__p__
18286   if ll then
18287    c=c+1
18288    collected[c]=ll
18289   end
18290  end
18291 end
18292 return collected
18293end
18294apply_axis['ancestor-or-self']=function(list)
18295 local collected={}
18296 local c=0
18297 for l=1,#list do
18298  local ll=list[l]
18299  c=c+1
18300  collected[c]=ll
18301  while ll do
18302   ll=ll.__p__
18303   if ll then
18304    c=c+1
18305    collected[c]=ll
18306   end
18307  end
18308 end
18309 return collected
18310end
18311apply_axis['parent']=function(list)
18312 local collected={}
18313 local c=0
18314 for l=1,#list do
18315  local pl=list[l].__p__
18316  if pl then
18317   c=c+1
18318   collected[c]=pl
18319  end
18320 end
18321 return collected
18322end
18323apply_axis['attribute']=function(list)
18324 return {}
18325end
18326apply_axis['namespace']=function(list)
18327 return {}
18328end
18329apply_axis['following']=function(list)
18330 return {}
18331end
18332apply_axis['preceding']=function(list)
18333 return {}
18334end
18335apply_axis['following-sibling']=function(list)
18336 local collected={}
18337 local c=0
18338 for l=1,#list do
18339  local ll=list[l]
18340  local p=ll.__p__
18341  local d=p.dt
18342  for i=ll.ni+1,#d do
18343   local di=d[i]
18344   if type(di)=="table" then
18345    c=c+1
18346    collected[c]=di
18347   end
18348  end
18349 end
18350 return collected
18351end
18352apply_axis['preceding-sibling']=function(list)
18353 local collected={}
18354 local c=0
18355 for l=1,#list do
18356  local ll=list[l]
18357  local p=ll.__p__
18358  local d=p.dt
18359  for i=1,ll.ni-1 do
18360   local di=d[i]
18361   if type(di)=="table" then
18362    c=c+1
18363    collected[c]=di
18364   end
18365  end
18366 end
18367 return collected
18368end
18369apply_axis['reverse-sibling']=function(list) 
18370 local collected={}
18371 local c=0
18372 for l=1,#list do
18373  local ll=list[l]
18374  local p=ll.__p__
18375  local d=p.dt
18376  for i=ll.ni-1,1,-1 do
18377   local di=d[i]
18378   if type(di)=="table" then
18379    c=c+1
18380    collected[c]=di
18381   end
18382  end
18383 end
18384 return collected
18385end
18386apply_axis['auto-descendant-or-self']=apply_axis['descendant-or-self']
18387apply_axis['auto-descendant']=apply_axis['descendant']
18388apply_axis['auto-child']=apply_axis['child']
18389apply_axis['auto-self']=apply_axis['self']
18390apply_axis['initial-child']=apply_axis['child']
18391local function apply_nodes(list,directive,nodes)
18392 local maxn=#nodes
18393 if maxn==3 then 
18394  local nns=nodes[2]
18395  local ntg=nodes[3]
18396  if not nns and not ntg then 
18397   if directive then
18398    return list
18399   else
18400    return {}
18401   end
18402  else
18403   local collected={}
18404   local c=0
18405   local m=0
18406   local p=nil
18407   if not nns then 
18408    for l=1,#list do
18409     local ll=list[l]
18410     local ltg=ll.tg
18411     if ltg then
18412      if directive then
18413       if ntg==ltg then
18414        local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18415        c=c+1
18416        collected[c]=ll
18417        ll.mi=m
18418       end
18419      elseif ntg~=ltg then
18420       local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18421       c=c+1
18422       collected[c]=ll
18423       ll.mi=m
18424      end
18425     end
18426    end
18427   elseif not ntg then 
18428    for l=1,#list do
18429     local ll=list[l]
18430     local lns=ll.rn or ll.ns
18431     if lns then
18432      if directive then
18433       if lns==nns then
18434        local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18435        c=c+1
18436        collected[c]=ll
18437        ll.mi=m
18438       end
18439      elseif lns~=nns then
18440       local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18441       c=c+1
18442       collected[c]=ll
18443       ll.mi=m
18444      end
18445     end
18446    end
18447   else 
18448    for l=1,#list do
18449     local ll=list[l]
18450     local ltg=ll.tg
18451     if ltg then
18452      local lns=ll.rn or ll.ns
18453      local ok=ltg==ntg and lns==nns
18454      if directive then
18455       if ok then
18456        local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18457        c=c+1
18458        collected[c]=ll
18459        ll.mi=m
18460       end
18461      elseif not ok then
18462       local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18463       c=c+1
18464       collected[c]=ll
18465       ll.mi=m
18466      end
18467     end
18468    end
18469   end
18470   return collected
18471  end
18472 else
18473  local collected={}
18474  local c=0
18475  local m=0
18476  local p=nil
18477  for l=1,#list do
18478   local ll=list[l]
18479   local ltg=ll.tg
18480   if ltg then
18481    local lns=ll.rn or ll.ns
18482    local ok=false
18483    for n=1,maxn,3 do
18484     local nns=nodes[n+1]
18485     local ntg=nodes[n+2]
18486     ok=(not ntg or ltg==ntg) and (not nns or lns==nns)
18487     if ok then
18488      break
18489     end
18490    end
18491    if directive then
18492     if ok then
18493      local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18494      c=c+1
18495      collected[c]=ll
18496      ll.mi=m
18497     end
18498    elseif not ok then
18499     local llp=ll.__p__;if llp~=p then p=llp;m=1 else m=m+1 end
18500     c=c+1
18501     collected[c]=ll
18502     ll.mi=m
18503    end
18504   end
18505  end
18506  return collected
18507 end
18508end
18509local quit_expression=false
18510local function apply_expression(list,expression,order)
18511 local collected={}
18512 local c=0
18513 quit_expression=false
18514 for l=1,#list do
18515  local ll=list[l]
18516  if expression(list,ll,l,order) then 
18517   c=c+1
18518   collected[c]=ll
18519  end
18520  if quit_expression then
18521   break
18522  end
18523 end
18524 return collected
18525end
18526local function apply_selector(list,specification)
18527 if xml.applyselector then
18528  apply_selector=xml.applyselector
18529  return apply_selector(list,specification)
18530 else
18531  return list
18532 end
18533end
18534local P,V,C,Cs,Cc,Ct,R,S,Cg,Cb=lpeg.P,lpeg.V,lpeg.C,lpeg.Cs,lpeg.Cc,lpeg.Ct,lpeg.R,lpeg.S,lpeg.Cg,lpeg.Cb
18535local spaces=S(" \n\r\t\f")^0
18536local lp_space=S(" \n\r\t\f")
18537local lp_any=P(1)
18538local lp_noequal=P("!=")/"~="+P("<=")+P(">=")+P("==")
18539local lp_doequal=P("=")/"=="
18540local lp_or=P("|")/" or "
18541local lp_and=P("&")/" and "
18542local builtin={
18543 text="(ll.dt[1] or '')",
18544 content="ll.dt",
18545 name="((ll.ns~='' and ll.ns..':'..ll.tg) or ll.tg)",
18546 tag="ll.tg",
18547 position="l",
18548 firstindex="1",
18549 firstelement="1",
18550 first="1",
18551 lastindex="(#ll.__p__.dt or 1)",
18552 lastelement="(ll.__p__.en or 1)",
18553 last="#list",
18554 list="list",
18555 self="ll",
18556 rootposition="order",
18557 order="order",
18558 element="(ll.ei or 1)",
18559 index="(ll.ni or 1)",
18560 match="(ll.mi or 1)",
18561 namespace="ll.ns",
18562 ns="ll.ns",
18563}
18564local lp_builtin=lpeg.utfchartabletopattern(builtin)/builtin*((spaces*P("(")*spaces*P(")"))/"")
18565local lp_attribute=(P("@")+P("attribute::"))/""*Cc("(ll.at and ll.at['")*((R("az","AZ")+S("-_:"))^1)*Cc("'])")
18566local lp_fastpos_p=P("+")^0*R("09")^1*P(-1)/"l==%0"
18567local lp_fastpos_n=P("-")*R("09")^1*P(-1)/"(%0<0 and (#list+%0+1==l))" 
18568local lp_fastpos=lp_fastpos_n+lp_fastpos_p
18569local lp_reserved=C("and")+C("or")+C("not")+C("div")+C("mod")+C("true")+C("false")
18570local lp_lua_function=Cs((R("az","AZ","__")^1*(P(".")*R("az","AZ","__")^1)^1)*("("))/"%0"
18571local lp_function=C(R("az","AZ","__")^1)*P("(")/function(t) 
18572 if expressions[t] then
18573  return "expr."..t.."("
18574 else
18575  return "expr.error("
18576 end
18577end
18578local lparent=P("(")
18579local rparent=P(")")
18580local noparent=1-(lparent+rparent)
18581local nested=P{lparent*(noparent+V(1))^0*rparent}
18582local value=P(lparent*C((noparent+nested)^0)*rparent) 
18583local lp_child=Cc("expr.child(ll,'")*R("az","AZ")*R("az","AZ","--","__")^0*Cc("')")
18584local lp_number=S("+-")*R("09")^1
18585local lp_string=Cc("'")*R("az","AZ","--","__")^1*Cc("'")
18586local lp_content=(P("'")*(1-P("'"))^0*P("'")+P('"')*(1-P('"'))^0*P('"'))
18587local cleaner
18588local lp_special=(C(P("name")+P("text")+P("tag")+P("count")+P("child")))*value/function(t,s)
18589 if expressions[t] then
18590  s=s and s~="" and lpegmatch(cleaner,s)
18591  if s and s~="" then
18592   return "expr."..t.."(ll,"..s..")"
18593  else
18594   return "expr."..t.."(ll)"
18595  end
18596 else
18597  return "expr.error("..t..")"
18598 end
18599end
18600local content=lp_builtin+lp_attribute+lp_special+lp_noequal+lp_doequal+lp_or+lp_and+lp_reserved+lp_lua_function+lp_function+lp_content+
18601 lp_child+lp_any
18602local converter=Cs (
18603 lp_fastpos+(P { lparent*(V(1))^0*rparent+content } )^0
18604)
18605cleaner=Cs ((
18606 lp_reserved+lp_number+lp_string+1 )^1 )
18607local template_e=[[
18608    local expr = xml.expressions
18609    return function(list,ll,l,order)
18610        return %s
18611    end
18612]]
18613local template_f_y=[[
18614    local finalizer = xml.finalizers['%s']['%s']
18615    return function(collection)
18616        return finalizer(collection,%s)
18617    end
18618]]
18619local template_f_n=[[
18620    return xml.finalizers['%s']['%s']
18621]]
18622local register_last_match={ kind="axis",axis="last-match"     } 
18623local register_self={ kind="axis",axis="self"     } 
18624local register_parent={ kind="axis",axis="parent"      } 
18625local register_descendant={ kind="axis",axis="descendant"     } 
18626local register_child={ kind="axis",axis="child"       } 
18627local register_descendant_or_self={ kind="axis",axis="descendant-or-self"   } 
18628local register_root={ kind="axis",axis="root"     } 
18629local register_ancestor={ kind="axis",axis="ancestor"    } 
18630local register_ancestor_or_self={ kind="axis",axis="ancestor-or-self"  } 
18631local register_attribute={ kind="axis",axis="attribute"      } 
18632local register_namespace={ kind="axis",axis="namespace"      } 
18633local register_following={ kind="axis",axis="following"      } 
18634local register_following_sibling={ kind="axis",axis="following-sibling"    } 
18635local register_preceding={ kind="axis",axis="preceding"      } 
18636local register_preceding_sibling={ kind="axis",axis="preceding-sibling"    } 
18637local register_reverse_sibling={ kind="axis",axis="reverse-sibling"   } 
18638local register_auto_descendant_or_self={ kind="axis",axis="auto-descendant-or-self" } 
18639local register_auto_descendant={ kind="axis",axis="auto-descendant"   } 
18640local register_auto_self={ kind="axis",axis="auto-self"      } 
18641local register_auto_child={ kind="axis",axis="auto-child"     } 
18642local register_initial_child={ kind="axis",axis="initial-child"     } 
18643local register_all_nodes={ kind="nodes",nodetest=true,nodes={ true,false,false } }
18644local skip={}
18645local function errorrunner_e(str,cnv)
18646 if not skip[str] then
18647  report_lpath("error in expression: %s => %s",str,cnv)
18648  skip[str]=cnv or str
18649 end
18650 return false
18651end
18652local function errorrunner_f(str,arg)
18653 report_lpath("error in finalizer: %s(%s)",str,arg or "")
18654 return false
18655end
18656local function register_nodes(nodetest,nodes)
18657 return { kind="nodes",nodetest=nodetest,nodes=nodes }
18658end
18659local function register_selector(specification)
18660 return { kind="selector",specification=specification }
18661end
18662local function register_expression(expression)
18663 local converted=lpegmatch(converter,expression)
18664 local wrapped=format(template_e,converted)
18665 local runner=load(wrapped)
18666 runner=(runner and runner()) or function() errorrunner_e(expression,converted) end
18667 return { kind="expression",expression=expression,converted=converted,evaluator=runner }
18668end
18669local function register_finalizer(protocol,name,arguments)
18670 local runner
18671 if arguments and arguments~="" then
18672  runner=load(format(template_f_y,protocol or xml.defaultprotocol,name,arguments))
18673 else
18674  runner=load(format(template_f_n,protocol or xml.defaultprotocol,name))
18675 end
18676 runner=(runner and runner()) or function() errorrunner_f(name,arguments) end
18677 return { kind="finalizer",name=name,arguments=arguments,finalizer=runner }
18678end
18679local expression=P { "ex",
18680 ex="["*C((V("sq")+V("dq")+(1-S("[]"))+V("ex"))^0)*"]",
18681 sq="'"*(1-S("'"))^0*"'",
18682 dq='"'*(1-S('"'))^0*'"',
18683}
18684local arguments=P { "ar",
18685 ar="("*Cs((V("sq")+V("dq")+V("nq")+P(1-P(")")))^0)*")",
18686 nq=((1-S("),'\""))^1)/function(s) return format("%q",s) end,
18687 sq=P("'")*(1-P("'"))^0*P("'"),
18688 dq=P('"')*(1-P('"'))^0*P('"'),
18689}
18690local function register_error(str)
18691 return { kind="error",error=format("unparsed: %s",str) }
18692end
18693local special_1=P("*")*Cc(register_auto_descendant)*Cc(register_all_nodes) 
18694local special_2=P("/")*Cc(register_auto_self)
18695local special_3=P("")*Cc(register_auto_self)
18696local no_nextcolon=P(-1)+#(1-P(":")) 
18697local no_nextlparent=P(-1)+#(1-P("(")) 
18698local pathparser=Ct { "patterns",
18699 patterns=spaces*V("protocol")*spaces*(
18700         (V("special")*spaces*P(-1)               )+(V("initial")*spaces*V("step")*spaces*(P("/")*spaces*V("step")*spaces)^0 )
18701         ),
18702 protocol=Cg(V("letters"),"protocol")*P("://")+Cg(Cc(nil),"protocol"),
18703 step=((V("shortcuts")+V("selector")+P("/")+V("axis"))*spaces*V("nodes")^0+V("error"))*spaces*V("expressions")^0*spaces*V("finalizer")^0,
18704 axis=V("last_match")+V("descendant")+V("child")+V("parent")+V("self")+V("root")+V("ancestor")+V("descendant_or_self")+V("following_sibling")+V("following")+V("reverse_sibling")+V("preceding_sibling")+V("preceding")+V("ancestor_or_self")+#(1-P(-1))*Cc(register_auto_child),
18705 special=special_1+special_2+special_3,
18706 initial=(P("/")*spaces*Cc(register_initial_child))^-1,
18707 error=(P(1)^1)/register_error,
18708 shortcuts_a=V("s_descendant_or_self")+V("s_descendant")+V("s_child")+V("s_parent")+V("s_self")+V("s_root")+V("s_ancestor")+V("s_lastmatch"),
18709 shortcuts=V("shortcuts_a")*(spaces*"/"*spaces*V("shortcuts_a"))^0,
18710 s_descendant_or_self=(P("***/")+P("/"))*Cc(register_descendant_or_self),
18711 s_descendant=P("**")*Cc(register_descendant),
18712 s_child=P("*")*no_nextcolon*Cc(register_child),
18713 s_parent=P("..")*Cc(register_parent),
18714 s_self=P("." )*Cc(register_self),
18715 s_root=P("^^")*Cc(register_root),
18716 s_ancestor=P("^")*Cc(register_ancestor),
18717 s_lastmatch=P("=")*Cc(register_last_match),
18718 descendant=P("descendant::")*Cc(register_descendant),
18719 child=P("child::")*Cc(register_child),
18720 parent=P("parent::")*Cc(register_parent),
18721 self=P("self::")*Cc(register_self),
18722 root=P('root::')*Cc(register_root),
18723 ancestor=P('ancestor::')*Cc(register_ancestor),
18724 descendant_or_self=P('descendant-or-self::')*Cc(register_descendant_or_self),
18725 ancestor_or_self=P('ancestor-or-self::')*Cc(register_ancestor_or_self),
18726 following=P('following::')*Cc(register_following),
18727 following_sibling=P('following-sibling::')*Cc(register_following_sibling),
18728 preceding=P('preceding::')*Cc(register_preceding),
18729 preceding_sibling=P('preceding-sibling::')*Cc(register_preceding_sibling),
18730 reverse_sibling=P('reverse-sibling::')*Cc(register_reverse_sibling),
18731 last_match=P('last-match::')*Cc(register_last_match),
18732 selector=P("{")*C((1-P("}"))^1)*P("}")/register_selector,
18733 nodes=(V("nodefunction")*spaces*P("(")*V("nodeset")*P(")")+V("nodetest")*V("nodeset"))/register_nodes,
18734 expressions=expression/register_expression,
18735 letters=R("az")^1,
18736 name=(1-S("/[]()|:*!"))^1,
18737 negate=P("!")*Cc(false),
18738 nodefunction=V("negate")+P("not")*Cc(false)+Cc(true),
18739 nodetest=V("negate")+Cc(true),
18740 nodename=(V("negate")+Cc(true))*spaces*((V("wildnodename")*P(":")*V("wildnodename"))+(Cc(false)*V("wildnodename"))),
18741 wildnodename=(C(V("name"))+P("*")*Cc(false))*no_nextlparent,
18742 nodeset=spaces*Ct(V("nodename")*(spaces*P("|")*spaces*V("nodename"))^0)*spaces,
18743 finalizer=(Cb("protocol")*P("/")^-1*C(V("name"))*arguments*P(-1))/register_finalizer,
18744}
18745xmlpatterns.pathparser=pathparser
18746local cache={}
18747local function nodesettostring(set,nodetest)
18748 local t={}
18749 for i=1,#set,3 do
18750  local directive,ns,tg=set[i],set[i+1],set[i+2]
18751  if not ns or ns=="" then ns="*" end
18752  if not tg or tg=="" then tg="*" end
18753  tg=(tg=="@rt@" and "[root]") or format("%s:%s",ns,tg)
18754  t[#t+1]=(directive and tg) or format("not(%s)",tg)
18755 end
18756 if nodetest==false then
18757  return format("not(%s)",concat(t,"|"))
18758 else
18759  return concat(t,"|")
18760 end
18761end
18762local function tagstostring(list)
18763 if #list==0 then
18764  return "no elements"
18765 else
18766  local t={}
18767  for i=1,#list do
18768   local li=list[i]
18769   local ns=li.ns
18770   local tg=li.tg
18771   if not ns or ns=="" then ns="*" end
18772   if not tg or tg=="" then tg="*" end
18773   t[i]=(tg=="@rt@" and "[root]") or format("%s:%s",ns,tg)
18774  end
18775  return concat(t," ")
18776 end
18777end
18778xml.nodesettostring=nodesettostring
18779local lpath 
18780local function lshow(parsed)
18781 if type(parsed)=="string" then
18782  parsed=lpath(parsed)
18783 end
18784 report_lpath("%s://%s => %s",parsed.protocol or xml.defaultprotocol,parsed.pattern,
18785  table.serialize(parsed,false))
18786end
18787xml.lshow=lshow
18788local function add_comment(p,str)
18789 local pc=p.comment
18790 if not pc then
18791  p.comment={ str }
18792 else
18793  pc[#pc+1]=str
18794 end
18795end
18796lpath=function (pattern) 
18797 lpathcalls=lpathcalls+1
18798 if type(pattern)=="table" then
18799  return pattern
18800 else
18801  local parsed=cache[pattern]
18802  if parsed then
18803   lpathcached=lpathcached+1
18804  else
18805   parsed=lpegmatch(pathparser,pattern)
18806   if parsed then
18807    parsed.pattern=pattern
18808    local np=#parsed
18809    if np==0 then
18810     parsed={ pattern=pattern,register_self,state="parsing error" }
18811     report_lpath("parsing error in pattern: %s",pattern)
18812     lshow(parsed)
18813    else
18814     local pi=parsed[1]
18815     if pi.axis=="auto-child" then
18816      if false then
18817       add_comment(parsed,"auto-child replaced by auto-descendant-or-self")
18818       parsed[1]=register_auto_descendant_or_self
18819      else
18820       add_comment(parsed,"auto-child replaced by auto-descendant")
18821       parsed[1]=register_auto_descendant
18822      end
18823     elseif pi.axis=="initial-child" and np>1 and parsed[2].axis then
18824      add_comment(parsed,"initial-child removed") 
18825      remove(parsed,1)
18826     end
18827     local np=#parsed 
18828     if np>1 then
18829      local pnp=parsed[np]
18830      if pnp.kind=="nodes" and pnp.nodetest==true then
18831       local nodes=pnp.nodes
18832       if nodes[1]==true and nodes[2]==false and nodes[3]==false then
18833        add_comment(parsed,"redundant final wildcard filter removed")
18834        remove(parsed,np)
18835       end
18836      end
18837     end
18838    end
18839   else
18840    parsed={ pattern=pattern }
18841   end
18842   cache[pattern]=parsed
18843   if trace_lparse and not trace_lprofile then
18844    lshow(parsed)
18845   end
18846  end
18847  return parsed
18848 end
18849end
18850xml.lpath=lpath
18851do
18852 local profiled={}
18853 xml.profiled=profiled
18854 local lastmatch=nil  
18855 local keepmatch=nil  
18856 if directives then
18857  directives.register("xml.path.keeplastmatch",function(v)
18858   keepmatch=v
18859   lastmatch=nil
18860  end)
18861 end
18862 apply_axis["last-match"]=function()
18863  return lastmatch or {}
18864 end
18865 local function profiled_apply(list,parsed,nofparsed,order)
18866  local p=profiled[parsed.pattern]
18867  if p then
18868   p.tested=p.tested+1
18869  else
18870   p={ tested=1,matched=0,finalized=0 }
18871   profiled[parsed.pattern]=p
18872  end
18873  local collected=list
18874  for i=1,nofparsed do
18875   local pi=parsed[i]
18876   local kind=pi.kind
18877   if kind=="axis" then
18878    collected=apply_axis[pi.axis](collected)
18879   elseif kind=="nodes" then
18880    collected=apply_nodes(collected,pi.nodetest,pi.nodes)
18881   elseif kind=="expression" then
18882    collected=apply_expression(collected,pi.evaluator,order)
18883   elseif kind=="selector" then
18884    collected=apply_selector(collected,pi.specification)
18885   elseif kind=="finalizer" then
18886    collected=pi.finalizer(collected) 
18887    p.matched=p.matched+1
18888    p.finalized=p.finalized+1
18889    return collected
18890   end
18891   if not collected or #collected==0 then
18892    local pn=i<nofparsed and parsed[nofparsed]
18893    if pn and pn.kind=="finalizer" then
18894     collected=pn.finalizer(collected) 
18895     p.finalized=p.finalized+1
18896     return collected
18897    end
18898    return nil
18899   end
18900  end
18901  if collected then
18902   p.matched=p.matched+1
18903  end
18904  return collected
18905 end
18906 local function traced_apply(list,parsed,nofparsed,order)
18907  if trace_lparse then
18908   lshow(parsed)
18909  end
18910  report_lpath("collecting: %s",parsed.pattern)
18911  report_lpath("root tags : %s",tagstostring(list))
18912  report_lpath("order     : %s",order or "unset")
18913  local collected=list
18914  for i=1,nofparsed do
18915   local pi=parsed[i]
18916   local kind=pi.kind
18917   if kind=="axis" then
18918    collected=apply_axis[pi.axis](collected)
18919    report_lpath("% 10i : ax : %s",(collected and #collected) or 0,pi.axis)
18920   elseif kind=="nodes" then
18921    collected=apply_nodes(collected,pi.nodetest,pi.nodes)
18922    report_lpath("% 10i : ns : %s",(collected and #collected) or 0,nodesettostring(pi.nodes,pi.nodetest))
18923   elseif kind=="expression" then
18924    collected=apply_expression(collected,pi.evaluator,order)
18925    report_lpath("% 10i : ex : %s -> %s",(collected and #collected) or 0,pi.expression,pi.converted)
18926   elseif kind=="selector" then
18927    collected=apply_selector(collected,pi.specification)
18928    report_lpath("% 10i : se : %s ",(collected and #collected) or 0,pi.specification)
18929   elseif kind=="finalizer" then
18930    collected=pi.finalizer(collected)
18931    report_lpath("% 10i : fi : %s : %s(%s)",(type(collected)=="table" and #collected) or 0,parsed.protocol or xml.defaultprotocol,pi.name,pi.arguments or "")
18932    return collected
18933   end
18934   if not collected or #collected==0 then
18935    local pn=i<nofparsed and parsed[nofparsed]
18936    if pn and pn.kind=="finalizer" then
18937     collected=pn.finalizer(collected)
18938     report_lpath("% 10i : fi : %s : %s(%s)",(type(collected)=="table" and #collected) or 0,parsed.protocol or xml.defaultprotocol,pn.name,pn.arguments or "")
18939     return collected
18940    end
18941    return nil
18942   end
18943  end
18944  return collected
18945 end
18946 local function normal_apply(list,parsed,nofparsed,order)
18947  local collected=list
18948  for i=1,nofparsed do
18949   local pi=parsed[i]
18950   local kind=pi.kind
18951   if kind=="axis" then
18952    local axis=pi.axis
18953    if axis~="self" then
18954     collected=apply_axis[axis](collected)
18955    end
18956   elseif kind=="nodes" then
18957    collected=apply_nodes(collected,pi.nodetest,pi.nodes)
18958   elseif kind=="expression" then
18959    collected=apply_expression(collected,pi.evaluator,order)
18960   elseif kind=="selector" then
18961    collected=apply_selector(collected,pi.specification)
18962   elseif kind=="finalizer" then
18963    return pi.finalizer(collected)
18964   end
18965   if not collected or #collected==0 then
18966    local pf=i<nofparsed and parsed[nofparsed].finalizer
18967    if pf then
18968     return pf(collected) 
18969    end
18970    return nil
18971   end
18972  end
18973  return collected
18974 end
18975 local apply=normal_apply
18976 if trackers then
18977  trackers.register("xml.path,xml.parse,xml.profile",function()
18978   if trace_lprofile then
18979    apply=profiled_apply
18980   elseif trace_lpath then
18981    apply=traced_apply
18982   else
18983    apply=normal_apply
18984   end
18985  end)
18986 end
18987 function xml.applylpath(list,pattern)
18988  if not list then
18989   lastmatch=nil
18990   return
18991  end
18992  local parsed=cache[pattern]
18993  if parsed then
18994   lpathcalls=lpathcalls+1
18995   lpathcached=lpathcached+1
18996  elseif type(pattern)=="table" then
18997   lpathcalls=lpathcalls+1
18998   parsed=pattern
18999  else
19000   parsed=lpath(pattern) or pattern
19001  end
19002  if not parsed then
19003   lastmatch=nil
19004   return
19005  end
19006  local nofparsed=#parsed
19007  if nofparsed==0 then
19008   lastmatch=nil
19009   return 
19010  end
19011  local collected=apply({ list },parsed,nofparsed,list.mi)
19012  lastmatch=keepmatch and collected or nil
19013  return collected
19014 end
19015 function xml.lastmatch()
19016  return lastmatch
19017 end
19018 local stack={}
19019 function xml.pushmatch()
19020  insert(stack,lastmatch)
19021 end
19022 function xml.popmatch()
19023  lastmatch=remove(stack)
19024 end
19025end
19026local applylpath=xml.applylpath
19027function xml.filter(root,pattern) 
19028 return applylpath(root,pattern)
19029end
19030expressions.child=function(e,pattern)
19031 return applylpath(e,pattern) 
19032end
19033expressions.count=function(e,pattern) 
19034 local collected=applylpath(e,pattern) 
19035 return pattern and (collected and #collected) or 0
19036end
19037expressions.attribute=function(e,name,value)
19038 if type(e)=="table" and name then
19039  local a=e.at
19040  if a then
19041   local v=a[name]
19042   if value then
19043    return v==value
19044   else
19045    return v
19046   end
19047  end
19048 end
19049 return nil
19050end
19051expressions.oneof=function(s,...)
19052 for i=1,select("#",...) do
19053  if s==select(i,...) then
19054   return true
19055  end
19056 end
19057 return false
19058end
19059expressions.error=function(str)
19060 xml.errorhandler(format("unknown function in lpath expression: %s",tostring(str or "?")))
19061 return false
19062end
19063expressions.undefined=function(s)
19064 return s==nil
19065end
19066expressions.quit=function(s)
19067 if s or s==nil then
19068  quit_expression=true
19069 end
19070 return true
19071end
19072expressions.print=function(...)
19073 print(...)
19074 return true
19075end
19076expressions.find=function(str,...)
19077 return str and find(str,...)
19078end
19079expressions.upper=function(str) return str and upper(str) or "" end 
19080expressions.lower=function(str) return str and lower(str) or "" end 
19081expressions.number=tonumber
19082expressions.boolean=toboolean
19083function expressions.contains(str,pattern)
19084 local t=type(str)
19085 if t=="string" then
19086  if find(str,pattern) then
19087   return true
19088  end
19089 elseif t=="table" then
19090  for i=1,#str do
19091   local d=str[i]
19092   if type(d)=="string" and find(d,pattern) then
19093    return true
19094   end
19095  end
19096 end
19097 return false
19098end
19099function expressions.idstring(str)
19100 return type(str)=="string" and gsub(str,"^#","") or ""
19101end
19102local function traverse(root,pattern,handle)
19103 local collected=applylpath(root,pattern)
19104 if collected then
19105  for c=1,#collected do
19106   local e=collected[c]
19107   local r=e.__p__
19108   handle(r,r.dt,e.ni)
19109  end
19110 end
19111end
19112local function selection(root,pattern,handle)
19113 local collected=applylpath(root,pattern)
19114 if collected then
19115  if handle then
19116   for c=1,#collected do
19117    handle(collected[c])
19118   end
19119  else
19120   return collected
19121  end
19122 end
19123end
19124xml.traverse=traverse     
19125xml.selection=selection
19126local function dofunction(collected,fnc,...)
19127 if collected then
19128  local f=functions[fnc]
19129  if f then
19130   for c=1,#collected do
19131    f(collected[c],...)
19132   end
19133  else
19134   report_lpath("unknown function %a",fnc)
19135  end
19136 end
19137end
19138finalizers.xml["function"]=dofunction
19139finalizers.tex["function"]=dofunction
19140expressions.text=function(e,n)
19141 local rdt=e.__p__.dt
19142 return rdt and rdt[n] or ""
19143end
19144expressions.name=function(e,n) 
19145 local found=false
19146 n=tonumber(n) or 0
19147 if n==0 then
19148  found=type(e)=="table" and e
19149 elseif n<0 then
19150  local d=e.__p__.dt
19151  local k=e.ni
19152  for i=k-1,1,-1 do
19153   local di=d[i]
19154   if type(di)=="table" then
19155    if n==-1 then
19156     found=di
19157     break
19158    else
19159     n=n+1
19160    end
19161   end
19162  end
19163 else
19164  local d=e.__p__.dt
19165  local k=e.ni
19166  for i=k+1,#d,1 do
19167   local di=d[i]
19168   if type(di)=="table" then
19169    if n==1 then
19170     found=di
19171     break
19172    else
19173     n=n-1
19174    end
19175   end
19176  end
19177 end
19178 if found then
19179  local ns=found.rn or found.ns or ""
19180  local tg=found.tg
19181  if ns~="" then
19182   return ns..":"..tg
19183  else
19184   return tg
19185  end
19186 else
19187  return ""
19188 end
19189end
19190expressions.tag=function(e,n) 
19191 if not e then
19192  return ""
19193 else
19194  local found=false
19195  n=tonumber(n) or 0
19196  if n==0 then
19197   found=(type(e)=="table") and e 
19198  elseif n<0 then
19199   local d=e.__p__.dt
19200   local k=e.ni
19201   for i=k-1,1,-1 do
19202    local di=d[i]
19203    if type(di)=="table" then
19204     if n==-1 then
19205      found=di
19206      break
19207     else
19208      n=n+1
19209     end
19210    end
19211   end
19212  else
19213   local d=e.__p__.dt
19214   local k=e.ni
19215   for i=k+1,#d,1 do
19216    local di=d[i]
19217    if type(di)=="table" then
19218     if n==1 then
19219      found=di
19220      break
19221     else
19222      n=n-1
19223     end
19224    end
19225   end
19226  end
19227  return (found and found.tg) or ""
19228 end
19229end
19230local dummy=function() end
19231function xml.elements(root,pattern,reverse) 
19232 local collected=applylpath(root,pattern)
19233 if not collected then
19234  return dummy
19235 end
19236 local n=#collected
19237 if n==0 then
19238  return dummy
19239 end
19240 if reverse then
19241  local c=n+1
19242  return function()
19243   if c>1 then
19244    c=c-1
19245    local e=collected[c]
19246    local r=e.__p__
19247    return r,r.dt,e.ni
19248   end
19249  end
19250 else
19251  local c=0
19252  return function()
19253   if c<n then
19254    c=c+1
19255    local e=collected[c]
19256    local r=e.__p__
19257    return r,r.dt,e.ni
19258   end
19259  end
19260 end
19261end
19262function xml.collected(root,pattern,reverse) 
19263 local collected=applylpath(root,pattern)
19264 if not collected then
19265  return dummy
19266 end
19267 local n=#collected
19268 if n==0 then
19269  return dummy
19270 end
19271 if reverse then
19272  local c=n+1
19273  return function()
19274   if c>1 then
19275    c=c-1
19276    return collected[c]
19277   end
19278  end
19279 else
19280  local c=0
19281  return function()
19282   if c<n then
19283    c=c+1
19284    return collected[c]
19285   end
19286  end
19287 end
19288end
19289function xml.inspect(collection,pattern)
19290 pattern=pattern or "."
19291 for e in xml.collected(collection,pattern or ".") do
19292  report_lpath("pattern: %s\n\n%s\n",pattern,xml.tostring(e))
19293 end
19294end
19295local function split(e) 
19296 local dt=e.dt
19297 if dt then
19298  for i=1,#dt do
19299   local dti=dt[i]
19300   if type(dti)=="string" then
19301    dti=gsub(dti,"^[\n\r]*(.-)[\n\r]*","%1")
19302    dti=gsub(dti,"[\n\r]+","\n\n")
19303    dt[i]=dti
19304   else
19305    split(dti)
19306   end
19307  end
19308 end
19309 return e
19310end
19311function xml.finalizers.paragraphs(c)
19312 for i=1,#c do
19313  split(c[i])
19314 end
19315 return c
19316end
19317
19318
19319end -- of closure
19320
19321do -- create closure to overcome 200 locals limit
19322
19323package.loaded["lxml-mis"] = package.loaded["lxml-mis"] or true
19324
19325-- original size: 3542, stripped down to: 1808
19326
19327if not modules then modules={} end modules ['lxml-mis']={
19328 version=1.001,
19329 comment="this module is the basis for the lxml-* ones",
19330 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
19331 copyright="PRAGMA ADE / ConTeXt Development Team",
19332 license="see context related readme files"
19333}
19334local xml,lpeg,string=xml,lpeg,string
19335local type=type
19336local concat=table.concat
19337local format,gsub,match=string.format,string.gsub,string.match
19338local lpegmatch,lpegpatterns=lpeg.match,lpeg.patterns
19339local P,S,R,C,V,Cc,Cs=lpeg.P,lpeg.S,lpeg.R,lpeg.C,lpeg.V,lpeg.Cc,lpeg.Cs
19340lpegpatterns.xml=lpegpatterns.xml or {}
19341local xmlpatterns=lpegpatterns.xml
19342local function xmlgsub(t,old,new) 
19343 local dt=t.dt
19344 if dt then
19345  for k=1,#dt do
19346   local v=dt[k]
19347   if type(v)=="string" then
19348    dt[k]=gsub(v,old,new)
19349   else
19350    xmlgsub(v,old,new)
19351   end
19352  end
19353 end
19354end
19355function xml.stripleadingspaces(dk,d,k) 
19356 if d and k then
19357  local dkm=d[k-1]
19358  if dkm and type(dkm)=="string" then
19359   local s=match(dkm,"\n(%s+)")
19360   xmlgsub(dk,"\n"..rep(" ",#s),"\n")
19361  end
19362 end
19363end
19364local normal=(1-S("<&>"))^0
19365local special=P("<")/"&lt;"+P(">")/"&gt;"+P("&")/"&amp;"
19366local escaped=Cs(normal*(special*normal)^0)
19367local normal=(1-S"&")^0
19368local special=P("&lt;")/"<"+P("&gt;")/">"+P("&amp;")/"&"
19369local unescaped=Cs(normal*(special*normal)^0)
19370local cleansed=Cs(((P("<")*(1-P(">"))^0*P(">"))/""+1)^0)
19371xmlpatterns.escaped=escaped
19372xmlpatterns.unescaped=unescaped
19373xmlpatterns.cleansed=cleansed
19374function xml.escaped  (str) return lpegmatch(escaped,str)   end
19375function xml.unescaped(str) return lpegmatch(unescaped,str) end
19376function xml.cleansed (str) return lpegmatch(cleansed,str)  end
19377function xml.fillin(root,pattern,str,check)
19378 local e=xml.first(root,pattern)
19379 if e then
19380  local n=#e.dt
19381  if not check or n==0 or (n==1 and e.dt[1]=="") then
19382   e.dt={ str }
19383  end
19384 end
19385end
19386
19387
19388end -- of closure
19389
19390do -- create closure to overcome 200 locals limit
19391
19392package.loaded["lxml-aux"] = package.loaded["lxml-aux"] or true
19393
19394-- original size: 34522, stripped down to: 21511
19395
19396if not modules then modules={} end modules ['lxml-aux']={
19397 version=1.001,
19398 comment="this module is the basis for the lxml-* ones",
19399 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
19400 copyright="PRAGMA ADE / ConTeXt Development Team",
19401 license="see context related readme files"
19402}
19403local trace_manipulations=false  trackers.register("lxml.manipulations",function(v) trace_manipulations=v end)
19404local trace_inclusions=false  trackers.register("lxml.inclusions",function(v) trace_inclusions=v end)
19405local report_xml=logs.reporter("xml")
19406local xml=xml
19407local xmlcopy,xmlname=xml.copy,xml.name
19408local xmlinheritedconvert=xml.inheritedconvert
19409local xmlapplylpath=xml.applylpath
19410local type,next,setmetatable,getmetatable=type,next,setmetatable,getmetatable
19411local insert,remove,fastcopy,concat=table.insert,table.remove,table.fastcopy,table.concat
19412local gmatch,gsub,format,find,strip,match=string.gmatch,string.gsub,string.format,string.find,string.strip,string.match
19413local utfbyte=utf.byte
19414local lpegmatch,lpegpatterns=lpeg.match,lpeg.patterns
19415local striplinepatterns=utilities.strings.striplinepatterns
19416local function report(what,pattern,c,e)
19417 report_xml("%s element %a, root %a, position %a, index %a, pattern %a",what,xmlname(e),xmlname(e.__p__),c,e.ni,pattern)
19418end
19419local function withelements(e,handle,depth)
19420 if e and handle then
19421  local edt=e.dt
19422  if edt then
19423   depth=depth or 0
19424   for i=1,#edt do
19425    local e=edt[i]
19426    if type(e)=="table" then
19427     handle(e,depth)
19428     withelements(e,handle,depth+1)
19429    end
19430   end
19431  end
19432 end
19433end
19434xml.withelements=withelements
19435function xml.withelement(e,n,handle) 
19436 if e and n~=0 and handle then
19437  local edt=e.dt
19438  if edt then
19439   if n>0 then
19440    for i=1,#edt do
19441     local ei=edt[i]
19442     if type(ei)=="table" then
19443      if n==1 then
19444       handle(ei)
19445       return
19446      else
19447       n=n-1
19448      end
19449     end
19450    end
19451   elseif n<0 then
19452    for i=#edt,1,-1 do
19453     local ei=edt[i]
19454     if type(ei)=="table" then
19455      if n==-1 then
19456       handle(ei)
19457       return
19458      else
19459       n=n+1
19460      end
19461     end
19462    end
19463   end
19464  end
19465 end
19466end
19467function xml.each(root,pattern,handle,reverse)
19468 local collected=xmlapplylpath(root,pattern)
19469 if collected then
19470  if handle then
19471   if reverse then
19472    for c=#collected,1,-1 do
19473     handle(collected[c])
19474    end
19475   else
19476    for c=1,#collected do
19477     handle(collected[c])
19478    end
19479   end
19480  end
19481  return collected
19482 end
19483end
19484function xml.processattributes(root,pattern,handle)
19485 local collected=xmlapplylpath(root,pattern)
19486 if collected and handle then
19487  for c=1,#collected do
19488   handle(collected[c].at)
19489  end
19490 end
19491 return collected
19492end
19493function xml.collect(root,pattern)
19494 return xmlapplylpath(root,pattern)
19495end
19496function xml.collecttexts(root,pattern,flatten) 
19497 local collected=xmlapplylpath(root,pattern)
19498 if collected and flatten then
19499  local xmltostring=xml.tostring
19500  for c=1,#collected do
19501   collected[c]=xmltostring(collected[c].dt)
19502  end
19503 end
19504 return collected or {}
19505end
19506function xml.collect_tags(root,pattern,nonamespace)
19507 local collected=xmlapplylpath(root,pattern)
19508 if collected then
19509  local t={}
19510  local n=0
19511  for c=1,#collected do
19512   local e=collected[c]
19513   local ns=e.ns
19514   local tg=e.tg
19515   n=n+1
19516   if nonamespace then
19517    t[n]=tg
19518   elseif ns=="" then
19519    t[n]=tg
19520   else
19521    t[n]=ns..":"..tg
19522   end
19523  end
19524  return t
19525 end
19526end
19527local no_root={ no_root=true }
19528local function redo_ni(d)
19529 for k=1,#d do
19530  local dk=d[k]
19531  if type(dk)=="table" then
19532   dk.ni=k
19533  end
19534 end
19535end
19536xml.reindex=redo_ni
19537local function xmltoelement(whatever,root)
19538 if not whatever then
19539  return nil
19540 end
19541 local element
19542 if type(whatever)=="string" then
19543  element=xmlinheritedconvert(whatever,root,true) 
19544 else
19545  element=whatever 
19546 end
19547 if element.error then
19548  return whatever 
19549 end
19550 if element then
19551 end
19552 return element
19553end
19554xml.toelement=xmltoelement
19555local function copiedelement(element,newparent)
19556 if type(element)~="string" then
19557  element=xmlcopy(element).dt
19558  if newparent and type(element)=="table" then
19559   for i=1,#element do
19560    local e=element[i]
19561    if type(e)=="table" then
19562     e.__p__=newparent
19563    end
19564   end
19565  end
19566 end
19567 return element
19568end
19569function xml.delete(root,pattern)
19570 if not pattern or pattern=="" then
19571  local p=root.__p__
19572  if p then
19573   if trace_manipulations then
19574    report('deleting',"--",c,root)
19575   end
19576   local d=p.dt
19577   remove(d,root.ni)
19578   redo_ni(d) 
19579  end
19580 else
19581  local collected=xmlapplylpath(root,pattern)
19582  if collected then
19583   for c=1,#collected do
19584    local e=collected[c]
19585    local p=e.__p__
19586    if p then
19587     if trace_manipulations then
19588      report('deleting',pattern,c,e)
19589     end
19590     local d=p.dt
19591     local ni=e.ni
19592     if ni<=#d then
19593      if false then
19594       p.dt[ni]=""
19595      else
19596       remove(d,ni)
19597       redo_ni(d) 
19598      end
19599     else
19600     end
19601    end
19602   end
19603  end
19604 end
19605end
19606function xml.wipe(root,pattern) 
19607 local collected=xmlapplylpath(root,pattern)
19608 if collected then
19609  for c=1,#collected do
19610   local e=collected[c]
19611   local p=e.__p__
19612   if p then
19613    local d=p.dt
19614    local ni=e.ni
19615    if ni<=#d then
19616     local dt=e.dt
19617     if #dt==1 then
19618      local d1=dt[1]
19619      if type(d1)=="string" and match(d1,"^%s*$") then
19620       if trace_manipulations then
19621        report('wiping',pattern,c,e)
19622       end
19623       remove(d,ni)
19624       redo_ni(d) 
19625      end
19626     end
19627    end
19628   end
19629  end
19630 end
19631end
19632function xml.replace(root,pattern,whatever)
19633 local element=root and xmltoelement(whatever,root)
19634 local collected=element and xmlapplylpath(root,pattern)
19635 if collected then
19636  for c=1,#collected do
19637   local e=collected[c]
19638   local p=e.__p__
19639   if p then
19640    if trace_manipulations then
19641     report('replacing',pattern,c,e)
19642    end
19643    local d=p.dt
19644    local n=e.ni
19645    local t=copiedelement(element,p)
19646    if type(t)=="table" then
19647     d[n]=t[1]
19648     for i=2,#t do
19649      n=n+1
19650      insert(d,n,t[i])
19651     end
19652    else
19653     d[n]=t
19654    end
19655    redo_ni(d) 
19656   end
19657  end
19658 end
19659end
19660function xml.expand(root,pattern,whatever)
19661 local collected=root and xmlapplylpath(root,pattern)
19662 if collected then
19663  for c=1,#collected do
19664   local e=collected[c]
19665   local p=e.__p__
19666   if p then
19667    if trace_manipulations then
19668     report('expanding',pattern,c,e)
19669    end
19670    local d=p.dt
19671    local n=e.ni
19672    local t=whatever(e,p)
19673    if t then
19674     if type(t)=="table" then
19675      t=xmlcopy(t)
19676      d[n]=t[1]
19677      for i=2,#t do
19678       n=n+1
19679       insert(d,n,t[i])
19680      end
19681     else
19682      d[n]=t
19683     end
19684     redo_ni(d) 
19685    end
19686   end
19687  end
19688 end
19689end
19690local function wrap(e,wrapper)
19691 local t={
19692  rn=e.rn,
19693  tg=e.tg,
19694  ns=e.ns,
19695  at=e.at,
19696  dt=e.dt,
19697  __p__=e,
19698 }
19699 setmetatable(t,getmetatable(e))
19700 e.rn=wrapper.rn or e.rn or ""
19701 e.tg=wrapper.tg or e.tg or ""
19702 e.ns=wrapper.ns or e.ns or ""
19703 e.at=fastcopy(wrapper.at)
19704 e.dt={ t }
19705end
19706function xml.wrap(root,pattern,whatever)
19707 if whatever then
19708  local wrapper=xmltoelement(whatever,root)
19709  local collected=xmlapplylpath(root,pattern)
19710  if collected then
19711   for c=1,#collected do
19712    local e=collected[c]
19713    if trace_manipulations then
19714     report('wrapping',pattern,c,e)
19715    end
19716    wrap(e,wrapper)
19717   end
19718  end
19719 else
19720  wrap(root,xmltoelement(pattern))
19721 end
19722end
19723local function inject_element(root,pattern,whatever,prepend)
19724 local element=root and xmltoelement(whatever,root)
19725 local collected=element and xmlapplylpath(root,pattern)
19726 local function inject_e(e)
19727  local r=e.__p__
19728  local d=r.dt
19729  local k=e.ni
19730  local rri=r.ri
19731  local edt=(rri and d[rri].dt) or (d and d[k] and d[k].dt)
19732  if edt then
19733   local be,af
19734   local cp=copiedelement(element,e)
19735   if prepend then
19736    be,af=cp,edt
19737   else
19738    be,af=edt,cp
19739   end
19740   local bn=#be
19741   for i=1,#af do
19742    bn=bn+1
19743    be[bn]=af[i]
19744   end
19745   if rri then
19746    r.dt[rri].dt=be
19747   else
19748    d[k].dt=be
19749   end
19750   redo_ni(d)
19751  end
19752 end
19753 if not collected then
19754 elseif collected.tg then
19755  inject_e(collected)
19756 else
19757  for c=1,#collected do
19758   inject_e(collected[c])
19759  end
19760 end
19761end
19762local function insert_element(root,pattern,whatever,before) 
19763 local element=root and xmltoelement(whatever,root)
19764 local collected=element and xmlapplylpath(root,pattern)
19765 local function insert_e(e)
19766  local r=e.__p__
19767  local d=r.dt
19768  local k=e.ni
19769  if not before then
19770   k=k+1
19771  end
19772  insert(d,k,copiedelement(element,r))
19773  redo_ni(d)
19774 end
19775 if not collected then
19776 elseif collected.tg then
19777  insert_e(collected)
19778 else
19779  for c=1,#collected do
19780   insert_e(collected[c])
19781  end
19782 end
19783end
19784xml.insert_element=insert_element
19785xml.insertafter=insert_element
19786xml.insertbefore=function(r,p,e) insert_element(r,p,e,true) end
19787xml.injectafter=inject_element
19788xml.injectbefore=function(r,p,e) inject_element(r,p,e,true) end
19789local function include(xmldata,pattern,attribute,recursive,loaddata,level)
19790 pattern=pattern or 'include'
19791 loaddata=loaddata or io.loaddata
19792 local collected=xmlapplylpath(xmldata,pattern)
19793 if collected then
19794  if not level then
19795   level=1
19796  end
19797  for c=1,#collected do
19798   local ek=collected[c]
19799   local name=nil
19800   local ekdt=ek.dt
19801   if ekdt then
19802    local ekat=ek.at
19803    local ekrt=ek.__p__
19804    if ekrt then
19805     local epdt=ekrt.dt
19806     if not attribute or attribute=="" then
19807      name=(type(ekdt)=="table" and ekdt[1]) or ekdt 
19808     end
19809     if not name then
19810      for a in gmatch(attribute or "href","([^|]+)") do
19811       name=ekat[a]
19812       if name then
19813        break
19814       end
19815      end
19816     end
19817     local data=nil
19818     if name and name~="" then
19819      local d,n=loaddata(name)
19820      data=d or ""
19821      name=n or name
19822      if trace_inclusions then
19823       report_xml("including %s bytes from %a at level %s by pattern %a and attribute %a (%srecursing)",#data,name,level,pattern,attribute or "",recursive and "" or "not ")
19824      end
19825     end
19826     if not data or data=="" then
19827      epdt[ek.ni]="" 
19828     elseif ekat["parse"]=="text" then
19829      epdt[ek.ni]=xml.escaped(data) 
19830     else
19831      local settings=xmldata.settings
19832      local savedresource=settings.currentresource
19833      settings.currentresource=name
19834      local xi=xmlinheritedconvert(data,xmldata,true)
19835      if not xi then
19836       epdt[ek.ni]="" 
19837      else
19838       if recursive then
19839        include(xi,pattern,attribute,recursive,loaddata,level+1)
19840       end
19841       local child=xml.body(xi) 
19842       child.__p__=ekrt
19843       child.__f__=name 
19844       child.cf=name
19845       epdt[ek.ni]=child
19846       local settings=xmldata.settings
19847       local inclusions=settings and settings.inclusions
19848       if inclusions then
19849        inclusions[#inclusions+1]=name
19850       elseif settings then
19851        settings.inclusions={ name }
19852       else
19853        settings={ inclusions={ name } }
19854        xmldata.settings=settings
19855       end
19856       if child.er then
19857        local badinclusions=settings.badinclusions
19858        if badinclusions then
19859         badinclusions[#badinclusions+1]=name
19860        else
19861         settings.badinclusions={ name }
19862        end
19863       end
19864      end
19865settings.currentresource=savedresource
19866     end
19867    end
19868   end
19869  end
19870 end
19871end
19872xml.include=include
19873function xml.inclusion(e,default)
19874 while e do
19875  local f=e.__f__
19876  if f then
19877   return f
19878  else
19879   e=e.__p__
19880  end
19881 end
19882 return default
19883end
19884local function getinclusions(key,e,sorted)
19885 while e do
19886  local settings=e.settings
19887  if settings then
19888   local inclusions=settings[key]
19889   if inclusions then
19890    inclusions=table.unique(inclusions) 
19891    if sorted then
19892     table.sort(inclusions) 
19893    end
19894    return inclusions 
19895   else
19896    e=e.__p__
19897   end
19898  else
19899   e=e.__p__
19900  end
19901 end
19902end
19903function xml.inclusions(e,sorted)
19904 return getinclusions("inclusions",e,sorted)
19905end
19906function xml.badinclusions(e,sorted)
19907 return getinclusions("badinclusions",e,sorted)
19908end
19909local b_collapser=lpegpatterns.b_collapser
19910local m_collapser=lpegpatterns.m_collapser
19911local e_collapser=lpegpatterns.e_collapser
19912local x_collapser=lpegpatterns.x_collapser
19913local b_stripper=lpegpatterns.b_stripper
19914local m_stripper=lpegpatterns.m_stripper
19915local e_stripper=lpegpatterns.e_stripper
19916local x_stripper=lpegpatterns.x_stripper
19917local function stripelement(e,nolines,anywhere,everything)
19918 local edt=e.dt
19919 if edt then
19920  local n=#edt
19921  if n==0 then
19922   return e 
19923  elseif everything then
19924   local t={}
19925   local m=0
19926   for i=1,n do
19927    local str=edt[i]
19928    if type(str)~="string" then
19929     m=m+1
19930     t[m]=str
19931    elseif str~="" then
19932     str=lpegmatch(x_collapser,str)
19933     if str~="" then
19934      m=m+1
19935      t[m]=str
19936     end
19937    end
19938   end
19939   e.dt=t
19940  elseif anywhere then
19941   local t={}
19942   local m=0
19943   for i=1,n do
19944    local str=edt[i]
19945    if type(str)~="string" then
19946     m=m+1
19947     t[m]=str
19948    elseif str~="" then
19949     if nolines then
19950      str=lpegmatch((i==1 and b_collapser) or (i==m and e_collapser) or m_collapser,str)
19951     else
19952      str=lpegmatch((i==1 and b_stripper) or (i==m and e_stripper) or m_stripper,str)
19953     end
19954     if str~="" then
19955      m=m+1
19956      t[m]=str
19957     end
19958    end
19959   end
19960   e.dt=t
19961  else
19962   local str=edt[1]
19963   if type(str)=="string" then
19964    if str~="" then
19965     str=lpegmatch(nolines and b_collapser or b_stripper,str)
19966    end
19967    if str=="" then
19968     remove(edt,1)
19969     n=n-1
19970    else
19971     edt[1]=str
19972    end
19973   end
19974   if n>0 then
19975    str=edt[n]
19976    if type(str)=="string" then
19977     if str=="" then
19978      remove(edt)
19979     else
19980      str=lpegmatch(nolines and e_collapser or e_stripper,str)
19981      if str=="" then
19982       remove(edt)
19983      else
19984       edt[n]=str
19985      end
19986     end
19987    end
19988   end
19989  end
19990 end
19991 return e 
19992end
19993xml.stripelement=stripelement
19994function xml.strip(root,pattern,nolines,anywhere,everything) 
19995 local collected=xmlapplylpath(root,pattern) 
19996 if collected then
19997  for i=1,#collected do
19998   stripelement(collected[i],nolines,anywhere,everything)
19999  end
20000 end
20001end
20002local function compactelement(e)
20003 local edt=e.dt
20004 if edt then
20005  for e=1,#edt do
20006   local str=edt[e]
20007   if type(str)=="string" and not find(str,"%S") then
20008    edt[e]=""
20009   end
20010  end
20011 end
20012 return e 
20013end
20014xml.compactelement=compactelement
20015local function renamespace(root,oldspace,newspace) 
20016 local ndt=#root.dt
20017 for i=1,ndt or 0 do
20018  local e=root[i]
20019  if type(e)=="table" then
20020   if e.ns==oldspace then
20021    e.ns=newspace
20022    if e.rn then
20023     e.rn=newspace
20024    end
20025   end
20026   local edt=e.dt
20027   if edt then
20028    renamespace(edt,oldspace,newspace)
20029   end
20030  end
20031 end
20032end
20033xml.renamespace=renamespace
20034function xml.remaptag(root,pattern,newtg)
20035 local collected=xmlapplylpath(root,pattern)
20036 if collected then
20037  for c=1,#collected do
20038   collected[c].tg=newtg
20039  end
20040 end
20041end
20042function xml.remapnamespace(root,pattern,newns)
20043 local collected=xmlapplylpath(root,pattern)
20044 if collected then
20045  for c=1,#collected do
20046   collected[c].ns=newns
20047  end
20048 end
20049end
20050function xml.checknamespace(root,pattern,newns)
20051 local collected=xmlapplylpath(root,pattern)
20052 if collected then
20053  for c=1,#collected do
20054   local e=collected[c]
20055   if (not e.rn or e.rn=="") and e.ns=="" then
20056    e.rn=newns
20057   end
20058  end
20059 end
20060end
20061function xml.remapname(root,pattern,newtg,newns,newrn)
20062 local collected=xmlapplylpath(root,pattern)
20063 if collected then
20064  for c=1,#collected do
20065   local e=collected[c]
20066   e.tg,e.ns,e.rn=newtg,newns,newrn
20067  end
20068 end
20069end
20070function xml.cdatatotext(e)
20071 local dt=e.dt
20072 if #dt==1 then
20073  local first=dt[1]
20074  if first.tg=="@cd@" then
20075   e.dt=first.dt
20076  end
20077 else
20078 end
20079end
20080function xml.texttocdata(e) 
20081 local dt=e.dt
20082 local s=xml.tostring(dt) 
20083 e.tg="@cd@"
20084 e.special=true
20085 e.ns=""
20086 e.rn=""
20087 e.dt={ s }
20088 e.at=nil
20089end
20090function xml.elementtocdata(e) 
20091 local dt=e.dt
20092 local s=xml.tostring(e) 
20093 e.tg="@cd@"
20094 e.special=true
20095 e.ns=""
20096 e.rn=""
20097 e.dt={ s }
20098 e.at=nil
20099end
20100xml.builtinentities=table.tohash { "amp","quot","apos","lt","gt" } 
20101local entities=characters and characters.entities or nil
20102local builtinentities=xml.builtinentities
20103function xml.addentitiesdoctype(root,option) 
20104 if not entities then
20105  require("char-ent")
20106  entities=characters.entities
20107 end
20108 if entities and root and root.tg=="@rt@" and root.statistics then
20109  local list={}
20110  local hexify=option=="hexadecimal"
20111  for k,v in table.sortedhash(root.statistics.entities.names) do
20112   if not builtinentities[k] then
20113    local e=entities[k]
20114    if not e then
20115     e=format("[%s]",k)
20116    elseif hexify then
20117     e=format("&#%05X;",utfbyte(k))
20118    end
20119    list[#list+1]=format("  <!ENTITY %s %q >",k,e)
20120   end
20121  end
20122  local dt=root.dt
20123  local n=dt[1].tg=="@pi@" and 2 or 1
20124  if #list>0 then
20125   insert(dt,n,{ "\n" })
20126   insert(dt,n,{
20127      tg="@dt@",
20128      dt={ format("Something [\n%s\n] ",concat(list)) },
20129      ns="",
20130      special=true,
20131   })
20132   insert(dt,n,{ "\n\n" })
20133  else
20134  end
20135 end
20136end
20137xml.all=xml.each
20138xml.insert=xml.insertafter
20139xml.inject=xml.injectafter
20140xml.after=xml.insertafter
20141xml.before=xml.insertbefore
20142xml.process=xml.each
20143xml.obsolete=xml.obsolete or {}
20144local obsolete=xml.obsolete
20145xml.strip_whitespace=xml.strip     obsolete.strip_whitespace=xml.strip
20146xml.collect_elements=xml.collect      obsolete.collect_elements=xml.collect
20147xml.delete_element=xml.delete    obsolete.delete_element=xml.delete
20148xml.replace_element=xml.replace      obsolete.replace_element=xml.replace
20149xml.each_element=xml.each      obsolete.each_element=xml.each
20150xml.process_elements=xml.process      obsolete.process_elements=xml.process
20151xml.insert_element_after=xml.insertafter     obsolete.insert_element_after=xml.insertafter
20152xml.insert_element_before=xml.insertbefore    obsolete.insert_element_before=xml.insertbefore
20153xml.inject_element_after=xml.injectafter     obsolete.inject_element_after=xml.injectafter
20154xml.inject_element_before=xml.injectbefore    obsolete.inject_element_before=xml.injectbefore
20155xml.process_attributes=xml.processattributes  obsolete.process_attributes=xml.processattributes
20156xml.collect_texts=xml.collecttexts    obsolete.collect_texts=xml.collecttexts
20157xml.inject_element=xml.inject    obsolete.inject_element=xml.inject
20158xml.remap_tag=xml.remaptag     obsolete.remap_tag=xml.remaptag
20159xml.remap_name=xml.remapname    obsolete.remap_name=xml.remapname
20160xml.remap_namespace=xml.remapnamespace  obsolete.remap_namespace=xml.remapnamespace
20161function xml.cdata(e)
20162 if e then
20163  local dt=e.dt
20164  if dt and #dt==1 then
20165   local first=dt[1]
20166   return first.tg=="@cd@" and first.dt[1] or ""
20167  end
20168 end
20169 return ""
20170end
20171function xml.finalizers.xml.cdata(collected)
20172 if collected then
20173  local e=collected[1]
20174  if e then
20175   local dt=e.dt
20176   if dt and #dt==1 then
20177    local first=dt[1]
20178    return first.tg=="@cd@" and first.dt[1] or ""
20179   end
20180  end
20181 end
20182 return ""
20183end
20184function xml.insertcomment(e,str,n)
20185 insert(e.dt,n or 1,{
20186  tg="@cm@",
20187  ns="",
20188  special=true,
20189  at={},
20190  dt={ str },
20191 })
20192end
20193function xml.insertcdata(e,str,n)
20194 insert(e.dt,n or 1,{
20195  tg="@cd@",
20196  ns="",
20197  special=true,
20198  at={},
20199  dt={ str },
20200 })
20201end
20202function xml.setcomment(e,str,n)
20203 e.dt={ {
20204  tg="@cm@",
20205  ns="",
20206  special=true,
20207  at={},
20208  dt={ str },
20209 } }
20210end
20211function xml.setcdata(e,str)
20212 e.dt={ {
20213  tg="@cd@",
20214  ns="",
20215  special=true,
20216  at={},
20217  dt={ str },
20218 } }
20219end
20220function xml.separate(x,pattern)
20221 local collected=xmlapplylpath(x,pattern)
20222 if collected then
20223  for c=1,#collected do
20224   local e=collected[c]
20225   local d=e.dt
20226   if d==x then
20227    report_xml("warning: xml.separate changes root")
20228    x=d
20229   end
20230   local t={ "\n" }
20231   local n=1
20232   local i=1
20233   local nd=#d
20234   while i<=nd do
20235    while i<=nd do
20236     local di=d[i]
20237     if type(di)=="string" then
20238      if di=="\n" or find(di,"^%s+$") then 
20239       i=i+1
20240      else
20241       d[i]=strip(di)
20242       break
20243      end
20244     else
20245      break
20246     end
20247    end
20248    if i>nd then
20249     break
20250    end
20251    t[n+1]="\n"
20252    t[n+2]=d[i]
20253    t[n+3]="\n"
20254    n=n+3
20255    i=i+1
20256   end
20257   t[n+1]="\n"
20258   setmetatable(t,getmetatable(d))
20259   e.dt=t
20260  end
20261 end
20262 return x
20263end
20264local helpers=xml.helpers or {}
20265xml.helpers=helpers
20266local function normal(e,action)
20267 local edt=e.dt
20268 if edt then
20269  for i=1,#edt do
20270   local str=edt[i]
20271   if type(str)=="string" and str~="" then
20272    edt[i]=action(str)
20273   end
20274  end
20275 end
20276end
20277local function recurse(e,action)
20278 local edt=e.dt
20279 if edt then
20280  for i=1,#edt do
20281   local str=edt[i]
20282   if type(str)~="string" then
20283    recurse(str,action) 
20284   elseif str~="" then
20285    edt[i]=action(str)
20286   end
20287  end
20288 end
20289end
20290function helpers.recursetext(collected,action,recursive)
20291 if recursive then
20292  for i=1,#collected do
20293   recurse(collected[i],action)
20294  end
20295 else
20296  for i=1,#collected do
20297     normal(collected[i],action)
20298  end
20299 end
20300end
20301local specials={
20302 ["@rt@"]="root",
20303 ["@pi@"]="instruction",
20304 ["@cm@"]="comment",
20305 ["@dt@"]="declaration",
20306 ["@cd@"]="cdata",
20307}
20308local function convert(x,strip,flat)
20309 local ns=x.ns
20310 local tg=x.tg
20311 local at=x.at
20312 local dt=x.dt
20313 local node=flat and {
20314  [0]=(not x.special and (ns~="" and ns..":"..tg or tg)) or nil,
20315 } or {
20316  _namespace=ns~="" and ns or nil,
20317  _tag=not x.special and tg or nil,
20318  _type=specials[tg] or "_element",
20319 }
20320 if at then
20321  for k,v in next,at do
20322   node[k]=v
20323  end
20324 end
20325 local n=0
20326 for i=1,#dt do
20327  local di=dt[i]
20328  if type(di)=="table" then
20329   if flat and di.special then
20330   else
20331    di=convert(di,strip,flat)
20332    if di then
20333     n=n+1
20334     node[n]=di
20335    end
20336   end
20337  elseif strip then
20338   di=lpegmatch(strip,di)
20339   if di~="" then
20340    n=n+1
20341    node[n]=di
20342   end
20343  else
20344   n=n+1
20345   node[n]=di
20346  end
20347 end
20348 if next(node) then
20349  return node
20350 end
20351end
20352function xml.totable(x,strip,flat)
20353 if type(x)=="table" then
20354  if strip then
20355   strip=striplinepatterns[strip]
20356  end
20357  return convert(x,strip,flat)
20358 end
20359end
20360function xml.rename(e,namespace,name,attributes)
20361 if type(e)~="table" or not e.tg then
20362  return
20363 end
20364 if type(name)=="table" then
20365  attributes=name
20366  name=namespace
20367  namespace=""
20368 elseif type(name)~="string" then
20369  attributes={}
20370  name=namespace
20371  namespace=""
20372 end
20373 if type(attributes)~="table" then
20374  attributes={}
20375 end
20376 e.ns=namespace
20377 e.rn=namespace
20378 e.tg=name
20379 e.at=attributes
20380end
20381
20382
20383end -- of closure
20384
20385do -- create closure to overcome 200 locals limit
20386
20387package.loaded["lxml-xml"] = package.loaded["lxml-xml"] or true
20388
20389-- original size: 11096, stripped down to: 7702
20390
20391if not modules then modules={} end modules ['lxml-xml']={
20392 version=1.001,
20393 comment="this module is the basis for the lxml-* ones",
20394 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
20395 copyright="PRAGMA ADE / ConTeXt Development Team",
20396 license="see context related readme files"
20397}
20398local tonumber,next=tonumber,next
20399local concat=table.concat
20400local find,lower,upper=string.find,string.lower,string.upper
20401local xml=xml
20402local finalizers=xml.finalizers.xml
20403local xmlfilter=xml.filter 
20404local xmltostring=xml.tostring
20405local xmlserialize=xml.serialize
20406local xmlcollected=xml.collected
20407local xmlnewhandlers=xml.newhandlers
20408local reparsedentity=xml.reparsedentitylpeg   
20409local unescapedentity=xml.unescapedentitylpeg
20410local parsedentity=reparsedentity
20411local function first(collected) 
20412 return collected and collected[1]
20413end
20414local function last(collected)
20415 return collected and collected[#collected]
20416end
20417local function all(collected)
20418 return collected
20419end
20420local reverse=table.reversed
20421local function attribute(collected,name)
20422 if collected and #collected>0 then
20423  local at=collected[1].at
20424  return at and at[name]
20425 end
20426end
20427local function att(id,name)
20428 local at=id.at
20429 return at and at[name]
20430end
20431local function count(collected)
20432 return collected and #collected or 0
20433end
20434local function position(collected,n)
20435 if not collected then
20436  return 0
20437 end
20438 local nc=#collected
20439 if nc==0 then
20440  return 0
20441 end
20442 n=tonumber(n) or 0
20443 if n<0 then
20444  return collected[nc+n+1]
20445 elseif n>0 then
20446  return collected[n]
20447 else
20448  return collected[1].mi or 0
20449 end
20450end
20451local function match(collected)
20452 return collected and #collected>0 and collected[1].mi or 0 
20453end
20454local function index(collected)
20455 return collected and #collected>0 and collected[1].ni or 0 
20456end
20457local function attributes(collected,arguments)
20458 if collected and #collected>0 then
20459  local at=collected[1].at
20460  if arguments then
20461   return at[arguments]
20462  elseif next(at) then
20463   return at 
20464  end
20465 end
20466end
20467local function chainattribute(collected,arguments) 
20468 if collected and #collected>0 then
20469  local e=collected[1]
20470  while e do
20471   local at=e.at
20472   if at then
20473    local a=at[arguments]
20474    if a then
20475     return a
20476    end
20477   else
20478    break 
20479   end
20480   e=e.__p__
20481  end
20482 end
20483 return ""
20484end
20485local function raw(collected) 
20486 if collected and #collected>0 then
20487  local e=collected[1] or collected
20488  return e and xmltostring(e) or "" 
20489 else
20490  return ""
20491 end
20492end
20493local xmltexthandler=xmlnewhandlers {
20494 name="string",
20495 initialize=function()
20496  result={}
20497  return result
20498 end,
20499 finalize=function()
20500  return concat(result)
20501 end,
20502 handle=function(...)
20503  result[#result+1]=concat {... }
20504 end,
20505 escape=false,
20506}
20507local function xmltotext(root)
20508 local dt=root.dt
20509 if not dt then
20510  return ""
20511 end
20512 local nt=#dt 
20513 if nt==0 then
20514  return ""
20515 elseif nt==1 and type(dt[1])=="string" then
20516  return dt[1] 
20517 else
20518  return xmlserialize(root,xmltexthandler) or ""
20519 end
20520end
20521function xml.serializetotext(root)
20522 return root and xmlserialize(root,xmltexthandler) or ""
20523end
20524local function text(collected) 
20525 if collected then 
20526  local e=collected[1] or collected 
20527  return e and xmltotext(e) or ""
20528 else
20529  return ""
20530 end
20531end
20532local function texts(collected)
20533 if not collected then
20534  return {} 
20535 end
20536 local nc=#collected
20537 if nc==0 then
20538  return {} 
20539 end
20540 local t,n={},0
20541 for c=1,nc do
20542  local e=collected[c]
20543  if e and e.dt then
20544   n=n+1
20545   t[n]=e.dt
20546  end
20547 end
20548 return t
20549end
20550local function tag(collected,n)
20551 if not collected then
20552  return
20553 end
20554 local nc=#collected
20555 if nc==0 then
20556  return
20557 end
20558 local c
20559 if n==0 or not n then
20560  c=collected[1]
20561 elseif n>1 then
20562  c=collected[n]
20563 else
20564  c=collected[nc-n+1]
20565 end
20566 return c and c.tg
20567end
20568local function name(collected,n)
20569 if not collected then
20570  return
20571 end
20572 local nc=#collected
20573 if nc==0 then
20574  return
20575 end
20576 local c
20577 if n==0 or not n then
20578  c=collected[1]
20579 elseif n>1 then
20580  c=collected[n]
20581 else
20582  c=collected[nc-n+1]
20583 end
20584 if not c then
20585 elseif c.ns=="" then
20586  return c.tg
20587 else
20588  return c.ns..":"..c.tg
20589 end
20590end
20591local function tags(collected,nonamespace)
20592 if not collected then
20593  return
20594 end
20595 local nc=#collected
20596 if nc==0 then
20597  return
20598 end
20599 local t,n={},0
20600 for c=1,nc do
20601  local e=collected[c]
20602  local ns,tg=e.ns,e.tg
20603  n=n+1
20604  if nonamespace or ns=="" then
20605   t[n]=tg
20606  else
20607   t[n]=ns..":"..tg
20608  end
20609 end
20610 return t
20611end
20612local function empty(collected,spacesonly)
20613 if not collected then
20614  return true
20615 end
20616 local nc=#collected
20617 if nc==0 then
20618  return true
20619 end
20620 for c=1,nc do
20621  local e=collected[c]
20622  if e then
20623   local edt=e.dt
20624   if edt then
20625    local n=#edt
20626    if n==1 then
20627     local edk=edt[1]
20628     local typ=type(edk)
20629     if typ=="table" then
20630      return false
20631     elseif edk~="" then
20632      return false
20633     elseif spacesonly and not find(edk,"%S") then
20634      return false
20635     end
20636    elseif n>1 then
20637     return false
20638    end
20639   end
20640  end
20641 end
20642 return true
20643end
20644finalizers.first=first
20645finalizers.last=last
20646finalizers.all=all
20647finalizers.reverse=reverse
20648finalizers.elements=all
20649finalizers.default=all
20650finalizers.attribute=attribute
20651finalizers.att=att
20652finalizers.count=count
20653finalizers.position=position
20654finalizers.match=match
20655finalizers.index=index
20656finalizers.attributes=attributes
20657finalizers.chainattribute=chainattribute
20658finalizers.text=text
20659finalizers.texts=texts
20660finalizers.tag=tag
20661finalizers.name=name
20662finalizers.tags=tags
20663finalizers.empty=empty
20664function xml.first(id,pattern)
20665 return first(xmlfilter(id,pattern))
20666end
20667function xml.last(id,pattern)
20668 return last(xmlfilter(id,pattern))
20669end
20670function xml.count(id,pattern)
20671 return count(xmlfilter(id,pattern))
20672end
20673function xml.attribute(id,pattern,a,default)
20674 return attribute(xmlfilter(id,pattern),a,default)
20675end
20676function xml.raw(id,pattern)
20677 if pattern then
20678  return raw(xmlfilter(id,pattern))
20679 else
20680  return raw(id)
20681 end
20682end
20683function xml.text(id,pattern) 
20684 if pattern then
20685  local collected=xmlfilter(id,pattern)
20686  return collected and #collected>0 and xmltotext(collected[1]) or ""
20687 elseif id then
20688  return xmltotext(id) or ""
20689 else
20690  return ""
20691 end
20692end
20693function xml.pure(id,pattern)
20694 if pattern then
20695  local collected=xmlfilter(id,pattern)
20696  if collected and #collected>0 then
20697   parsedentity=unescapedentity
20698   local s=collected and #collected>0 and xmltotext(collected[1]) or ""
20699   parsedentity=reparsedentity
20700   return s
20701  else
20702   return ""
20703  end
20704 else
20705  parsedentity=unescapedentity
20706  local s=xmltotext(id) or ""
20707  parsedentity=reparsedentity
20708  return s
20709 end
20710end
20711xml.content=text
20712function xml.position(id,pattern,n) 
20713 return position(xmlfilter(id,pattern),n)
20714end
20715function xml.match(id,pattern) 
20716 return match(xmlfilter(id,pattern))
20717end
20718function xml.empty(id,pattern,spacesonly)
20719 return empty(xmlfilter(id,pattern),spacesonly)
20720end
20721xml.all=xml.filter
20722xml.index=xml.position
20723xml.found=xml.filter
20724local function totable(x)
20725 local t={}
20726 for e in xmlcollected(x[1] or x,"/*") do
20727  t[e.tg]=xmltostring(e.dt) or ""
20728 end
20729 return next(t) and t or nil
20730end
20731xml.table=totable
20732finalizers.table=totable
20733local function textonly(e,t)
20734 if e then
20735  local edt=e.dt
20736  if edt then
20737   for i=1,#edt do
20738    local e=edt[i]
20739    if type(e)=="table" then
20740     textonly(e,t)
20741    else
20742     t[#t+1]=e
20743    end
20744   end
20745  end
20746 end
20747 return t
20748end
20749function xml.textonly(e) 
20750 return concat(textonly(e,{}))
20751end
20752function finalizers.lowerall(collected)
20753 for c=1,#collected do
20754  local e=collected[c]
20755  if not e.special then
20756   e.tg=lower(e.tg)
20757   local eat=e.at
20758   if eat then
20759    local t={}
20760    for k,v in next,eat do
20761     t[lower(k)]=v
20762    end
20763    e.at=t
20764   end
20765  end
20766 end
20767end
20768function finalizers.upperall(collected)
20769 for c=1,#collected do
20770  local e=collected[c]
20771  if not e.special then
20772   e.tg=upper(e.tg)
20773   local eat=e.at
20774   if eat then
20775    local t={}
20776    for k,v in next,eat do
20777     t[upper(k)]=v
20778    end
20779    e.at=t
20780   end
20781  end
20782 end
20783end
20784
20785
20786end -- of closure
20787
20788do -- create closure to overcome 200 locals limit
20789
20790package.loaded["trac-xml"] = package.loaded["trac-xml"] or true
20791
20792-- original size: 6407, stripped down to: 4640
20793
20794if not modules then modules={} end modules ['trac-xml']={
20795 version=1.001,
20796 comment="companion to trac-log.mkiv",
20797 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
20798 copyright="PRAGMA ADE / ConTeXt Development Team",
20799 license="see context related readme files"
20800}
20801local formatters=string.formatters
20802local reporters=logs.reporters
20803local xmlserialize=xml.serialize
20804local xmlcollected=xml.collected
20805local xmltext=xml.text
20806local xmlfirst=xml.first
20807local function showhelp(specification,...)
20808 local root=xml.convert(specification.helpinfo or "")
20809 if not root then
20810  return
20811 end
20812 local xs=xml.gethandlers("string")
20813 xml.sethandlersfunction(xs,"short",function(e,handler) xmlserialize(e.dt,handler) end)
20814 xml.sethandlersfunction(xs,"ref",function(e,handler) handler.handle("--"..e.at.name) end)
20815 local wantedcategories=select("#",...)==0 and true or table.tohash {... }
20816 local nofcategories=xml.count(root,"/application/flags/category")
20817 local report=specification.report
20818 for category in xmlcollected(root,"/application/flags/category") do
20819  local categoryname=category.at.name or ""
20820  if wantedcategories==true or wantedcategories[categoryname] then
20821   if nofcategories>1 then
20822    report("%s options:",categoryname)
20823    report()
20824   end
20825   for subcategory in xmlcollected(category,"/subcategory") do
20826    for flag in xmlcollected(subcategory,"/flag") do
20827     local name=flag.at.name
20828     local value=flag.at.value
20829     local short=xmltext(xmlfirst(flag,"/short"))
20830     if value then
20831      report("--%-20s %s",formatters["%s=%s"](name,value),short)
20832     else
20833      report("--%-20s %s",name,short)
20834     end
20835    end
20836    report()
20837   end
20838  end
20839 end
20840 for category in xmlcollected(root,"/application/examples/category") do
20841  local title=xmltext(xmlfirst(category,"/title"))
20842  if title and title~="" then
20843   report()
20844   report(title)
20845   report()
20846  end
20847  for subcategory in xmlcollected(category,"/subcategory") do
20848   for example in xmlcollected(subcategory,"/example") do
20849    local command=xmltext(xmlfirst(example,"/command"))
20850    local comment=xmltext(xmlfirst(example,"/comment"))
20851    report(command)
20852   end
20853   report()
20854  end
20855 end
20856 for comment in xmlcollected(root,"/application/comments/comment") do
20857  local comment=xmltext(comment)
20858  report()
20859  report(comment)
20860  report()
20861 end
20862end
20863local reporthelp=reporters.help
20864local exporthelp=reporters.export
20865local function xmlfound(t)
20866 local helpinfo=t.helpinfo
20867 if type(helpinfo)=="table" then
20868  return false
20869 end
20870 if type(helpinfo)~="string" then
20871  helpinfo="Warning: no helpinfo found."
20872  t.helpinfo=helpinfo
20873  return false
20874 end
20875 if string.find(helpinfo,".xml$") then
20876  local ownscript=environment.ownscript
20877  local helpdata=false
20878  if ownscript then
20879   local helpfile=file.join(file.pathpart(ownscript),helpinfo)
20880   helpdata=io.loaddata(helpfile)
20881   if helpdata=="" then
20882    helpdata=false
20883   end
20884  end
20885  if not helpdata then
20886   local helpfile=resolvers.findfile(helpinfo,"tex")
20887   helpdata=helpfile and io.loaddata(helpfile)
20888  end
20889  if helpdata and helpdata~="" then
20890   helpinfo=helpdata
20891  else
20892   helpinfo=formatters["Warning: help file %a is not found."](helpinfo)
20893  end
20894 end
20895 t.helpinfo=helpinfo
20896 return string.find(t.helpinfo,"^<%?xml") and true or false
20897end
20898function reporters.help(t,...)
20899 if xmlfound(t) then
20900  showhelp(t,...)
20901 else
20902  reporthelp(t,...)
20903 end
20904end
20905function reporters.export(t,methods,filename)
20906 if not xmlfound(t) then
20907  return exporthelp(t)
20908 end
20909 if not methods or methods=="" then
20910  methods=environment.arguments["exporthelp"]
20911 end
20912 if not filename or filename=="" then
20913  filename=environment.files[1]
20914 end
20915 dofile(resolvers.findfile("trac-exp.lua","tex"))
20916 local exporters=logs.exporters
20917 if not exporters or not methods then
20918  return exporthelp(t)
20919 end
20920 if methods=="all" then
20921  methods=table.keys(exporters)
20922 elseif type(methods)=="string" then
20923  methods=utilities.parsers.settings_to_array(methods)
20924 else
20925  return exporthelp(t)
20926 end
20927 if type(filename)~="string" or filename=="" then
20928  filename=false
20929 elseif file.pathpart(filename)=="" then
20930  t.report("export file %a will not be saved on the current path (safeguard)",filename)
20931  return
20932 end
20933 for i=1,#methods do
20934  local method=methods[i]
20935  local exporter=exporters[method]
20936  if exporter then
20937   local result=exporter(t,method)
20938   if result and result~="" then
20939    if filename then
20940     local fullname=file.replacesuffix(filename,method)
20941     t.report("saving export in %a",fullname)
20942     dir.mkdirs(file.pathpart(fullname))
20943     io.savedata(fullname,result)
20944    else
20945     reporters.lines(t,result)
20946    end
20947   else
20948    t.report("no output from exporter %a",method)
20949   end
20950  else
20951   t.report("unknown exporter %a",method)
20952  end
20953 end
20954end
20955
20956
20957end -- of closure
20958
20959do -- create closure to overcome 200 locals limit
20960
20961package.loaded["data-ini"] = package.loaded["data-ini"] or true
20962
20963-- original size: 10636, stripped down to: 7049
20964
20965if not modules then modules={} end modules ['data-ini']={
20966 version=1.001,
20967 comment="companion to luat-lib.mkiv",
20968 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
20969 copyright="PRAGMA ADE / ConTeXt Development Team",
20970 license="see context related readme files",
20971}
20972local next,type,getmetatable,rawset=next,type,getmetatable,rawset
20973local gsub,find,gmatch,char=string.gsub,string.find,string.gmatch,string.char
20974local filedirname,filebasename,filejoin,replacesuffix=file.dirname,file.basename,file.join,file.replacesuffix
20975local ostype,osname,osuname,ossetenv,osgetenv=os.type,os.name,os.uname,os.setenv,os.getenv
20976local sortedpairs=table.sortedpairs
20977local isfile,currentdir=lfs.isfile,lfs.currentdir
20978local expandlink=dir.expandlink
20979local P,S,R,C,Cs,Cc,lpegmatch=lpeg.P,lpeg.S,lpeg.R,lpeg.C,lpeg.Cs,lpeg.Cc,lpeg.match
20980local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
20981local trace_expansions=false  trackers.register("resolvers.expansions",function(v) trace_expansions=v end)
20982local report_initialization=logs.reporter("resolvers","initialization")
20983resolvers=resolvers or {}
20984local resolvers=resolvers
20985texconfig.kpse_init=false
20986texconfig.shell_escape='t'
20987if not (environment and environment.default_texmfcnf) and kpse and kpse.default_texmfcnf then
20988 local default_texmfcnf=kpse.default_texmfcnf()
20989 default_texmfcnf=gsub(default_texmfcnf,"$SELFAUTOLOC","selfautoloc:")
20990 default_texmfcnf=gsub(default_texmfcnf,"$SELFAUTODIR","selfautodir:")
20991 default_texmfcnf=gsub(default_texmfcnf,"$SELFAUTOPARENT","selfautoparent:")
20992 default_texmfcnf=gsub(default_texmfcnf,"$HOME","home:")
20993 environment.default_texmfcnf=default_texmfcnf
20994end
20995kpse={ original=kpse }
20996setmetatable(kpse,{
20997 __index=function(kp,name)
20998  report_initialization("fatal error: kpse library is accessed (key: %s)",name)
20999  os.exit()
21000 end
21001} )
21002do
21003 local osfontdir=osgetenv("OSFONTDIR")
21004 if osfontdir and osfontdir~="" then
21005 elseif osname=="windows" then
21006  ossetenv("OSFONTDIR","c:/windows/fonts//")
21007 elseif osname=="macosx" then
21008  ossetenv("OSFONTDIR","$HOME/Library/Fonts//;/Library/Fonts//;/System/Library/Fonts//")
21009 end
21010end
21011if not environment.homedir then
21012 local oldhome=osgetenv('HOME')
21013 local homedir=osgetenv(ostype=="windows" and 'USERPROFILE' or 'HOME') or ''
21014 if not homedir or homedir=="" then
21015  homedir=char(127) 
21016 end
21017 homedir=file.collapsepath(homedir)
21018 ossetenv("HOME",homedir) 
21019 ossetenv("USERPROFILE",homedir) 
21020 environment.oldhome=oldhome
21021 environment.homedir=homedir
21022end
21023do
21024 local args=environment.originalarguments or arg 
21025 if not environment.ownmain then
21026  environment.ownmain=status and string.match(string.lower(status.banner),"this is ([%a]+)") or "luatex"
21027 end
21028 local ownbin=environment.ownbin  or os.selfbin or args[-2] or arg[-2] or args[-1] or arg[-1] or arg[0] or "luametatex"
21029 local ownpath=environment.ownpath or os.selfdir
21030 ownbin=file.collapsepath(ownbin)   
21031 ownpath=file.collapsepath(ownpath)
21032 ownpath=expandlink(ownpath,trace_locating and report_initialization)
21033 if not ownpath or ownpath=="" or ownpath=="unset" then
21034  ownpath=args[-1] or arg[-1]
21035  ownpath=ownpath and filedirname(gsub(ownpath,"\\","/"))
21036  if not ownpath or ownpath=="" then
21037   ownpath=args[-0] or arg[-0]
21038   ownpath=ownpath and filedirname(gsub(ownpath,"\\","/"))
21039  end
21040  local binary=ownbin
21041  if not ownpath or ownpath=="" then
21042   ownpath=ownpath and filedirname(binary)
21043  end
21044  if not ownpath or ownpath=="" then
21045   if os.binsuffix~="" then
21046    binary=replacesuffix(binary,os.binsuffix)
21047   end
21048   local path=osgetenv("PATH")
21049   if path then
21050    for p in gmatch(path,"[^"..io.pathseparator.."]+") do
21051     local b=filejoin(p,binary)
21052     if isfile(b) then
21053      ownpath=expandlink(p,trace_locating and report_initialization)
21054      break
21055     end
21056    end
21057   end
21058  end
21059  if not ownpath or ownpath=="" then
21060   ownpath="."
21061   report_initialization("forcing fallback to ownpath %a",ownpath)
21062  elseif trace_locating then
21063   report_initialization("using ownpath %a",ownpath)
21064  end
21065 end
21066 environment.ownbin=ownbin
21067 environment.ownpath=ownpath
21068end
21069resolvers.ownpath=environment.ownpath
21070function resolvers.getownpath()
21071 return environment.ownpath
21072end
21073do
21074 local ownpath=environment.ownpath or dir.current()
21075 if ownpath then
21076  ossetenv('SELFAUTOLOC',file.collapsepath(ownpath))
21077  ossetenv('SELFAUTODIR',file.collapsepath(ownpath.."/.."))
21078  ossetenv('SELFAUTOPARENT',file.collapsepath(ownpath.."/../.."))
21079 else
21080  report_initialization("error: unable to locate ownpath")
21081  os.exit()
21082 end
21083end
21084local texos=environment.texos   or osgetenv("TEXOS")
21085local texmfos=environment.texmfos or osgetenv('SELFAUTODIR')
21086if not texos or texos=="" then
21087 texos=file.basename(texmfos)
21088end
21089ossetenv('TEXMFOS',texmfos)   
21090ossetenv('TEXOS',texos)  
21091ossetenv('SELFAUTOSYSTEM',os.platform)  
21092environment.texos=texos
21093environment.texmfos=texmfos
21094local texroot=environment.texroot or osgetenv("TEXROOT")
21095if not texroot or texroot=="" then
21096 texroot=osgetenv('SELFAUTOPARENT')
21097 ossetenv('TEXROOT',texroot)
21098end
21099environment.texroot=file.collapsepath(texroot)
21100local prefixes=utilities.storage.allocate()
21101resolvers.prefixes=prefixes
21102local resolved={}
21103local abstract={}
21104local dynamic={}
21105function resolvers.resetresolve(str)
21106 resolved,abstract={},{}
21107end
21108function resolvers.allprefixes(separator)
21109 local all=table.sortedkeys(prefixes)
21110 if separator then
21111  for i=1,#all do
21112   all[i]=all[i]..":"
21113  end
21114 end
21115 return all
21116end
21117local function _resolve_(method,target)
21118 local action=prefixes[method]
21119 if action then
21120  return action(target)
21121 else
21122  return method..":"..target
21123 end
21124end
21125function resolvers.unresolve(str)
21126 return abstract[str] or str
21127end
21128function resolvers.setdynamic(str)
21129 dynamic[str]=true
21130end
21131local pattern=Cs((C(R("az")^2)*P(":")*C((1-S(" \"\';,"))^1)/_resolve_+P(1))^0)
21132local prefix=C(R("az")^2)*P(":")
21133local target=C((1-S(" \"\';,"))^1)
21134local notarget=(#S(";,")+P(-1))*Cc("")
21135local p_resolve=Cs(((prefix*(target+notarget))/_resolve_+P(1))^0)
21136local p_simple=prefix*P(-1)
21137local function resolve(str) 
21138 if type(str)=="table" then
21139  local res={}
21140  for i=1,#str do
21141   res[i]=resolve(str[i])
21142  end
21143  return res
21144 end
21145 local res=resolved[str]
21146 if res then
21147  return res
21148 end
21149 local simple=lpegmatch(p_simple,str)
21150 local action=prefixes[simple]
21151 if action then
21152  local res=action(res)
21153  if not dynamic[simple] then
21154   resolved[simple]=res
21155   abstract[res]=simple
21156  end
21157  return res
21158 end
21159 res=lpegmatch(p_resolve,str)
21160 resolved[str]=res
21161 abstract[res]=str
21162 return res
21163end
21164resolvers.resolve=resolve
21165if type(osuname)=="function" then
21166 for k,v in next,osuname() do
21167  if not prefixes[k] then
21168   prefixes[k]=function() return v end
21169  end
21170 end
21171end
21172if ostype=="unix" then
21173 local pattern
21174 local function makepattern(t,k,v)
21175  if t then
21176   rawset(t,k,v)
21177  end
21178  local colon=P(":")
21179  for k,v in sortedpairs(prefixes) do
21180   if p then
21181    p=P(k)+p
21182   else
21183    p=P(k)
21184   end
21185  end
21186  pattern=Cs((p*colon+colon/";"+P(1))^0)
21187 end
21188 makepattern()
21189 table.setmetatablenewindex(prefixes,makepattern)
21190 function resolvers.repath(str)
21191  return lpegmatch(pattern,str)
21192 end
21193else 
21194 function resolvers.repath(str)
21195  return str
21196 end
21197end
21198
21199
21200end -- of closure
21201
21202do -- create closure to overcome 200 locals limit
21203
21204package.loaded["data-exp"] = package.loaded["data-exp"] or true
21205
21206-- original size: 18185, stripped down to: 10438
21207
21208if not modules then modules={} end modules ['data-exp']={
21209 version=1.001,
21210 comment="companion to luat-lib.mkiv",
21211 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
21212 copyright="PRAGMA ADE / ConTeXt Development Team",
21213 license="see context related readme files",
21214}
21215local format,find,gmatch,lower,char,sub=string.format,string.find,string.gmatch,string.lower,string.char,string.sub
21216local concat,sort=table.concat,table.sort
21217local sortedkeys=table.sortedkeys
21218local lpegmatch,lpegpatterns=lpeg.match,lpeg.patterns
21219local Ct,Cs,Cc,Carg,P,C,S=lpeg.Ct,lpeg.Cs,lpeg.Cc,lpeg.Carg,lpeg.P,lpeg.C,lpeg.S
21220local type,next=type,next
21221local isdir=lfs.isdir
21222local collapsepath,joinpath,basename=file.collapsepath,file.join,file.basename
21223local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
21224local trace_expansions=false  trackers.register("resolvers.expansions",function(v) trace_expansions=v end)
21225local trace_globbing=true   trackers.register("resolvers.globbing",function(v) trace_globbing=v end)
21226local report_expansions=logs.reporter("resolvers","expansions")
21227local report_globbing=logs.reporter("resolvers","globbing")
21228local resolvers=resolvers
21229local resolveprefix=resolvers.resolve
21230local function f_both(a,b)
21231 local t,n={},0
21232 for sb in gmatch(b,"[^,]+") do     
21233  for sa in gmatch(a,"[^,]+") do    
21234   n=n+1;t[n]=sa..sb
21235  end
21236 end
21237 return concat(t,",")
21238end
21239local comma=P(",")
21240local nocomma=(1-comma)^1
21241local docomma=comma^1/","
21242local before=Cs((nocomma*Carg(1)+docomma)^0)
21243local after=Cs((Carg(1)*nocomma+docomma)^0)
21244local both=Cs(((C(nocomma)*Carg(1))/function(a,b) return lpegmatch(before,b,1,a) end+docomma)^0)
21245local function f_first (a,b) return lpegmatch(after,b,1,a) end
21246local function f_second(a,b) return lpegmatch(before,a,1,b) end
21247local function f_both  (a,b) return lpegmatch(both,b,1,a) end
21248local left=P("{")
21249local right=P("}")
21250local var=P((1-S("{}" ))^0)
21251local set=P((1-S("{},"))^0)
21252local other=P(1)
21253local l_first=Cs((Cc("{")*(C(set)*left*C(var)*right/f_first)*Cc("}")+other )^0 )
21254local l_second=Cs((Cc("{")*(left*C(var)*right*C(set)/f_second)*Cc("}")+other )^0 )
21255local l_both=Cs((Cc("{")*(left*C(var)*right*left*C(var)*right/f_both)*Cc("}")+other )^0 )
21256local l_rest=Cs((left*var*(left/"")*var*(right/"")*var*right+other )^0 )
21257local stripper_1=lpeg.stripper ("{}@")
21258local replacer_1=lpeg.replacer { { ",}",",@}" },{ "{,","{@," },}
21259local function splitpathexpr(str,newlist,validate) 
21260 if trace_expansions then
21261  report_expansions("expanding variable %a",str)
21262 end
21263 local t,ok,done=newlist or {},false,false
21264 local n=#t
21265 str=lpegmatch(replacer_1,str)
21266 repeat
21267  local old=str
21268  repeat
21269   local old=str
21270   str=lpegmatch(l_first,str)
21271  until old==str
21272  repeat
21273   local old=str
21274   str=lpegmatch(l_second,str)
21275  until old==str
21276  repeat
21277   local old=str
21278   str=lpegmatch(l_both,str)
21279  until old==str
21280  repeat
21281   local old=str
21282   str=lpegmatch(l_rest,str)
21283  until old==str
21284 until old==str 
21285 str=lpegmatch(stripper_1,str)
21286 if validate then
21287  for s in gmatch(str,"[^,]+") do
21288   local v=validate(s)
21289   if v then
21290    n=n+1
21291    t[n]=v
21292   end
21293  end
21294 else
21295  for s in gmatch(str,"[^,]+") do
21296   n=n+1
21297   t[n]=s
21298  end
21299 end
21300 if trace_expansions then
21301  for k=1,#t do
21302   report_expansions("% 4i: %s",k,t[k])
21303  end
21304 end
21305 return t
21306end
21307local function validate(s)
21308 s=collapsepath(s) 
21309 return s~="" and not find(s,"^!*unset/*$") and s
21310end
21311resolvers.validatedpath=validate 
21312function resolvers.expandedpathfromlist(pathlist)
21313 local newlist={}
21314 for k=1,#pathlist do
21315  splitpathexpr(pathlist[k],newlist,validate)
21316 end
21317 return newlist
21318end
21319local usedhomedir=nil
21320local donegation=(P("!")/""  )^0
21321local doslashes=(P("\\")/"/"+1)^0
21322local function expandedhome()
21323 if not usedhomedir then
21324  usedhomedir=lpegmatch(Cs(donegation*doslashes),environment.homedir or "")
21325  if usedhomedir=="~" or usedhomedir=="" or not isdir(usedhomedir) then
21326   if trace_expansions then
21327    report_expansions("no home dir set, ignoring dependent path using current path")
21328   end
21329   usedhomedir="."
21330  end
21331 end
21332 return usedhomedir
21333end
21334local dohome=((P("~")+P("$HOME")+P("%HOME%"))/expandedhome)^0
21335local cleanup=Cs(donegation*dohome*doslashes)
21336resolvers.cleanpath=function(str)
21337 return str and lpegmatch(cleanup,str) or ""
21338end
21339local expandhome=P("~")/"$HOME"
21340local dodouble=P('"')/""*(expandhome+(1-P('"')))^0*P('"')/""
21341local dosingle=P("'")/""*(expandhome+(1-P("'")))^0*P("'")/""
21342local dostring=(expandhome+1     )^0
21343local stripper=Cs(
21344 lpegpatterns.unspacer*(dosingle+dodouble+dostring)*lpegpatterns.unspacer
21345)
21346function resolvers.checkedvariable(str) 
21347 return type(str)=="string" and lpegmatch(stripper,str) or str
21348end
21349local cache={}
21350local splitter=lpeg.tsplitat(";") 
21351local backslashswapper=lpeg.replacer("\\","/")
21352local function splitconfigurationpath(str) 
21353 if str then
21354  local found=cache[str]
21355  if not found then
21356   if str=="" then
21357    found={}
21358   else
21359    local split=lpegmatch(splitter,lpegmatch(backslashswapper,str)) 
21360    found={}
21361    local noffound=0
21362    for i=1,#split do
21363     local s=split[i]
21364     if not find(s,"^{*unset}*") then
21365      noffound=noffound+1
21366      found[noffound]=s
21367     end
21368    end
21369    if trace_expansions then
21370     report_expansions("splitting path specification %a",str)
21371     for k=1,noffound do
21372      report_expansions("% 4i: %s",k,found[k])
21373     end
21374    end
21375    cache[str]=found
21376   end
21377  end
21378  return found
21379 end
21380end
21381resolvers.splitconfigurationpath=splitconfigurationpath
21382function resolvers.splitpath(str)
21383 if type(str)=='table' then
21384  return str
21385 else
21386  return splitconfigurationpath(str)
21387 end
21388end
21389function resolvers.joinpath(str)
21390 if type(str)=='table' then
21391  return joinpath(str)
21392 else
21393  return str
21394 end
21395end
21396local attributes,directory=lfs.attributes,lfs.dir
21397local weird=P(".")^1+lpeg.anywhere(S("~`!#$%^&*()={}[]:;\"\'||<>,?\n\r\t"))
21398local lessweird=P(".")^1+lpeg.anywhere(S("~`#$%^&*:;\"\'||<>,?\n\r\t"))
21399local timer={}
21400local scanned={}
21401local nofscans=0
21402local scancache={}
21403local fullcache={}
21404local nofsharedscans=0
21405local addcasecraptoo=true
21406local function scan(files,remap,spec,path,n,m,r,onlyone,tolerant)
21407 local full=path=="" and spec or (spec..path..'/')
21408 local dirlist={}
21409 local nofdirs=0
21410 local pattern=tolerant and lessweird or weird
21411 local filelist={}
21412 local noffiles=0
21413 for name,mode in directory(full) do
21414  if not lpegmatch(pattern,name) then
21415   if not mode then
21416    mode=attributes(full..name,"mode")
21417   end
21418   if mode=="file" then
21419    n=n+1
21420    noffiles=noffiles+1
21421    filelist[noffiles]=name
21422   elseif mode=="directory" then
21423    m=m+1
21424    nofdirs=nofdirs+1
21425    if path~="" then
21426     dirlist[nofdirs]=path.."/"..name
21427    else
21428     dirlist[nofdirs]=name
21429    end
21430   end
21431  end
21432 end
21433 if noffiles>0 then
21434  sort(filelist)
21435  for i=1,noffiles do
21436   local name=filelist[i]
21437   local lower=lower(name)
21438   local paths=files[lower]
21439   if paths then
21440    if onlyone then
21441    else
21442     if name~=lower then
21443      local rl=remap[lower]
21444      if not rl then
21445       remap[lower]=name
21446       r=r+1
21447      elseif trace_globbing and rl~=name then
21448       report_globbing("confusing filename, name: %a, lower: %a, already: %a",name,lower,rl)
21449      end
21450      if addcasecraptoo then
21451       local paths=files[name]
21452       if not paths then
21453        files[name]=path
21454       elseif type(paths)=="string" then
21455        files[name]={ paths,path }
21456       else
21457        paths[#paths+1]=path
21458       end
21459      end
21460     end
21461     if type(paths)=="string" then
21462      files[lower]={ paths,path }
21463     else
21464      paths[#paths+1]=path
21465     end
21466    end
21467   else 
21468    files[lower]=path
21469    if name~=lower then
21470     local rl=remap[lower]
21471     if not rl then
21472      remap[lower]=name
21473      r=r+1
21474     elseif trace_globbing and rl~=name then
21475      report_globbing("confusing filename, name: %a, lower: %a, already: %a",name,lower,rl)
21476     end
21477    end
21478   end
21479  end
21480 end
21481 if nofdirs>0 then
21482  sort(dirlist)
21483  for i=1,nofdirs do
21484   files,remap,n,m,r=scan(files,remap,spec,dirlist[i],n,m,r,onlyonce,tolerant)
21485  end
21486 end
21487 scancache[sub(full,1,-2)]=files
21488 return files,remap,n,m,r
21489end
21490local function scanfiles(path,branch,usecache,onlyonce,tolerant)
21491 local realpath=resolveprefix(path)
21492 if usecache then
21493  local content=fullcache[realpath]
21494  if content then
21495   if trace_locating then
21496    report_expansions("using cached scan of path %a, branch %a",path,branch or path)
21497   end
21498   nofsharedscans=nofsharedscans+1
21499   return content
21500  end
21501 end
21502 statistics.starttiming(timer)
21503 if trace_locating then
21504  report_expansions("scanning path %a, branch %a",path,branch or path)
21505 end
21506 local content
21507 if isdir(realpath) then
21508  local files,remap,n,m,r=scan({},{},realpath..'/',"",0,0,0,onlyonce,tolerant)
21509  content={
21510   metadata={
21511    path=path,
21512    files=n,
21513    directories=m,
21514    remappings=r,
21515   },
21516   files=files,
21517   remap=remap,
21518  }
21519  if trace_locating then
21520   report_expansions("%s files found on %s directories with %s uppercase remappings",n,m,r)
21521  end
21522 else
21523  content={
21524   metadata={
21525    path=path,
21526    files=0,
21527    directories=0,
21528    remappings=0,
21529   },
21530   files={},
21531   remap={},
21532  }
21533  if trace_locating then
21534   report_expansions("invalid path %a",realpath)
21535  end
21536 end
21537 if usecache then
21538  scanned[#scanned+1]=realpath
21539  fullcache[realpath]=content
21540 end
21541 nofscans=nofscans+1
21542 statistics.stoptiming(timer)
21543 return content
21544end
21545resolvers.scanfiles=scanfiles
21546function resolvers.simplescanfiles(path,branch,usecache)
21547 return scanfiles(path,branch,usecache,true,true) 
21548end
21549function resolvers.scandata()
21550 table.sort(scanned)
21551 return {
21552  n=nofscans,
21553  shared=nofsharedscans,
21554  time=statistics.elapsedtime(timer),
21555  paths=scanned,
21556 }
21557end
21558function resolvers.get_from_content(content,path,name) 
21559 if not content then
21560  return
21561 end
21562 local files=content.files
21563 if not files then
21564  return
21565 end
21566 local remap=content.remap
21567 if not remap then
21568  return
21569 end
21570 if name then
21571  local used=lower(name)
21572  return path,remap[used] or used
21573 else
21574  local name=path
21575  local used=lower(name)
21576  local path=files[used]
21577  if path then
21578   return path,remap[used] or used
21579  end
21580 end
21581end
21582local nothing=function() end
21583function resolvers.filtered_from_content(content,pattern)
21584 if content and type(pattern)=="string" then
21585  local pattern=lower(pattern)
21586  local files=content.files 
21587  local remap=content.remap
21588  if files and remap then
21589   local f=sortedkeys(files)
21590   local n=#f
21591   local i=0
21592   local function iterator()
21593    while i<n do
21594     i=i+1
21595     local k=f[i]
21596     if find(k,pattern) then
21597      return files[k],remap and remap[k] or k
21598     end
21599    end
21600   end
21601   return iterator
21602  end
21603 end
21604 return nothing
21605end
21606
21607
21608end -- of closure
21609
21610do -- create closure to overcome 200 locals limit
21611
21612package.loaded["data-env"] = package.loaded["data-env"] or true
21613
21614-- original size: 9758, stripped down to: 6523
21615
21616if not modules then modules={} end modules ['data-env']={
21617 version=1.001,
21618 comment="companion to luat-lib.mkiv",
21619 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
21620 copyright="PRAGMA ADE / ConTeXt Development Team",
21621 license="see context related readme files",
21622}
21623local lower,gsub=string.lower,string.gsub
21624local next,rawget=next,rawget
21625local resolvers=resolvers
21626local allocate=utilities.storage.allocate
21627local setmetatableindex=table.setmetatableindex
21628local sortedhash=table.sortedhash
21629local suffixonly=file.suffixonly
21630local formats=allocate()
21631local suffixes=allocate()
21632local dangerous=allocate()
21633local suffixmap=allocate()
21634local usertypes=allocate()
21635resolvers.formats=formats
21636resolvers.suffixes=suffixes
21637resolvers.dangerous=dangerous
21638resolvers.suffixmap=suffixmap
21639resolvers.usertypes=usertypes
21640local luasuffixes=utilities.lua.suffixes
21641local relations=allocate { 
21642 core={
21643  ofm={ 
21644   names={ "ofm","omega font metric","omega font metrics" },
21645   variable='OFMFONTS',
21646   suffixes={ 'ofm','tfm' },
21647  },
21648  ovf={ 
21649   names={ "ovf","omega virtual font","omega virtual fonts" },
21650   variable='OVFFONTS',
21651   suffixes={ 'ovf','vf' },
21652  },
21653  tfm={
21654   names={ "tfm","tex font metric","tex font metrics" },
21655   variable='TFMFONTS',
21656   suffixes={ 'tfm' },
21657  },
21658  vf={
21659   names={ "vf","virtual font","virtual fonts" },
21660   variable='VFFONTS',
21661   suffixes={ 'vf' },
21662  },
21663  otf={
21664   names={ "otf","opentype","opentype font","opentype fonts"},
21665   variable='OPENTYPEFONTS',
21666   suffixes={ 'otf' },
21667  },
21668  ttf={
21669   names={ "ttf","truetype","truetype font","truetype fonts","truetype collection","truetype collections","truetype dictionary","truetype dictionaries" },
21670   variable='TTFONTS',
21671   suffixes={ 'ttf','ttc','dfont' },
21672  },
21673  afm={
21674   names={ "afm","adobe font metric","adobe font metrics" },
21675   variable="AFMFONTS",
21676   suffixes={ "afm" },
21677  },
21678  pfb={
21679   names={ "pfb","type1","type 1","type1 font","type 1 font","type1 fonts","type 1 fonts" },
21680   variable='T1FONTS',
21681   suffixes={ 'pfb','pfa' },
21682  },
21683  fea={
21684   names={ "fea","font feature","font features","font feature file","font feature files" },
21685   variable='FONTFEATURES',
21686   suffixes={ 'fea' },
21687  },
21688  cid={
21689   names={ "cid","cid map","cid maps","cid file","cid files" },
21690   variable='FONTCIDMAPS',
21691   suffixes={ 'cid','cidmap' },
21692  },
21693  fmt={
21694   names={ "fmt","format","tex format" },
21695   variable='TEXFORMATS',
21696   suffixes={ 'fmt' },
21697  },
21698  mem={ 
21699   names={ 'mem',"metapost format" },
21700   variable='MPMEMS',
21701   suffixes={ 'mem' },
21702  },
21703  mp={
21704   names={ "mp" },
21705   variable='MPINPUTS',
21706   suffixes=CONTEXTLMTXMODE>0
21707    and { 'mpxl','mpvi','mpiv','mpii','mp' }
21708    or  {   'mpvi','mpiv','mpii','mp' },
21709   usertype=true,
21710  },
21711  tex={
21712   names={ "tex" },
21713   variable='TEXINPUTS',
21714   suffixes={ "tex","mkiv","mkvi","mkxl","mklx","mkii","cld","lfg","xml" },
21715   usertype=true,
21716  },
21717  icc={
21718   names={ "icc","icc profile","icc profiles" },
21719   variable='ICCPROFILES',
21720   suffixes={ 'icc' },
21721  },
21722  texmfscripts={
21723   names={ "texmfscript","texmfscripts","script","scripts" },
21724   variable='TEXMFSCRIPTS',
21725   suffixes={ 'lua','rb','pl','py' },
21726  },
21727  lua={
21728   names={ "lua" },
21729   variable='LUAINPUTS',
21730   suffixes={ luasuffixes.lmt,luasuffixes.lua,luasuffixes.luc,luasuffixes.tma,luasuffixes.tmc },
21731   usertype=true,
21732  },
21733  lib={
21734   names={ "lib" },
21735   variable='CLUAINPUTS',
21736   suffixes=os.libsuffix and { os.libsuffix } or { 'dll','so' },
21737  },
21738  bib={
21739   names={ 'bib' },
21740   variable='BIBINPUTS',
21741   suffixes={ 'bib' },
21742   usertype=true,
21743  },
21744  bst={
21745   names={ 'bst' },
21746   variable='BSTINPUTS',
21747   suffixes={ 'bst' },
21748   usertype=true,
21749  },
21750  fontconfig={
21751   names={ 'fontconfig','fontconfig file','fontconfig files' },
21752   variable='FONTCONFIG_PATH',
21753  },
21754  pk={
21755   names={ "pk" },
21756   variable='PKFONTS',
21757   suffixes={ 'pk' },
21758  },
21759 },
21760 obsolete={
21761  enc={
21762   names={ "enc","enc files","enc file","encoding files","encoding file" },
21763   variable='ENCFONTS',
21764   suffixes={ 'enc' },
21765  },
21766  map={
21767   names={ "map","map files","map file" },
21768   variable='TEXFONTMAPS',
21769   suffixes={ 'map' },
21770  },
21771  lig={
21772   names={ "lig files","lig file","ligature file","ligature files" },
21773   variable='LIGFONTS',
21774   suffixes={ 'lig' },
21775  },
21776  opl={
21777   names={ "opl" },
21778   variable='OPLFONTS',
21779   suffixes={ 'opl' },
21780  },
21781  ovp={
21782   names={ "ovp" },
21783   variable='OVPFONTS',
21784   suffixes={ 'ovp' },
21785  },
21786 },
21787 kpse={ 
21788  base={
21789   names={ 'base',"metafont format" },
21790   variable='MFBASES',
21791   suffixes={ 'base','bas' },
21792  },
21793  cmap={
21794   names={ 'cmap','cmap files','cmap file' },
21795   variable='CMAPFONTS',
21796   suffixes={ 'cmap' },
21797  },
21798  cnf={
21799   names={ 'cnf' },
21800   suffixes={ 'cnf' },
21801  },
21802  web={
21803   names={ 'web' },
21804   suffixes={ 'web','ch' }
21805  },
21806  cweb={
21807   names={ 'cweb' },
21808   suffixes={ 'w','web','ch' },
21809  },
21810  gf={
21811   names={ 'gf' },
21812   suffixes={ '<resolution>gf' },
21813  },
21814  mf={
21815   names={ 'mf' },
21816   variable='MFINPUTS',
21817   suffixes={ 'mf' },
21818  },
21819  mft={
21820   names={ 'mft' },
21821   suffixes={ 'mft' },
21822  },
21823  pk={
21824   names={ 'pk' },
21825   suffixes={ '<resolution>pk' },
21826  },
21827 },
21828}
21829resolvers.relations=relations
21830function resolvers.updaterelations()
21831 for category,categories in sortedhash(relations) do
21832  for name,relation in sortedhash(categories) do
21833   local rn=relation.names
21834   local rv=relation.variable
21835   if rn and rv then
21836    local rs=relation.suffixes
21837    local ru=relation.usertype
21838    for i=1,#rn do
21839     local rni=lower(gsub(rn[i]," ",""))
21840     formats[rni]=rv
21841     if rs then
21842      suffixes[rni]=rs
21843      for i=1,#rs do
21844       local rsi=rs[i]
21845       if not suffixmap[rsi] then
21846        suffixmap[rsi]=rni
21847       end
21848      end
21849     end
21850    end
21851    if ru then
21852     usertypes[name]=true
21853    end
21854   end
21855  end
21856 end
21857end
21858resolvers.updaterelations() 
21859local function simplified(t,k)
21860 return k and rawget(t,lower(gsub(k," ",""))) or nil
21861end
21862setmetatableindex(formats,simplified)
21863setmetatableindex(suffixes,simplified)
21864setmetatableindex(suffixmap,simplified)
21865function resolvers.suffixofformat(str)
21866 local s=suffixes[str]
21867 return s and s[1] or ""
21868end
21869function resolvers.suffixofformat(str)
21870 return suffixes[str] or {}
21871end
21872for name,format in next,formats do
21873 dangerous[name]=true 
21874end
21875dangerous.tex=nil
21876function resolvers.formatofvariable(str)
21877 return formats[str] or ''
21878end
21879function resolvers.formatofsuffix(str) 
21880 return suffixmap[suffixonly(str)] or 'tex' 
21881end
21882function resolvers.variableofformat(str)
21883 return formats[str] or ''
21884end
21885function resolvers.variableofformatorsuffix(str)
21886 local v=formats[str]
21887 if v then
21888  return v
21889 end
21890 v=suffixmap[suffixonly(str)]
21891 if v then
21892  return formats[v]
21893 end
21894 return ''
21895end
21896
21897
21898end -- of closure
21899
21900do -- create closure to overcome 200 locals limit
21901
21902package.loaded["data-tmp"] = package.loaded["data-tmp"] or true
21903
21904-- original size: 16433, stripped down to: 11636
21905
21906if not modules then modules={} end modules ['data-tmp']={
21907 version=1.100,
21908 comment="companion to luat-lib.mkiv",
21909 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
21910 copyright="PRAGMA ADE / ConTeXt Development Team",
21911 license="see context related readme files"
21912}
21913local next,type=next,type
21914local pcall,loadfile,collectgarbage=pcall,loadfile,collectgarbage
21915local format,lower,gsub=string.format,string.lower,string.gsub
21916local concat,serialize,fastserialize,serializetofile=table.concat,table.serialize,table.fastserialize,table.tofile
21917local mkdirs,expanddirname,isdir,isfile=dir.mkdirs,dir.expandname,lfs.isdir,lfs.isfile
21918local is_writable,is_readable=file.is_writable,file.is_readable
21919local collapsepath,joinfile,addsuffix,dirname=file.collapsepath,file.join,file.addsuffix,file.dirname
21920local savedata=file.savedata
21921local formatters=string.formatters
21922local osexit,osdate,osuuid=os.exit,os.date,os.uuid
21923local removefile=os.remove
21924local md5hex=md5.hex
21925local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
21926local trace_cache=false  trackers.register("resolvers.cache",function(v) trace_cache=v end)
21927local report_caches=logs.reporter("resolvers","caches")
21928local report_resolvers=logs.reporter("resolvers","caching")
21929local resolvers=resolvers
21930local cleanpath=resolvers.cleanpath
21931local resolvepath=resolvers.resolve
21932local luautilities=utilities.lua
21933do
21934 local directive_cleanup=false  directives.register("system.compile.cleanup",function(v) directive_cleanup=v end)
21935 local directive_strip=false  directives.register("system.compile.strip",function(v) directive_strip=v end)
21936 local compilelua=luautilities.compile
21937 function luautilities.compile(luafile,lucfile,cleanup,strip)
21938  if cleanup==nil then cleanup=directive_cleanup end
21939  if strip==nil then strip=directive_strip   end
21940  return compilelua(luafile,lucfile,cleanup,strip)
21941 end
21942end
21943caches=caches or {}
21944local caches=caches
21945local writable=nil
21946local readables={}
21947local usedreadables={}
21948local compilelua=luautilities.compile
21949local luasuffixes=luautilities.suffixes
21950caches.base=caches.base or (LUATEXENGINE and LUATEXENGINE.."-cache") or "luatex-cache"  
21951caches.more=caches.more or "context"    
21952caches.defaults={ "TMPDIR","TEMPDIR","TMP","TEMP","HOME","HOMEPATH" }
21953local direct_cache=false 
21954local fast_cache=false
21955local cache_tree=false
21956directives.register("system.caches.direct",function(v) direct_cache=true end)
21957directives.register("system.caches.fast",function(v) fast_cache=true end)
21958local function configfiles()
21959 return concat(resolvers.configurationfiles(),";")
21960end
21961local function hashed(tree)
21962 tree=gsub(tree,"[\\/]+$","")
21963 tree=lower(tree)
21964 local hash=md5hex(tree)
21965 if trace_cache or trace_locating then
21966  report_caches("hashing tree %a, hash %a",tree,hash)
21967 end
21968 return hash
21969end
21970local function treehash()
21971 local tree=configfiles()
21972 if not tree or tree=="" then
21973  return false
21974 else
21975  return hashed(tree)
21976 end
21977end
21978caches.hashed=hashed
21979caches.treehash=treehash
21980caches.configfiles=configfiles
21981local function identify()
21982 local texmfcaches=resolvers.cleanpathlist("TEXMFCACHE") 
21983 if texmfcaches then
21984  for k=1,#texmfcaches do
21985   local cachepath=texmfcaches[k]
21986   if cachepath~="" then
21987    cachepath=resolvepath(cachepath)
21988    cachepath=cleanpath(cachepath)
21989    cachepath=collapsepath(cachepath)
21990    local valid=isdir(cachepath)
21991    if valid then
21992     if is_readable(cachepath) then
21993      readables[#readables+1]=cachepath
21994      if not writable and is_writable(cachepath) then
21995       writable=cachepath
21996      end
21997     end
21998    elseif not writable then
21999     local cacheparent=dirname(cachepath)
22000     if is_writable(cacheparent) then 
22001      mkdirs(cachepath)
22002      if isdir(cachepath) and is_writable(cachepath) then
22003       report_caches("path %a created",cachepath)
22004       writable=cachepath
22005       readables[#readables+1]=cachepath
22006      end
22007     end
22008    end
22009   end
22010  end
22011 end
22012 local texmfcaches=caches.defaults
22013 if texmfcaches then
22014  for k=1,#texmfcaches do
22015   local cachepath=texmfcaches[k]
22016   cachepath=resolvers.expansion(cachepath) 
22017   if cachepath~="" then
22018    cachepath=resolvepath(cachepath)
22019    cachepath=cleanpath(cachepath)
22020    local valid=isdir(cachepath)
22021    if valid and is_readable(cachepath) then
22022     if not writable and is_writable(cachepath) then
22023      readables[#readables+1]=cachepath
22024      writable=cachepath
22025      break
22026     end
22027    end
22028   end
22029  end
22030 end
22031 if not writable then
22032  report_caches("fatal error: there is no valid writable cache path defined")
22033  osexit()
22034 elseif #readables==0 then
22035  report_caches("fatal error: there is no valid readable cache path defined")
22036  osexit()
22037 end
22038 writable=expanddirname(cleanpath(writable))
22039 local base=caches.base
22040 local more=caches.more
22041 local tree=cache_tree or treehash() 
22042 if tree then
22043  cache_tree=tree
22044  writable=mkdirs(writable,base,more,tree)
22045  for i=1,#readables do
22046   readables[i]=joinfile(readables[i],base,more,tree)
22047  end
22048 else
22049  writable=mkdirs(writable,base,more)
22050  for i=1,#readables do
22051   readables[i]=joinfile(readables[i],base,more)
22052  end
22053 end
22054 if trace_cache then
22055  for i=1,#readables do
22056   report_caches("using readable path %a (order %s)",readables[i],i)
22057  end
22058  report_caches("using writable path %a",writable)
22059 end
22060 identify=function()
22061  return writable,readables
22062 end
22063 return writable,readables
22064end
22065function caches.usedpaths(separator)
22066 local writable,readables=identify()
22067 if #readables>1 then
22068  local result={}
22069  local done={}
22070  for i=1,#readables do
22071   local readable=readables[i]
22072   if readable==writable then
22073    done[readable]=true
22074    result[#result+1]=formatters["readable+writable: %a"](readable)
22075   elseif usedreadables[i] then
22076    done[readable]=true
22077    result[#result+1]=formatters["readable: %a"](readable)
22078   end
22079  end
22080  if not done[writable] then
22081   result[#result+1]=formatters["writable: %a"](writable)
22082  end
22083  return concat(result,separator or " | ")
22084 else
22085  return writable or "?"
22086 end
22087end
22088local r_cache={}
22089local w_cache={}
22090local function getreadablepaths(...)
22091 local tags={... }
22092 local hash=concat(tags,"/")
22093 local done=r_cache[hash]
22094 if not done then
22095  local writable,readables=identify() 
22096  if #tags>0 then
22097   done={}
22098   for i=1,#readables do
22099    done[i]=joinfile(readables[i],...)
22100   end
22101  else
22102   done=readables
22103  end
22104  r_cache[hash]=done
22105 end
22106 return done
22107end
22108local function getwritablepath(...)
22109 local tags={... }
22110 local hash=concat(tags,"/")
22111 local done=w_cache[hash]
22112 if not done then
22113  local writable,readables=identify() 
22114  if #tags>0 then
22115   done=mkdirs(writable,...)
22116  else
22117   done=writable
22118  end
22119  w_cache[hash]=done
22120 end
22121 return done
22122end
22123local function setfirstwritablefile(filename,...)
22124 local wr=getwritablepath(...)
22125 local fullname=joinfile(wr,filename)
22126 return fullname,wr
22127end
22128local function setluanames(path,name)
22129 return
22130  format("%s/%s.%s",path,name,luasuffixes.tma),
22131  format("%s/%s.%s",path,name,luasuffixes.tmc)
22132end
22133local function getfirstreadablefile(filename,...)
22134 local fullname,path=setfirstwritablefile(filename,...)
22135 if is_readable(fullname) then
22136  return fullname,path 
22137 end
22138 local rd=getreadablepaths(...)
22139 for i=1,#rd do
22140  local path=rd[i]
22141  local fullname=joinfile(path,filename)
22142  if is_readable(fullname) then
22143   usedreadables[i]=true
22144   return fullname,path 
22145  end
22146 end
22147 return fullname,path 
22148end
22149caches.getreadablepaths=getreadablepaths
22150caches.getwritablepath=getwritablepath
22151caches.setfirstwritablefile=setfirstwritablefile
22152caches.getfirstreadablefile=getfirstreadablefile
22153caches.setluanames=setluanames
22154local checkmemory=utilities and utilities.lua and utilities.lua.checkmemory
22155local threshold=100 
22156function caches.loaddata(readables,name,writable)
22157 local used=checkmemory and checkmemory()
22158 if type(readables)=="string" then
22159  readables={ readables }
22160 end
22161 for i=1,#readables do
22162  local path=readables[i]
22163  local loader=false
22164  local state=false
22165  local tmaname,tmcname=setluanames(path,name)
22166  if isfile(tmcname) then
22167   state,loader=pcall(loadfile,tmcname)
22168  end
22169  if not loader and isfile(tmaname) then
22170   local tmacrap,tmcname=setluanames(writable,name)
22171   if isfile(tmcname) then
22172    state,loader=pcall(loadfile,tmcname)
22173   end
22174   compilelua(tmaname,tmcname)
22175   if isfile(tmcname) then
22176    state,loader=pcall(loadfile,tmcname)
22177   end
22178   if not loader then
22179    state,loader=pcall(loadfile,tmaname)
22180   end
22181  end
22182  if loader then
22183   loader=loader()
22184   if checkmemory then
22185    checkmemory(used,threshold)
22186   else 
22187    collectgarbage("step") 
22188   end
22189   return loader
22190  end
22191 end
22192 return false
22193end
22194function caches.is_writable(filepath,filename)
22195 local tmaname,tmcname=setluanames(filepath,filename)
22196 return is_writable(tmaname)
22197end
22198local saveoptions={ compact=true,accurate=not JITSUPPORTED }
22199function caches.savedata(filepath,filename,data,fast)
22200 local tmaname,tmcname=setluanames(filepath,filename)
22201 data.cache_uuid=osuuid()
22202 if fast or fast_cache then
22203  savedata(tmaname,fastserialize(data,true))
22204 elseif direct_cache then
22205  savedata(tmaname,serialize(data,true,saveoptions))
22206 else
22207  serializetofile(tmaname,data,true,saveoptions)
22208 end
22209 compilelua(tmaname,tmcname)
22210end
22211local content_state={}
22212function caches.contentstate()
22213 return content_state or {}
22214end
22215function caches.loadcontent(cachename,dataname,filename)
22216 if not filename then
22217  local name=hashed(cachename)
22218  local full,path=getfirstreadablefile(addsuffix(name,luasuffixes.lua),"trees")
22219  filename=joinfile(path,name)
22220 end
22221 local state,blob=pcall(loadfile,addsuffix(filename,luasuffixes.luc))
22222 if not blob then
22223  state,blob=pcall(loadfile,addsuffix(filename,luasuffixes.lua))
22224 end
22225 if blob then
22226  local data=blob()
22227  if data and data.content then
22228   if data.type==dataname then
22229    if data.version==resolvers.cacheversion then
22230     content_state[#content_state+1]=data.uuid
22231     if trace_locating then
22232      report_resolvers("loading %a for %a from %a",dataname,cachename,filename)
22233     end
22234     return data.content
22235    else
22236     report_resolvers("skipping %a for %a from %a (version mismatch)",dataname,cachename,filename)
22237    end
22238   else
22239    report_resolvers("skipping %a for %a from %a (datatype mismatch)",dataname,cachename,filename)
22240   end
22241  elseif trace_locating then
22242   report_resolvers("skipping %a for %a from %a (no content)",dataname,cachename,filename)
22243  end
22244 elseif trace_locating then
22245  report_resolvers("skipping %a for %a from %a (invalid file)",dataname,cachename,filename)
22246 end
22247end
22248function caches.collapsecontent(content)
22249 for k,v in next,content do
22250  if type(v)=="table" and #v==1 then
22251   content[k]=v[1]
22252  end
22253 end
22254end
22255function caches.savecontent(cachename,dataname,content,filename)
22256 if not filename then
22257  local name=hashed(cachename)
22258  local full,path=setfirstwritablefile(addsuffix(name,luasuffixes.lua),"trees")
22259  filename=joinfile(path,name) 
22260 end
22261 local luaname=addsuffix(filename,luasuffixes.lua)
22262 local lucname=addsuffix(filename,luasuffixes.luc)
22263 if trace_locating then
22264  report_resolvers("preparing %a for %a",dataname,cachename)
22265 end
22266 local data={
22267  type=dataname,
22268  root=cachename,
22269  version=resolvers.cacheversion,
22270  date=osdate("%Y-%m-%d"),
22271  time=osdate("%H:%M:%S"),
22272  content=content,
22273  uuid=osuuid(),
22274 }
22275 local ok=savedata(luaname,serialize(data,true))
22276 if ok then
22277  if trace_locating then
22278   report_resolvers("category %a, cachename %a saved in %a",dataname,cachename,luaname)
22279  end
22280  if compilelua(luaname,lucname) then
22281   if trace_locating then
22282    report_resolvers("%a compiled to %a",dataname,lucname)
22283   end
22284   return true
22285  else
22286   if trace_locating then
22287    report_resolvers("compiling failed for %a, deleting file %a",dataname,lucname)
22288   end
22289   removefile(lucname)
22290  end
22291 elseif trace_locating then
22292  report_resolvers("unable to save %a in %a (access error)",dataname,luaname)
22293 end
22294end
22295
22296
22297end -- of closure
22298
22299do -- create closure to overcome 200 locals limit
22300
22301package.loaded["data-met"] = package.loaded["data-met"] or true
22302
22303-- original size: 5518, stripped down to: 3854
22304
22305if not modules then modules={} end modules ['data-met']={
22306 version=1.100,
22307 comment="companion to luat-lib.mkiv",
22308 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
22309 copyright="PRAGMA ADE / ConTeXt Development Team",
22310 license="see context related readme files"
22311}
22312local type=type
22313local find=string.find
22314local addurlscheme,urlhashed=url.addscheme,url.hashed
22315local collapsepath,joinfile=file.collapsepath,file.join
22316local report_methods=logs.reporter("resolvers","methods")
22317local trace_locating=false
22318local trace_methods=false
22319trackers.register("resolvers.locating",function(v) trace_methods=v end)
22320trackers.register("resolvers.methods",function(v) trace_methods=v end)
22321local allocate=utilities.storage.allocate
22322local resolvers=resolvers
22323local registered={}
22324local function splitmethod(filename) 
22325 if not filename then
22326  return {
22327   scheme="unknown",
22328   original=filename,
22329  }
22330 end
22331 if type(filename)=="table" then
22332  return filename 
22333 end
22334 filename=collapsepath(filename,".") 
22335 if not find(filename,"://",1,true) then
22336  return {
22337   scheme="file",
22338   path=filename,
22339   original=filename,
22340   filename=filename,
22341  }
22342 end
22343 local specification=urlhashed(filename)
22344 if not specification.scheme or specification.scheme=="" then
22345  return {
22346   scheme="file",
22347   path=filename,
22348   original=filename,
22349   filename=filename,
22350  }
22351 else
22352  return specification
22353 end
22354end
22355resolvers.splitmethod=splitmethod
22356local function methodhandler(what,first,...) 
22357 local method=registered[what]
22358 if method then
22359  local how=method.how
22360  local namespace=method.namespace
22361  if how=="uri" or how=="url" then
22362   local specification=splitmethod(first)
22363   local scheme=specification.scheme
22364   local resolver=namespace and namespace[scheme]
22365   if resolver then
22366    if trace_methods then
22367     report_methods("resolving, method %a, how %a, handler %a, argument %a",what,how,scheme,first)
22368    end
22369    return resolver(specification,...)
22370   else
22371    resolver=namespace.default or namespace.file
22372    if resolver then
22373     if trace_methods then
22374      report_methods("resolving, method %a, how %a, handler %a, argument %a",what,how,"default",first)
22375     end
22376     return resolver(specification,...)
22377    elseif trace_methods then
22378     report_methods("resolving, method %a, how %a, handler %a, argument %a",what,how,"unset")
22379    end
22380   end
22381  elseif how=="tag" then
22382   local resolver=namespace and namespace[first]
22383   if resolver then
22384    if trace_methods then
22385     report_methods("resolving, method %a, how %a, tag %a",what,how,first)
22386    end
22387    return resolver(...)
22388   else
22389    resolver=namespace.default or namespace.file
22390    if resolver then
22391     if trace_methods then
22392      report_methods("resolving, method %a, how %a, tag %a",what,how,"default")
22393     end
22394     return resolver(...)
22395    elseif trace_methods then
22396     report_methods("resolving, method %a, how %a, tag %a",what,how,"unset")
22397    end
22398   end
22399  end
22400 else
22401  report_methods("resolving, invalid method %a")
22402 end
22403end
22404resolvers.methodhandler=methodhandler
22405function resolvers.registermethod(name,namespace,how)
22406 registered[name]={
22407  how=how or "tag",
22408  namespace=namespace
22409 }
22410 namespace["byscheme"]=function(scheme,filename,...)
22411  if scheme=="file" then
22412   return methodhandler(name,filename,...)
22413  else
22414   return methodhandler(name,addurlscheme(filename,scheme),...)
22415  end
22416 end
22417end
22418local concatinators=allocate { notfound=joinfile  }  
22419local locators=allocate { notfound=function() end  }  
22420local hashers=allocate { notfound=function() end  }  
22421local generators=allocate { notfound=function() end  }  
22422resolvers.concatinators=concatinators
22423resolvers.locators=locators
22424resolvers.hashers=hashers
22425resolvers.generators=generators
22426local registermethod=resolvers.registermethod
22427registermethod("concatinators",concatinators,"tag")
22428registermethod("locators",locators,"uri")
22429registermethod("hashers",hashers,"uri")
22430registermethod("generators",generators,"uri")
22431
22432
22433end -- of closure
22434
22435do -- create closure to overcome 200 locals limit
22436
22437package.loaded["data-res"] = package.loaded["data-res"] or true
22438
22439-- original size: 70699, stripped down to: 45019
22440
22441if not modules then modules={} end modules ['data-res']={
22442 version=1.001,
22443 comment="companion to luat-lib.mkiv",
22444 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
22445 copyright="PRAGMA ADE / ConTeXt Development Team",
22446 license="see context related readme files",
22447}
22448local gsub,find,lower,upper,match,gmatch=string.gsub,string.find,string.lower,string.upper,string.match,string.gmatch
22449local concat,insert,remove=table.concat,table.insert,table.remove
22450local next,type,rawget,loadfile=next,type,rawget,loadfile
22451local mergedtable=table.merged
22452local os=os
22453local P,S,R,C,Cc,Cs,Ct,Carg=lpeg.P,lpeg.S,lpeg.R,lpeg.C,lpeg.Cc,lpeg.Cs,lpeg.Ct,lpeg.Carg
22454local lpegmatch,lpegpatterns=lpeg.match,lpeg.patterns
22455local formatters=string.formatters
22456local filedirname=file.dirname
22457local filebasename=file.basename
22458local suffixonly=file.suffixonly
22459local addsuffix=file.addsuffix
22460local removesuffix=file.removesuffix
22461local filejoin=file.join
22462local collapsepath=file.collapsepath
22463local joinpath=file.joinpath
22464local is_qualified_path=file.is_qualified_path
22465local allocate=utilities.storage.allocate
22466local settings_to_array=utilities.parsers.settings_to_array
22467local urlhasscheme=url.hasscheme
22468local getcurrentdir=lfs.currentdir
22469local isfile=lfs.isfile
22470local isdir=lfs.isdir
22471local setmetatableindex=table.setmetatableindex
22472local luasuffixes=utilities.lua.suffixes
22473local trace_locating=false  trackers  .register("resolvers.locating",function(v) trace_locating=v end)
22474local trace_details=false  trackers  .register("resolvers.details",function(v) trace_details=v end)
22475local trace_expansions=false  trackers  .register("resolvers.expansions",function(v) trace_expansions=v end)
22476local trace_paths=false  trackers  .register("resolvers.paths",function(v) trace_paths=v end)
22477local resolve_otherwise=true   directives.register("resolvers.otherwise",function(v) resolve_otherwise=v end)
22478local report_resolving=logs.reporter("resolvers","resolving")
22479local resolvers=resolvers
22480local expandedpathfromlist=resolvers.expandedpathfromlist
22481local checkedvariable=resolvers.checkedvariable
22482local splitconfigurationpath=resolvers.splitconfigurationpath
22483local methodhandler=resolvers.methodhandler
22484local filtered=resolvers.filtered_from_content
22485local lookup=resolvers.get_from_content
22486local cleanpath=resolvers.cleanpath
22487local resolveprefix=resolvers.resolve
22488local initializesetter=utilities.setters.initialize
22489local ostype,osname,osenv,ossetenv,osgetenv=os.type,os.name,os.env,os.setenv,os.getenv
22490resolvers.cacheversion="1.100"
22491resolvers.configbanner=""
22492resolvers.homedir=environment.homedir
22493resolvers.luacnfname="texmfcnf.lua"
22494resolvers.luacnffallback="contextcnf.lua"
22495resolvers.luacnfstate="unknown"
22496local criticalvars={
22497 "SELFAUTOLOC",
22498 "SELFAUTODIR",
22499 "SELFAUTOPARENT",
22500 "TEXMFCNF",
22501 "TEXMF",
22502 "TEXOS",
22503}
22504do
22505 local texroot=environment.texroot
22506 resolvers.luacnfspec={
22507  "home:texmf/web2c",
22508  "selfautoparent:/texmf-local/web2c",
22509  "selfautoparent:/texmf-context/web2c",
22510  "selfautoparent:/texmf/web2c",
22511 }
22512 if environment.default_texmfcnf then
22513  resolvers.luacnfspec={
22514   "home:texmf/web2c",
22515   environment.default_texmfcnf,
22516  }
22517 elseif texroot and isdir(texroot.."/texmf-context") then
22518 elseif texroot and isdir(texroot.."/texmf-dist") then
22519  resolvers.luacnfspec={
22520   "home:texmf/web2c",
22521   "selfautoparent:/texmf-local/web2c",
22522   "selfautoparent:",
22523   "selfautoparent:/texmf-dist/web2c",
22524   "selfautoparent:/texmf/web2c",
22525  }
22526 elseif ostype~="windows" and isdir("/etc/texmf/web2c") then
22527  resolvers.luacnfspec={
22528   "home:texmf/web2c",
22529   "/etc/texmf/web2c",
22530   "selfautodir:/share/texmf/web2c",
22531  }
22532 else
22533 end
22534 resolvers.luacnfspec=concat(resolvers.luacnfspec,";")
22535end
22536local unset_variable="unset"
22537local formats=resolvers.formats
22538local suffixes=resolvers.suffixes
22539local usertypes=resolvers.usertypes
22540local dangerous=resolvers.dangerous
22541local suffixmap=resolvers.suffixmap
22542resolvers.defaultsuffixes={ "tex" } 
22543local instance=nil
22544local variable
22545local expansion
22546local setenv
22547local getenv
22548local formatofsuffix=resolvers.formatofsuffix
22549local splitpath=resolvers.splitpath
22550local splitmethod=resolvers.splitmethod
22551setenv=function(key,value,raw)
22552 if instance then
22553  instance.environment[key]=value
22554  ossetenv(key,raw and value or resolveprefix(value))
22555 end
22556end
22557getenv=function(key)
22558 local value=rawget(instance.environment,key)
22559 if value and value~="" then
22560  return value
22561 else
22562  local e=osgetenv(key)
22563  return e~=nil and e~="" and checkedvariable(e) or ""
22564 end
22565end
22566resolvers.getenv=getenv
22567resolvers.setenv=setenv
22568local dollarstripper=lpeg.stripper("$")
22569local inhibitstripper=P("!")^0*Cs(P(1)^0)
22570local expandedvariable,resolvedvariable  do
22571 local function resolveinstancevariable(k)
22572  return instance.expansions[k]
22573 end
22574 local p_variable=P("$")/""
22575 local p_key=C(R("az","AZ","09","__","--")^1)
22576 local p_whatever=P(";")*((1-S("!{}/\\"))^1*P(";")/"")+P(";")*(P(";")/"")+P(1)
22577 local variableexpander=Cs((p_variable*(p_key/resolveinstancevariable)+p_whatever)^1 )
22578 local p_cleaner=P("\\")/"/"+P(";")*S("!{}/\\")^0*P(";")^1/";"
22579 local variablecleaner=Cs((p_cleaner+P(1))^0)
22580 local p_variable=R("az","AZ","09","__","--")^1/resolveinstancevariable
22581 local p_variable=(P("$")/"")*(p_variable+(P("{")/"")*p_variable*(P("}")/""))
22582 local variableresolver=Cs((p_variable+P(1))^0)
22583 expandedvariable=function(var)
22584  return lpegmatch(variableexpander,var) or var
22585 end
22586 function resolvers.reset()
22587  if trace_locating then
22588   report_resolving("creating instance")
22589  end
22590  local environment={}
22591  local variables={}
22592  local expansions={}
22593  local order={}
22594  instance={
22595   environment=environment,
22596   variables=variables,
22597   expansions=expansions,
22598   order=order,
22599   files={},
22600   setups={},
22601   found={},
22602   foundintrees={},
22603   hashes={},
22604   hashed={},
22605   pathlists=false,
22606   specification={},
22607   lists={},
22608   data={},
22609   fakepaths={},
22610   remember=true,
22611   diskcache=true,
22612   renewcache=false,
22613   renewtree=false,
22614   loaderror=false,
22615   savelists=true,
22616   pattern=nil,
22617   force_suffixes=true,
22618   pathstack={},
22619  }
22620  setmetatableindex(variables,function(t,k)
22621   local v
22622   for i=1,#order do
22623    v=order[i][k]
22624    if v~=nil then
22625     t[k]=v
22626     return v
22627    end
22628   end
22629   if v==nil then
22630    v=""
22631   end
22632   t[k]=v
22633   return v
22634  end)
22635  local repath=resolvers.repath
22636  setmetatableindex(environment,function(t,k)
22637   local v=osgetenv(k)
22638   if v==nil then
22639    v=variables[k]
22640   end
22641   if v~=nil then
22642    v=checkedvariable(v) or ""
22643   end
22644   v=repath(v) 
22645   t[k]=v
22646   return v
22647  end)
22648  setmetatableindex(expansions,function(t,k)
22649   local v=environment[k]
22650   if type(v)=="string" then
22651    v=lpegmatch(variableresolver,v)
22652    v=lpegmatch(variablecleaner,v)
22653   end
22654   t[k]=v
22655   return v
22656  end)
22657 end
22658end
22659function resolvers.initialized()
22660 return instance~=nil
22661end
22662local function reset_hashes()
22663 instance.lists={}
22664 instance.pathlists=false
22665 instance.found={}
22666end
22667local function reset_caches()
22668 instance.lists={}
22669 instance.pathlists=false
22670end
22671local makepathexpression  do
22672 local slash=P("/")
22673 local pathexpressionpattern=Cs (
22674  Cc("^")*(
22675   Cc("%")*S(".-")+slash^2*P(-1)/"/.*"
22676+slash^2/"/"+(1-slash)*P(-1)*Cc("/")+P(1)
22677  )^1*Cc("$") 
22678 )
22679 local cache={}
22680 makepathexpression=function(str)
22681  if str=="." then
22682   return "^%./$"
22683  else
22684   local c=cache[str]
22685   if not c then
22686    c=lpegmatch(pathexpressionpattern,str)
22687    cache[str]=c
22688   end
22689   return c
22690  end
22691 end
22692end
22693local function reportcriticalvariables(cnfspec)
22694 if trace_locating then
22695  for i=1,#criticalvars do
22696   local k=criticalvars[i]
22697   local v=getenv(k) or "unknown" 
22698   report_resolving("variable %a set to %a",k,v)
22699  end
22700  report_resolving()
22701  if cnfspec then
22702   report_resolving("using configuration specification %a",type(cnfspec)=="table" and concat(cnfspec,",") or cnfspec)
22703  end
22704  report_resolving()
22705 end
22706 reportcriticalvariables=function() end
22707end
22708local function identify_configuration_files()
22709 local specification=instance.specification
22710 if #specification==0 then
22711  local cnfspec=getenv("TEXMFCNF")
22712  if cnfspec=="" then
22713   cnfspec=resolvers.luacnfspec
22714   resolvers.luacnfstate="default"
22715  else
22716   resolvers.luacnfstate="environment"
22717  end
22718  reportcriticalvariables(cnfspec)
22719  local cnfpaths=expandedpathfromlist(splitpath(cnfspec))
22720  local function locatecnf(luacnfname,kind)
22721   for i=1,#cnfpaths do
22722    local filepath=cnfpaths[i]
22723    local filename=collapsepath(filejoin(filepath,luacnfname))
22724    local realname=resolveprefix(filename)
22725    if trace_locating then
22726     local fullpath=gsub(resolveprefix(collapsepath(filepath)),"//","/")
22727     local weirdpath=find(fullpath,"/texmf.+/texmf") or not find(fullpath,"/web2c",1,true)
22728     report_resolving("looking for %s %a on %s path %a from specification %a",
22729      kind,luacnfname,weirdpath and "weird" or "given",fullpath,filepath)
22730    end
22731    if isfile(realname) then
22732     specification[#specification+1]=filename 
22733     if trace_locating then
22734      report_resolving("found %s configuration file %a",kind,realname)
22735     end
22736    end
22737   end
22738  end
22739  locatecnf(resolvers.luacnfname,"regular")
22740  if #specification==0 then
22741   locatecnf(resolvers.luacnffallback,"fallback")
22742  end
22743  if trace_locating then
22744   report_resolving()
22745  end
22746 elseif trace_locating then
22747  report_resolving("configuration files already identified")
22748 end
22749end
22750local function load_configuration_files()
22751 local specification=instance.specification
22752 local setups=instance.setups
22753 local order=instance.order
22754 if #specification>0 then
22755  local luacnfname=resolvers.luacnfname
22756  for i=1,#specification do
22757   local filename=specification[i]
22758   local pathname=filedirname(filename)
22759   local filename=filejoin(pathname,luacnfname)
22760   local realname=resolveprefix(filename) 
22761   local blob=loadfile(realname)
22762   if blob then
22763    local data=blob()
22764    local parent=data and data.parent
22765    if parent then
22766     local filename=filejoin(pathname,parent)
22767     local realname=resolveprefix(filename) 
22768     local blob=loadfile(realname)
22769     if blob then
22770      local parentdata=blob()
22771      if parentdata then
22772       report_resolving("loading configuration file %a",filename)
22773       data=mergedtable(parentdata,data)
22774      end
22775     end
22776    end
22777    data=data and data.content
22778    if data then
22779     if trace_locating then
22780      report_resolving("loading configuration file %a",filename)
22781      report_resolving()
22782     end
22783     local variables=data.variables or {}
22784     local warning=false
22785     for k,v in next,data do
22786      local variant=type(v)
22787      if variant=="table" then
22788       initializesetter(filename,k,v)
22789      elseif variables[k]==nil then
22790       if trace_locating and not warning then
22791        report_resolving("variables like %a in configuration file %a should move to the 'variables' subtable",
22792         k,resolveprefix(filename))
22793        warning=true
22794       end
22795       variables[k]=v
22796      end
22797     end
22798     setups[pathname]=variables
22799     if resolvers.luacnfstate=="default" then
22800      local cnfspec=variables["TEXMFCNF"]
22801      if cnfspec then
22802       if trace_locating then
22803        report_resolving("reloading configuration due to TEXMF redefinition")
22804       end
22805       setenv("TEXMFCNF",cnfspec)
22806       instance.specification={}
22807       identify_configuration_files()
22808       load_configuration_files()
22809       resolvers.luacnfstate="configuration"
22810       break
22811      end
22812     end
22813    else
22814     if trace_locating then
22815      report_resolving("skipping configuration file %a (no content)",filename)
22816     end
22817     setups[pathname]={}
22818     instance.loaderror=true
22819    end
22820   elseif trace_locating then
22821    report_resolving("skipping configuration file %a (no valid format)",filename)
22822   end
22823   order[#order+1]=setups[pathname]
22824   if instance.loaderror then
22825    break
22826   end
22827  end
22828 elseif trace_locating then
22829  report_resolving("warning: no lua configuration files found")
22830 end
22831end
22832local expandedpathlist
22833local unexpandedpathlist
22834function resolvers.configurationfiles()
22835 return instance.specification or {}
22836end
22837local function load_file_databases()
22838 instance.loaderror=false
22839 instance.files={}
22840 if not instance.renewcache then
22841  local hashes=instance.hashes
22842  for k=1,#hashes do
22843   local hash=hashes[k]
22844   resolvers.hashers.byscheme(hash.type,hash.name)
22845   if instance.loaderror then break end
22846  end
22847 end
22848end
22849local function locate_file_databases()
22850 local texmfpaths=expandedpathlist("TEXMF")
22851 if #texmfpaths>0 then
22852  for i=1,#texmfpaths do
22853   local path=collapsepath(texmfpaths[i])
22854   path=gsub(path,"/+$","") 
22855   local stripped=lpegmatch(inhibitstripper,path) 
22856   if stripped~="" then
22857    local runtime=stripped==path
22858    path=cleanpath(path)
22859    local spec=splitmethod(stripped)
22860    if runtime and (spec.noscheme or spec.scheme=="file") then
22861     stripped="tree:///"..stripped
22862    elseif spec.scheme=="cache" or spec.scheme=="file" then
22863     stripped=spec.path
22864    end
22865    if trace_locating then
22866     if runtime then
22867      report_resolving("locating list of %a (runtime) (%s)",path,stripped)
22868     else
22869      report_resolving("locating list of %a (cached)",path)
22870     end
22871    end
22872    methodhandler('locators',stripped)
22873   end
22874  end
22875  if trace_locating then
22876   report_resolving()
22877  end
22878 elseif trace_locating then
22879  report_resolving("no texmf paths are defined (using TEXMF)")
22880 end
22881end
22882local function generate_file_databases()
22883 local hashes=instance.hashes
22884 for k=1,#hashes do
22885  local hash=hashes[k]
22886  methodhandler('generators',hash.name)
22887 end
22888 if trace_locating then
22889  report_resolving()
22890 end
22891end
22892local function save_file_databases() 
22893 local hashes=instance.hashes
22894 local files=instance.files
22895 for i=1,#hashes do
22896  local hash=hashes[i]
22897  local cachename=hash.name
22898  if hash.cache then
22899   local content=files[cachename]
22900   caches.collapsecontent(content)
22901   if trace_locating then
22902    report_resolving("saving tree %a",cachename)
22903   end
22904   caches.savecontent(cachename,"files",content)
22905  elseif trace_locating then
22906   report_resolving("not saving runtime tree %a",cachename)
22907  end
22908 end
22909end
22910function resolvers.renew(hashname)
22911 local files=instance.files
22912 if hashname and hashname~="" then
22913  local expanded=expansion(hashname) or ""
22914  if expanded~="" then
22915   if trace_locating then
22916    report_resolving("identifying tree %a from %a",expanded,hashname)
22917   end
22918   hashname=expanded
22919  else
22920   if trace_locating then
22921    report_resolving("identifying tree %a",hashname)
22922   end
22923  end
22924  local realpath=resolveprefix(hashname)
22925  if isdir(realpath) then
22926   if trace_locating then
22927    report_resolving("using path %a",realpath)
22928   end
22929   methodhandler('generators',hashname)
22930   local content=files[hashname]
22931   caches.collapsecontent(content)
22932   if trace_locating then
22933    report_resolving("saving tree %a",hashname)
22934   end
22935   caches.savecontent(hashname,"files",content)
22936  else
22937   report_resolving("invalid path %a",realpath)
22938  end
22939 end
22940end
22941local function load_databases()
22942 locate_file_databases()
22943 if instance.diskcache and not instance.renewcache then
22944  load_file_databases()
22945  if instance.loaderror then
22946   generate_file_databases()
22947   save_file_databases()
22948  end
22949 else
22950  generate_file_databases()
22951  if instance.renewcache then
22952   save_file_databases()
22953  end
22954 end
22955end
22956function resolvers.appendhash(type,name,cache)
22957 local hashed=instance.hashed
22958 local hashes=instance.hashes
22959 if hashed[name] then
22960 else
22961  if trace_locating then
22962   report_resolving("hash %a appended",name)
22963  end
22964  insert(hashes,{ type=type,name=name,cache=cache } )
22965  hashed[name]=cache
22966 end
22967end
22968function resolvers.prependhash(type,name,cache)
22969 local hashed=instance.hashed
22970 local hashes=instance.hashes
22971 if hashed[name] then
22972 else
22973  if trace_locating then
22974   report_resolving("hash %a prepended",name)
22975  end
22976  insert(hashes,1,{ type=type,name=name,cache=cache } )
22977  hashed[name]=cache
22978 end
22979end
22980function resolvers.extendtexmfvariable(specification) 
22981 local environment=instance.environment
22982 local variables=instance.variables
22983 local texmftrees=splitpath(getenv("TEXMF")) 
22984 insert(texmftrees,1,specification)
22985 texmftrees=concat(texmftrees,",") 
22986 if environment["TEXMF"] then
22987  environment["TEXMF"]=texmftrees
22988 elseif variables["TEXMF"] then
22989  variables["TEXMF"]=texmftrees
22990 else
22991 end
22992 reset_hashes()
22993end
22994function resolvers.splitexpansions()
22995 local expansions=instance.expansions
22996 for k,v in next,expansions do
22997  local t,tn,h,p={},0,{},splitconfigurationpath(v)
22998  for kk=1,#p do
22999   local vv=p[kk]
23000   if vv~="" and not h[vv] then
23001    tn=tn+1
23002    t[tn]=vv
23003    h[vv]=true
23004   end
23005  end
23006  if tn>1 then
23007   expansions[k]=t
23008  else
23009   expansions[k]=t[1]
23010  end
23011 end
23012end
23013function resolvers.datastate()
23014 return caches.contentstate()
23015end
23016variable=function(name)
23017 local variables=instance.variables
23018 local name=name and lpegmatch(dollarstripper,name)
23019 local result=name and variables[name]
23020 return result~=nil and result or ""
23021end
23022expansion=function(name)
23023 local expansions=instance.expansions
23024 local name=name and lpegmatch(dollarstripper,name)
23025 local result=name and expansions[name]
23026 return result~=nil and result or ""
23027end
23028resolvers.variable=variable
23029resolvers.expansion=expansion
23030unexpandedpathlist=function(str)
23031 local pth=variable(str)
23032 local lst=splitpath(pth)
23033 return expandedpathfromlist(lst)
23034end
23035function resolvers.unexpandedpath(str)
23036 return joinpath(unexpandedpathlist(str))
23037end
23038function resolvers.pushpath(name)
23039 local pathstack=instance.pathstack
23040 local lastpath=pathstack[#pathstack]
23041 local pluspath=filedirname(name)
23042 if lastpath then
23043  lastpath=collapsepath(filejoin(lastpath,pluspath))
23044 else
23045  lastpath=collapsepath(pluspath)
23046 end
23047 insert(pathstack,lastpath)
23048 if trace_paths then
23049  report_resolving("pushing path %a",lastpath)
23050 end
23051end
23052function resolvers.poppath()
23053 local pathstack=instance.pathstack
23054 if trace_paths and #pathstack>0 then
23055  report_resolving("popping path %a",pathstack[#pathstack])
23056 end
23057 remove(pathstack)
23058end
23059function resolvers.stackpath()
23060 local pathstack=instance.pathstack
23061 local currentpath=pathstack[#pathstack]
23062 return currentpath~="" and currentpath or nil
23063end
23064local done={}
23065function resolvers.resetextrapaths()
23066 local extra_paths=instance.extra_paths
23067 if not extra_paths then
23068  done={}
23069  instance.extra_paths={}
23070 elseif #ep>0 then
23071  done={}
23072  reset_caches()
23073 end
23074end
23075function resolvers.getextrapaths()
23076 return instance.extra_paths or {}
23077end
23078function resolvers.registerextrapath(paths,subpaths)
23079 if not subpaths or subpaths=="" then
23080  if not paths or path=="" then
23081   return 
23082  elseif done[paths] then
23083   return 
23084  end
23085 end
23086 local paths=settings_to_array(paths)
23087 local subpaths=settings_to_array(subpaths)
23088 local extra_paths=instance.extra_paths or {}
23089 local oldn=#extra_paths
23090 local newn=oldn
23091 local nofpaths=#paths
23092 local nofsubpaths=#subpaths
23093 if nofpaths>0 then
23094  if nofsubpaths>0 then
23095   for i=1,nofpaths do
23096    local p=paths[i]
23097    for j=1,nofsubpaths do
23098     local s=subpaths[j]
23099     local ps=p.."/"..s
23100     if not done[ps] then
23101      newn=newn+1
23102      extra_paths[newn]=cleanpath(ps)
23103      done[ps]=true
23104     end
23105    end
23106   end
23107  else
23108   for i=1,nofpaths do
23109    local p=paths[i]
23110    if not done[p] then
23111     newn=newn+1
23112     extra_paths[newn]=cleanpath(p)
23113     done[p]=true
23114    end
23115   end
23116  end
23117 elseif nofsubpaths>0 then
23118  for i=1,oldn do
23119   for j=1,nofsubpaths do
23120    local s=subpaths[j]
23121    local ps=extra_paths[i].."/"..s
23122    if not done[ps] then
23123     newn=newn+1
23124     extra_paths[newn]=cleanpath(ps)
23125     done[ps]=true
23126    end
23127   end
23128  end
23129 end
23130 if newn>0 then
23131  instance.extra_paths=extra_paths 
23132 end
23133 if newn~=oldn then
23134  reset_caches()
23135 end
23136end
23137function resolvers.pushextrapath(path)
23138 local paths=settings_to_array(path)
23139 local extra_stack=instance.extra_stack
23140 if extra_stack then
23141  insert(extra_stack,1,paths)
23142 else
23143  instance.extra_stack={ paths }
23144 end
23145 reset_caches()
23146end
23147function resolvers.popextrapath()
23148 local extra_stack=instance.extra_stack
23149 if extra_stack then
23150  reset_caches()
23151  return remove(extra_stack,1)
23152 end
23153end
23154local function made_list(instance,list,extra_too)
23155 local done={}
23156 local new={}
23157 local newn=0
23158 local function add(p)
23159  for k=1,#p do
23160   local v=p[k]
23161   if not done[v] then
23162    done[v]=true
23163    newn=newn+1
23164    new[newn]=v
23165   end
23166  end
23167 end
23168 for k=1,#list do
23169  local v=list[k]
23170  if done[v] then
23171  elseif find(v,"^[%.%/]$") then
23172   done[v]=true
23173   newn=newn+1
23174   new[newn]=v
23175  else
23176   break
23177  end
23178 end
23179 if extra_too then
23180  local extra_stack=instance.extra_stack
23181  local extra_paths=instance.extra_paths
23182  if extra_stack and #extra_stack>0 then
23183   for k=1,#extra_stack do
23184    add(extra_stack[k])
23185   end
23186  end
23187  if extra_paths and #extra_paths>0 then
23188   add(extra_paths)
23189  end
23190 end
23191 add(list)
23192 return new
23193end
23194expandedpathlist=function(str,extra_too)
23195 if not str then
23196  return {}
23197 elseif instance.savelists then 
23198  str=lpegmatch(dollarstripper,str)
23199  local lists=instance.lists
23200  local lst=lists[str]
23201  if not lst then
23202   local l=made_list(instance,splitpath(expansion(str)),extra_too)
23203   lst=expandedpathfromlist(l)
23204   lists[str]=lst
23205  end
23206  return lst
23207 else
23208  local lst=splitpath(expansion(str))
23209  return made_list(instance,expandedpathfromlist(lst),extra_too)
23210 end
23211end
23212resolvers.expandedpathlist=expandedpathlist
23213resolvers.unexpandedpathlist=unexpandedpathlist
23214function resolvers.cleanpathlist(str)
23215 local t=expandedpathlist(str)
23216 if t then
23217  for i=1,#t do
23218   t[i]=collapsepath(cleanpath(t[i]))
23219  end
23220 end
23221 return t
23222end
23223function resolvers.expandpath(str)
23224 return joinpath(expandedpathlist(str))
23225end
23226local function expandedpathlistfromvariable(str) 
23227 str=lpegmatch(dollarstripper,str)
23228 local tmp=resolvers.variableofformatorsuffix(str)
23229 return expandedpathlist(tmp~="" and tmp or str)
23230end
23231function resolvers.expandpathfromvariable(str)
23232 return joinpath(expandedpathlistfromvariable(str))
23233end
23234resolvers.expandedpathlistfromvariable=expandedpathlistfromvariable
23235function resolvers.cleanedpathlist(v) 
23236 local t=expandedpathlist(v)
23237 for i=1,#t do
23238  t[i]=resolveprefix(cleanpath(t[i]))
23239 end
23240 return t
23241end
23242function resolvers.expandbraces(str) 
23243 local pth=expandedpathfromlist(splitpath(str))
23244 return joinpath(pth)
23245end
23246function resolvers.registerfilehash(name,content,someerror)
23247 local files=instance.files
23248 if content then
23249  files[name]=content
23250 else
23251  files[name]={}
23252  if somerror==true then 
23253   instance.loaderror=someerror
23254  end
23255 end
23256end
23257function resolvers.getfilehashes()
23258 return instance and instance.files or {}
23259end
23260function resolvers.gethashes()
23261 return instance and instance.hashes or {}
23262end
23263function resolvers.renewcache()
23264 if instance then
23265  instance.renewcache=true
23266 end
23267end
23268local function isreadable(name)
23269 local readable=isfile(name) 
23270 if trace_details then
23271  if readable then
23272   report_resolving("file %a is readable",name)
23273  else
23274   report_resolving("file %a is not readable",name)
23275  end
23276 end
23277 return readable
23278end
23279local function collect_files(names) 
23280 local filelist={}   
23281 local noffiles=0
23282 local function check(hash,root,pathname,path,basename,name)
23283  if not pathname or find(path,pathname) then
23284   local variant=hash.type
23285   local search=filejoin(root,path,name) 
23286   local result=methodhandler('concatinators',variant,root,path,name)
23287   if trace_details then
23288    report_resolving("match: variant %a, search %a, result %a",variant,search,result)
23289   end
23290   noffiles=noffiles+1
23291   filelist[noffiles]={ variant,search,result }
23292  end
23293 end
23294 for k=1,#names do
23295  local filename=names[k]
23296  if trace_details then
23297   report_resolving("checking name %a",filename)
23298  end
23299  local basename=filebasename(filename)
23300  local pathname=filedirname(filename)
23301  if pathname=="" or find(pathname,"^%.") then
23302   pathname=false
23303  else
23304   pathname=gsub(pathname,"%*",".*")
23305   pathname="/"..pathname.."$"
23306  end
23307  local hashes=instance.hashes
23308  local files=instance.files
23309  for h=1,#hashes do
23310   local hash=hashes[h]
23311   local hashname=hash.name
23312   local content=hashname and files[hashname]
23313   if content then
23314    if trace_details then
23315     report_resolving("deep checking %a, base %a, pattern %a",hashname,basename,pathname)
23316    end
23317    local path,name=lookup(content,basename)
23318    if path then
23319     local metadata=content.metadata
23320     local realroot=metadata and metadata.path or hashname
23321     if type(path)=="string" then
23322      check(hash,realroot,pathname,path,basename,name)
23323     else
23324      for i=1,#path do
23325       check(hash,realroot,pathname,path[i],basename,name)
23326      end
23327     end
23328    end
23329   elseif trace_locating then
23330    report_resolving("no match in %a (%s)",hashname,basename)
23331   end
23332  end
23333 end
23334 return noffiles>0 and filelist or nil
23335end
23336local fit={}
23337function resolvers.registerintrees(filename,format,filetype,usedmethod,foundname)
23338 local foundintrees=instance.foundintrees
23339 if usedmethod=="direct" and filename==foundname and fit[foundname] then
23340 else
23341  local collapsed=collapsepath(foundname,true)
23342  local t={
23343   filename=filename,
23344   format=format~="" and format   or nil,
23345   filetype=filetype~="" and filetype or nil,
23346   usedmethod=usedmethod,
23347   foundname=foundname,
23348   fullname=collapsed,
23349  }
23350  fit[foundname]=t
23351  foundintrees[#foundintrees+1]=t
23352 end
23353end
23354function resolvers.foundintrees()
23355 return instance.foundintrees or {}
23356end
23357function resolvers.foundintree(fullname)
23358 local f=fit[fullname]
23359 return f and f.usedmethod=="database"
23360end
23361local function can_be_dir(name) 
23362 local fakepaths=instance.fakepaths
23363 if not fakepaths[name] then
23364  if isdir(name) then
23365   fakepaths[name]=1 
23366  else
23367   fakepaths[name]=2 
23368  end
23369 end
23370 return fakepaths[name]==1
23371end
23372local preparetreepattern=Cs((P(".")/"%%."+P("-")/"%%-"+P(1))^0*Cc("$"))
23373local collect_instance_files
23374local function find_analyze(filename,askedformat,allresults)
23375 local filetype=""
23376 local filesuffix=suffixonly(filename)
23377 local wantedfiles={}
23378 wantedfiles[#wantedfiles+1]=filename
23379 if askedformat=="" then
23380  if filesuffix=="" or not suffixmap[filesuffix] then
23381   local defaultsuffixes=resolvers.defaultsuffixes
23382   for i=1,#defaultsuffixes do
23383    local forcedname=filename.."."..defaultsuffixes[i]
23384    wantedfiles[#wantedfiles+1]=forcedname
23385    filetype=formatofsuffix(forcedname)
23386    if trace_locating then
23387     report_resolving("forcing filetype %a",filetype)
23388    end
23389   end
23390  else
23391   filetype=formatofsuffix(filename)
23392   if trace_locating then
23393    report_resolving("using suffix based filetype %a",filetype)
23394   end
23395  end
23396 else
23397  if filesuffix=="" or not suffixmap[filesuffix] then
23398   local format_suffixes=suffixes[askedformat]
23399   if format_suffixes then
23400    for i=1,#format_suffixes do
23401     wantedfiles[#wantedfiles+1]=filename.."."..format_suffixes[i]
23402    end
23403   end
23404  end
23405  filetype=askedformat
23406  if trace_locating then
23407   report_resolving("using given filetype %a",filetype)
23408  end
23409 end
23410 return filetype,wantedfiles
23411end
23412local function find_direct(filename,allresults)
23413 if not dangerous[askedformat] and isreadable(filename) then
23414  if trace_details then
23415   report_resolving("file %a found directly",filename)
23416  end
23417  return "direct",{ filename }
23418 end
23419end
23420local function find_wildcard(filename,allresults)
23421 if find(filename,'*',1,true) then
23422  if trace_locating then
23423   report_resolving("checking wildcard %a",filename)
23424  end
23425  local result=resolvers.findwildcardfiles(filename)
23426  if result then
23427   return "wildcard",result
23428  end
23429 end
23430end
23431local function find_qualified(filename,allresults,askedformat,alsostripped) 
23432 if not is_qualified_path(filename) then
23433  return
23434 end
23435 if trace_locating then
23436  report_resolving("checking qualified name %a",filename)
23437 end
23438 if isreadable(filename) then
23439  if trace_details then
23440   report_resolving("qualified file %a found",filename)
23441  end
23442  return "qualified",{ filename }
23443 end
23444 if trace_details then
23445  report_resolving("locating qualified file %a",filename)
23446 end
23447 local forcedname,suffix="",suffixonly(filename)
23448 if suffix=="" then 
23449  local format_suffixes=askedformat=="" and resolvers.defaultsuffixes or suffixes[askedformat]
23450  if format_suffixes then
23451   for i=1,#format_suffixes do
23452    local suffix=format_suffixes[i]
23453    forcedname=filename.."."..suffix
23454    if isreadable(forcedname) then
23455     if trace_locating then
23456      report_resolving("no suffix, forcing format filetype %a",suffix)
23457     end
23458     return "qualified",{ forcedname }
23459    end
23460   end
23461  end
23462 end
23463 if alsostripped and suffix and suffix~="" then
23464  local basename=filebasename(filename)
23465  local pattern=lpegmatch(preparetreepattern,filename)
23466  local savedformat=askedformat
23467  local format=savedformat or ""
23468  if format=="" then
23469   askedformat=formatofsuffix(suffix)
23470  end
23471  if not format then
23472   askedformat="othertextfiles" 
23473  end
23474  if basename~=filename then
23475   local resolved=collect_instance_files(basename,askedformat,allresults)
23476   if #resolved==0 then
23477    local lowered=lower(basename)
23478    if filename~=lowered then
23479     resolved=collect_instance_files(lowered,askedformat,allresults)
23480    end
23481   end
23482   resolvers.format=savedformat
23483   if #resolved>0 then
23484    local result={}
23485    for r=1,#resolved do
23486     local rr=resolved[r]
23487     if find(rr,pattern) then
23488      result[#result+1]=rr
23489     end
23490    end
23491    if #result>0 then
23492     return "qualified",result
23493    end
23494   end
23495  end
23496 end
23497end
23498local function check_subpath(fname)
23499 if isreadable(fname) then
23500  if trace_details then
23501   report_resolving("found %a by deep scanning",fname)
23502  end
23503  return fname
23504 end
23505end
23506local function makepathlist(list,filetype)
23507 local typespec=resolvers.variableofformat(filetype)
23508 local pathlist=expandedpathlist(typespec,filetype and usertypes[filetype]) 
23509 local entry={}
23510 if pathlist and #pathlist>0 then
23511  for k=1,#pathlist do
23512   local path=pathlist[k]
23513   local prescanned=find(path,'^!!')
23514   local resursive=find(path,'//$')
23515   local pathname=lpegmatch(inhibitstripper,path)
23516   local expression=makepathexpression(pathname)
23517   local barename=gsub(pathname,"/+$","")
23518   barename=resolveprefix(barename)
23519   local scheme=urlhasscheme(barename)
23520   local schemename=gsub(barename,"%.%*$",'')
23521   entry[k]={
23522    path=path,
23523    pathname=pathname,
23524    prescanned=prescanned,
23525    recursive=recursive,
23526    expression=expression,
23527    barename=barename,
23528    scheme=scheme,
23529    schemename=schemename,
23530   }
23531  end
23532  entry.typespec=typespec
23533  list[filetype]=entry
23534 else
23535  list[filetype]=false
23536 end
23537 return entry
23538end
23539local function find_intree(filename,filetype,wantedfiles,allresults)
23540 local pathlists=instance.pathlists
23541 if not pathlists then
23542  pathlists=setmetatableindex({},makepathlist)
23543  instance.pathlists=pathlists
23544 end
23545 local pathlist=pathlists[filetype]
23546 if pathlist then
23547  local method="intree"
23548  local filelist=collect_files(wantedfiles) 
23549  local dirlist={}
23550  local result={}
23551  if filelist then
23552   for i=1,#filelist do
23553    dirlist[i]=filedirname(filelist[i][3]).."/" 
23554   end
23555  end
23556  if trace_details then
23557   report_resolving("checking filename %a in tree",filename)
23558  end
23559  for k=1,#pathlist do
23560   local entry=pathlist[k]
23561   local path=entry.path
23562   local pathname=entry.pathname
23563   local done=false
23564   if filelist then
23565    local expression=entry.expression
23566    if trace_details then
23567     report_resolving("using pattern %a for path %a",expression,pathname)
23568    end
23569    for k=1,#filelist do
23570     local fl=filelist[k]
23571     local f=fl[2]
23572     local d=dirlist[k]
23573     if find(d,expression) or find(resolveprefix(d),expression) then
23574      result[#result+1]=resolveprefix(fl[3]) 
23575      done=true
23576      if allresults then
23577       if trace_details then
23578        report_resolving("match to %a in hash for file %a and path %a, continue scanning",expression,f,d)
23579       end
23580      else
23581       if trace_details then
23582        report_resolving("match to %a in hash for file %a and path %a, quit scanning",expression,f,d)
23583       end
23584       break
23585      end
23586     elseif trace_details then
23587      report_resolving("no match to %a in hash for file %a and path %a",expression,f,d)
23588     end
23589    end
23590   end
23591   if done then
23592    method="database"
23593   else
23594    method="filesystem" 
23595    local scheme=entry.scheme
23596    if not scheme or scheme=="file" then
23597     local pname=entry.schemename
23598     if not find(pname,"*",1,true) then
23599      if can_be_dir(pname) then
23600       if not done and not entry.prescanned then
23601        if trace_details then
23602         report_resolving("quick root scan for %a",pname)
23603        end
23604        for k=1,#wantedfiles do
23605         local w=wantedfiles[k]
23606         local fname=check_subpath(filejoin(pname,w))
23607         if fname then
23608          result[#result+1]=fname
23609          done=true
23610          if not allresults then
23611           break
23612          end
23613         end
23614        end
23615        if not done and entry.recursive then
23616         if trace_details then
23617          report_resolving("scanning filesystem for %a",pname)
23618         end
23619         local files=resolvers.simplescanfiles(pname,false,true)
23620         for k=1,#wantedfiles do
23621          local w=wantedfiles[k]
23622          local subpath=files[w]
23623          if not subpath or subpath=="" then
23624          elseif type(subpath)=="string" then
23625           local fname=check_subpath(filejoin(pname,subpath,w))
23626           if fname then
23627            result[#result+1]=fname
23628            done=true
23629            if not allresults then
23630             break
23631            end
23632           end
23633          else
23634           for i=1,#subpath do
23635            local sp=subpath[i]
23636            if sp=="" then
23637            else
23638             local fname=check_subpath(filejoin(pname,sp,w))
23639             if fname then
23640              result[#result+1]=fname
23641              done=true
23642              if not allresults then
23643               break
23644              end
23645             end
23646            end
23647           end
23648           if done and not allresults then
23649            break
23650           end
23651          end
23652         end
23653        end
23654       end
23655      end
23656     else
23657     end
23658    else
23659     for k=1,#wantedfiles do
23660      local pname=entry.barename
23661      local fname=methodhandler('finders',pname.."/"..wantedfiles[k])
23662      if fname then
23663       result[#result+1]=fname
23664       done=true
23665       if not allresults then
23666        break
23667       end
23668      end
23669     end
23670    end
23671   end
23672   if done and not allresults then
23673    break
23674   end
23675  end
23676  if #result>0 then
23677   return method,result
23678  end
23679 end
23680end
23681local function find_onpath(filename,filetype,wantedfiles,allresults)
23682 if trace_details then
23683  report_resolving("checking filename %a, filetype %a, wanted files %a",filename,filetype,concat(wantedfiles," | "))
23684 end
23685 local result={}
23686 for k=1,#wantedfiles do
23687  local fname=wantedfiles[k]
23688  if fname and isreadable(fname) then
23689   filename=fname
23690   result[#result+1]=filejoin('.',fname)
23691   if not allresults then
23692    break
23693   end
23694  end
23695 end
23696 if #result>0 then
23697  return "onpath",result
23698 end
23699end
23700local function find_otherwise(filename,filetype,wantedfiles,allresults) 
23701 local filelist=collect_files(wantedfiles)
23702 local fl=filelist and filelist[1]
23703 if fl then
23704  return "otherwise",{ resolveprefix(fl[3]) } 
23705 end
23706end
23707collect_instance_files=function(filename,askedformat,allresults) 
23708 if not filename or filename=="" then
23709  return {}
23710 end
23711 askedformat=askedformat or ""
23712 filename=collapsepath(filename,".")
23713 filename=gsub(filename,"^%./",getcurrentdir().."/") 
23714 if allresults then
23715  local filetype,wantedfiles=find_analyze(filename,askedformat)
23716  local results={
23717   { find_direct   (filename,true) },
23718   { find_wildcard (filename,true) },
23719   { find_qualified(filename,true,askedformat) },
23720   { find_intree   (filename,filetype,wantedfiles,true) },
23721   { find_onpath   (filename,filetype,wantedfiles,true) },
23722   { find_otherwise(filename,filetype,wantedfiles,true) },
23723  }
23724  local result={}
23725  local status={}
23726  local done={}
23727  for k=1,#results do
23728   local r=results[k]
23729   local method,list=r[1],r[2]
23730   if method and list then
23731    for i=1,#list do
23732     local c=collapsepath(list[i])
23733     if not done[c] then
23734      result[#result+1]=c
23735      done[c]=true
23736     end
23737     status[#status+1]=formatters["%-10s: %s"](method,c)
23738    end
23739   end
23740  end
23741  if trace_details then
23742   report_resolving("lookup status: %s",table.serialize(status,filename))
23743  end
23744  return result,status
23745 else
23746  local method,result,stamp,filetype,wantedfiles
23747  if instance.remember then
23748   if askedformat=="" then
23749    stamp=formatters["%s::%s"](suffixonly(filename),filename)
23750   else
23751    stamp=formatters["%s::%s"](askedformat,filename)
23752   end
23753   result=stamp and instance.found[stamp]
23754   if result then
23755    if trace_locating then
23756     report_resolving("remembered file %a",filename)
23757    end
23758    return result
23759   end
23760  end
23761  method,result=find_direct(filename)
23762  if not result then
23763   method,result=find_wildcard(filename)
23764   if not result then
23765    method,result=find_qualified(filename,false,askedformat)
23766    if not result then
23767     filetype,wantedfiles=find_analyze(filename,askedformat)
23768     method,result=find_intree(filename,filetype,wantedfiles)
23769     if not result then
23770      method,result=find_onpath(filename,filetype,wantedfiles)
23771      if resolve_otherwise and not result then
23772       method,result=find_otherwise(filename,filetype,wantedfiles)
23773      end
23774     end
23775    end
23776   end
23777  end
23778  if result and #result>0 then
23779   local foundname=collapsepath(result[1])
23780   resolvers.registerintrees(filename,askedformat,filetype,method,foundname)
23781   result={ foundname }
23782  else
23783   result={} 
23784  end
23785  if stamp then
23786   if trace_locating then
23787    report_resolving("remembering file %a using hash %a",filename,stamp)
23788   end
23789   instance.found[stamp]=result
23790  end
23791  return result
23792 end
23793end
23794local function findfiles(filename,filetype,allresults)
23795 if not filename or filename=="" then
23796  return {}
23797 end
23798 if allresults==nil then
23799  allresults=true
23800 end
23801 local result,status=collect_instance_files(filename,filetype or "",allresults)
23802 if not result or #result==0 then
23803  local lowered=lower(filename)
23804  if filename~=lowered then
23805   result,status=collect_instance_files(lowered,filetype or "",allresults)
23806  end
23807 end
23808 return result or {},status
23809end
23810local function findfile(filename,filetype)
23811 if not filename or filename=="" then
23812  return ""
23813 else
23814  return findfiles(filename,filetype,false)[1] or ""
23815 end
23816end
23817resolvers.findfiles=findfiles
23818resolvers.findfile=findfile
23819resolvers.find_file=findfile  
23820resolvers.find_files=findfiles 
23821function resolvers.findpath(filename,filetype)
23822 return filedirname(findfiles(filename,filetype,false)[1] or "")
23823end
23824local function findgivenfiles(filename,allresults)
23825 local hashes=instance.hashes
23826 local files=instance.files
23827 local base=filebasename(filename)
23828 local result={}
23829 local function okay(hash,path,name)
23830  local found=methodhandler('concatinators',hash.type,hash.name,path,name)
23831  if found and found~="" then
23832   result[#result+1]=resolveprefix(found)
23833   return not allresults
23834  end
23835 end
23836 for k=1,#hashes do
23837  local hash=hashes[k]
23838  local content=files[hash.name]
23839  if content then
23840   local path,name=lookup(content,base)
23841   if not path then
23842   elseif type(path)=="string" then
23843    if okay(hash,path,name) then
23844     return result
23845    end
23846   else
23847    for i=1,#path do
23848     if okay(hash,path[i],name) then
23849      return result
23850     end
23851    end
23852   end
23853  end
23854 end
23855 return result
23856end
23857function resolvers.findgivenfiles(filename)
23858 return findgivenfiles(filename,true)
23859end
23860function resolvers.findgivenfile(filename)
23861 return findgivenfiles(filename,false)[1] or ""
23862end
23863local makewildcard=Cs(
23864 (P("^")^0*P("/")*P(-1)+P(-1))/".*"+(P("^")^0*P("/")/"")^0*(P("*")/".*"+P("-")/"%%-"+P(".")/"%%."+P("?")/"."+P("\\")/"/"+P(1))^0
23865)
23866function resolvers.wildcardpattern(pattern)
23867 return lpegmatch(makewildcard,pattern) or pattern
23868end
23869local function findwildcardfiles(filename,allresults,result)
23870 local files=instance.files
23871 local hashes=instance.hashes
23872 local result=result or {}
23873 local base=filebasename(filename)
23874 local dirn=filedirname(filename)
23875 local path=lower(lpegmatch(makewildcard,dirn) or dirn)
23876 local name=lower(lpegmatch(makewildcard,base) or base)
23877 if find(name,"*",1,true) then
23878  local function okay(found,path,base,hashname,hashtype)
23879   if find(found,path) then
23880    local full=methodhandler('concatinators',hashtype,hashname,found,base)
23881    if full and full~="" then
23882     result[#result+1]=resolveprefix(full)
23883     return not allresults
23884    end
23885   end
23886  end
23887  for k=1,#hashes do
23888   local hash=hashes[k]
23889   local hashname=hash.name
23890   local hashtype=hash.type
23891   if hashname and hashtype then
23892    for found,base in filtered(files[hashname],name) do
23893     if type(found)=='string' then
23894      if okay(found,path,base,hashname,hashtype) then
23895       break
23896      end
23897     else
23898      for i=1,#found do
23899       if okay(found[i],path,base,hashname,hashtype) then
23900        break
23901       end
23902      end
23903     end
23904    end
23905   end
23906  end
23907 else
23908  local function okayokay(found,path,base,hashname,hashtype)
23909   if find(found,path) then
23910    local full=methodhandler('concatinators',hashtype,hashname,found,base)
23911    if full and full~="" then
23912     result[#result+1]=resolveprefix(full)
23913     return not allresults
23914    end
23915   end
23916  end
23917  for k=1,#hashes do
23918   local hash=hashes[k]
23919   local hashname=hash.name
23920   local hashtype=hash.type
23921   if hashname and hashtype then
23922    local found,base=lookup(content,base)
23923    if not found then
23924    elseif type(found)=='string' then
23925     if okay(found,path,base,hashname,hashtype) then
23926      break
23927     end
23928    else
23929     for i=1,#found do
23930      if okay(found[i],path,base,hashname,hashtype) then
23931       break
23932      end
23933     end
23934    end
23935   end
23936  end
23937 end
23938 return result
23939end
23940function resolvers.findwildcardfiles(filename,result)
23941 return findwildcardfiles(filename,true,result)
23942end
23943function resolvers.findwildcardfile(filename)
23944 return findwildcardfiles(filename,false)[1] or ""
23945end
23946do
23947 local starttiming=statistics.starttiming
23948 local stoptiming=statistics.stoptiming
23949 local elapsedtime=statistics.elapsedtime
23950 function resolvers.starttiming()
23951  starttiming(instance)
23952 end
23953 function resolvers.stoptiming()
23954  stoptiming(instance)
23955 end
23956 function resolvers.loadtime()
23957  return elapsedtime(instance)
23958 end
23959end
23960function resolvers.automount()
23961end
23962function resolvers.load(option)
23963 resolvers.starttiming()
23964 identify_configuration_files()
23965 load_configuration_files()
23966 if option~="nofiles" then
23967  load_databases()
23968  resolvers.automount()
23969 end
23970 resolvers.stoptiming()
23971 local files=instance.files
23972 return files and next(files) and true
23973end
23974local function report(str)
23975 if trace_locating then
23976  report_resolving(str) 
23977 else
23978  print(str)
23979 end
23980end
23981function resolvers.dowithfilesandreport(command,files,...) 
23982 if files and #files>0 then
23983  if trace_locating then
23984   report('') 
23985  end
23986  if type(files)=="string" then
23987   files={ files }
23988  end
23989  for f=1,#files do
23990   local file=files[f]
23991   local result=command(file,...)
23992   if type(result)=='string' then
23993    report(result)
23994   else
23995    for i=1,#result do
23996     report(result[i]) 
23997    end
23998   end
23999  end
24000 end
24001end
24002function resolvers.showpath(str)  
24003 return joinpath(expandedpathlist(resolvers.formatofvariable(str)))
24004end
24005function resolvers.registerfile(files,name,path)
24006 if files[name] then
24007  if type(files[name])=='string' then
24008   files[name]={ files[name],path }
24009  else
24010   files[name]=path
24011  end
24012 else
24013  files[name]=path
24014 end
24015end
24016function resolvers.dowithpath(name,func)
24017 local pathlist=expandedpathlist(name)
24018 for i=1,#pathlist do
24019  func("^"..cleanpath(pathlist[i]))
24020 end
24021end
24022function resolvers.dowithvariable(name,func)
24023 func(expandedvariable(name))
24024end
24025function resolvers.locateformat(name)
24026 local engine=environment.ownmain or "luatex"
24027 local barename=removesuffix(file.basename(name))
24028 local fullname=addsuffix(barename,"fmt")
24029 local fmtname=caches.getfirstreadablefile(fullname,"formats",engine) or ""
24030 if fmtname=="" then
24031  fmtname=findfile(fullname)
24032  fmtname=cleanpath(fmtname)
24033 end
24034 if fmtname~="" then
24035  local barename=removesuffix(fmtname)
24036  local luaname=addsuffix(barename,luasuffixes.lua)
24037  local lucname=addsuffix(barename,luasuffixes.luc)
24038  local luiname=addsuffix(barename,luasuffixes.lui)
24039  if isfile(luiname) then
24040   return fmtname,luiname
24041  elseif isfile(lucname) then
24042   return fmtname,lucname
24043  elseif isfile(luaname) then
24044   return fmtname,luaname
24045  end
24046 end
24047 return nil,nil
24048end
24049function resolvers.booleanvariable(str,default)
24050 local b=expansion(str)
24051 if b=="" then
24052  return default
24053 else
24054  b=toboolean(b)
24055  return (b==nil and default) or b
24056 end
24057end
24058function resolvers.dowithfilesintree(pattern,handle,before,after) 
24059 local hashes=instance.hashes
24060 local files=instance.files
24061 for i=1,#hashes do
24062  local hash=hashes[i]
24063  local blobtype=hash.type
24064  local blobpath=hash.name
24065  if blobtype and blobpath then
24066   local total=0
24067   local checked=0
24068   local done=0
24069   if before then
24070    before(blobtype,blobpath,pattern)
24071   end
24072   for path,name in filtered(files[blobpath],pattern) do
24073    if type(path)=="string" then
24074     checked=checked+1
24075     if handle(blobtype,blobpath,path,name) then
24076      done=done+1
24077     end
24078    else
24079     checked=checked+#path
24080     for i=1,#path do
24081      if handle(blobtype,blobpath,path[i],name) then
24082       done=done+1
24083      end
24084     end
24085    end
24086   end
24087   if after then
24088    after(blobtype,blobpath,pattern,checked,done)
24089   end
24090  end
24091 end
24092end
24093function resolvers.knownvariables(pattern)
24094 if instance then
24095  local environment=instance.environment
24096  local variables=instance.variables
24097  local expansions=instance.expansions
24098  local order=instance.order
24099  local pattern=upper(pattern or "")
24100  local result={}
24101  for i=1,#order do
24102   for key in next,order[i] do
24103    if result[key]==nil and key~="" and (pattern=="" or find(upper(key),pattern)) then
24104     result[key]={
24105      environment=rawget(environment,key),
24106      variable=key,
24107      expansion=expansions[key],
24108      resolved=resolveprefix(expansions[key]),
24109     }
24110    end
24111   end
24112  end
24113  return result
24114 else
24115  return {}
24116 end
24117end
24118
24119
24120end -- of closure
24121
24122do -- create closure to overcome 200 locals limit
24123
24124package.loaded["data-pre"] = package.loaded["data-pre"] or true
24125
24126-- original size: 5872, stripped down to: 3691
24127
24128if not modules then modules={} end modules ['data-pre']={
24129 version=1.001,
24130 comment="companion to luat-lib.mkiv",
24131 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
24132 copyright="PRAGMA ADE / ConTeXt Development Team",
24133 license="see context related readme files"
24134}
24135local ipairs=ipairs
24136local insert,remove=table.insert,table.remove
24137local resolvers=resolvers
24138local prefixes=resolvers.prefixes
24139local cleanpath=resolvers.cleanpath
24140local findgivenfile=resolvers.findgivenfile
24141local expansion=resolvers.expansion
24142local getenv=resolvers.getenv 
24143local basename=file.basename
24144local dirname=file.dirname
24145local joinpath=file.join
24146local isfile=lfs.isfile
24147local isdir=lfs.isdir
24148prefixes.environment=function(str)
24149 return cleanpath(expansion(str))
24150end
24151local function relative(str,n)
24152 if not isfile(str) then
24153  local pstr="./"..str
24154  if isfile(pstr) then
24155   str=pstr
24156  else
24157   local p="../"
24158   for i=1,n or 2 do
24159    local pstr=p..str
24160    if isfile(pstr) then
24161     str=pstr
24162     break
24163    else
24164     p=p.."../"
24165    end
24166   end
24167  end
24168 end
24169 return cleanpath(str)
24170end
24171local function locate(str)
24172 local fullname=findgivenfile(str) or ""
24173 return cleanpath(fullname~="" and fullname or str)
24174end
24175prefixes.relative=relative
24176prefixes.locate=locate
24177prefixes.auto=function(str)
24178 local fullname=relative(str)
24179 if not isfile(fullname) then
24180  fullname=locate(str)
24181 end
24182 return fullname
24183end
24184prefixes.filename=function(str)
24185 local fullname=findgivenfile(str) or ""
24186 return cleanpath(basename((fullname~="" and fullname) or str)) 
24187end
24188prefixes.pathname=function(str)
24189 local fullname=findgivenfile(str) or ""
24190 return cleanpath(dirname((fullname~="" and fullname) or str))
24191end
24192prefixes.selfautoloc=function(str)
24193 local pth=getenv('SELFAUTOLOC')
24194 return cleanpath(str and joinpath(pth,str) or pth)
24195end
24196prefixes.selfautoparent=function(str)
24197 local pth=getenv('SELFAUTOPARENT')
24198 return cleanpath(str and joinpath(pth,str) or pth)
24199end
24200prefixes.selfautodir=function(str)
24201 local pth=getenv('SELFAUTODIR')
24202 return cleanpath(str and joinpath(pth,str) or pth)
24203end
24204prefixes.home=function(str)
24205 local pth=getenv('HOME')
24206 return cleanpath(str and joinpath(pth,str) or pth)
24207end
24208do
24209 local tmppth
24210 prefixes.temp=function(str)
24211  if not tmppth then
24212   for _,s in ipairs { "TMP","TEMP","TMPDIR","TEMPDIR" } do
24213    tmppth=getenv(s)
24214    if tmppth~="" and isdir(tmppth) then
24215     break
24216    end
24217   end
24218   if not tmppth or tmppth=="" then
24219    tmppth="."
24220   end
24221  end
24222  return cleanpath(str and joinpath(tmppth,str) or tmppth)
24223 end
24224 prefixes.texruns=function(str)
24225  local pth=getenv('TEXRUNS')
24226  if pth=="" then
24227   pth=tmppth
24228  end
24229  return cleanpath(str and joinpath(pth,str) or pth)
24230 end
24231end
24232prefixes.env=prefixes.environment
24233prefixes.rel=prefixes.relative
24234prefixes.loc=prefixes.locate
24235prefixes.kpse=prefixes.locate
24236prefixes.full=prefixes.locate
24237prefixes.file=prefixes.filename
24238prefixes.path=prefixes.pathname
24239local inputstack={}
24240local stackpath=resolvers.stackpath
24241local function toppath()
24242 if not inputstack then      
24243  return "."
24244 end
24245 local pathname=dirname(inputstack[#inputstack] or "")
24246 if pathname=="" then
24247  return "."
24248 else
24249  return pathname
24250 end
24251end
24252local function jobpath()
24253 local path=stackpath()
24254 if not path or path=="" then
24255  return "."
24256 else
24257  return path
24258 end
24259end
24260local function pushinputname(name)
24261 insert(inputstack,name)
24262end
24263local function popinputname(name)
24264 return remove(inputstack)
24265end
24266resolvers.toppath=toppath
24267resolvers.jobpath=jobpath
24268resolvers.pushinputname=pushinputname
24269resolvers.popinputname=popinputname
24270prefixes.toppath=function(str) return cleanpath(joinpath(toppath(),str)) end 
24271prefixes.jobpath=function(str) return cleanpath(joinpath(jobpath(),str)) end 
24272resolvers.setdynamic("toppath")
24273resolvers.setdynamic("jobpath")
24274
24275
24276end -- of closure
24277
24278do -- create closure to overcome 200 locals limit
24279
24280package.loaded["data-inp"] = package.loaded["data-inp"] or true
24281
24282-- original size: 1050, stripped down to: 946
24283
24284if not modules then modules={} end modules ['data-inp']={
24285 version=1.001,
24286 comment="companion to luat-lib.mkiv",
24287 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
24288 copyright="PRAGMA ADE / ConTeXt Development Team",
24289 license="see context related readme files"
24290}
24291local allocate=utilities.storage.allocate
24292local resolvers=resolvers
24293local methodhandler=resolvers.methodhandler
24294local registermethod=resolvers.registermethod
24295local finders=allocate { helpers={},notfound=function() end }
24296local openers=allocate { helpers={},notfound=function() end }
24297local loaders=allocate { helpers={},notfound=function() return false,nil,0 end }
24298local tracers=allocate { helpers={},notfound=function() end }
24299registermethod("finders",finders,"uri")
24300registermethod("openers",openers,"uri")
24301registermethod("loaders",loaders,"uri")
24302registermethod("tracers",tracers,"uri")
24303resolvers.finders=finders
24304resolvers.openers=openers
24305resolvers.loaders=loaders
24306resolvers.tracers=tracers
24307
24308
24309end -- of closure
24310
24311do -- create closure to overcome 200 locals limit
24312
24313package.loaded["data-out"] = package.loaded["data-out"] or true
24314
24315-- original size: 682, stripped down to: 579
24316
24317if not modules then modules={} end modules ['data-out']={
24318 version=1.001,
24319 comment="companion to luat-lib.mkiv",
24320 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
24321 copyright="PRAGMA ADE / ConTeXt Development Team",
24322 license="see context related readme files"
24323}
24324local allocate=utilities.storage.allocate
24325local resolvers=resolvers
24326local registermethod=resolvers.registermethod
24327local savers=allocate { helpers={} }
24328resolvers.savers=savers
24329local cleaners=allocate { helpers={} }
24330resolvers.cleaners=cleaners
24331registermethod("savers",savers,"uri")
24332registermethod("cleaners",cleaners,"uri")
24333
24334
24335end -- of closure
24336
24337do -- create closure to overcome 200 locals limit
24338
24339package.loaded["data-fil"] = package.loaded["data-fil"] or true
24340
24341-- original size: 4365, stripped down to: 3452
24342
24343if not modules then modules={} end modules ['data-fil']={
24344 version=1.001,
24345 comment="companion to luat-lib.mkiv",
24346 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
24347 copyright="PRAGMA ADE / ConTeXt Development Team",
24348 license="see context related readme files"
24349}
24350local ioopen=io.open
24351local isdir=lfs.isdir
24352local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
24353local report_files=logs.reporter("resolvers","files")
24354local resolvers=resolvers
24355local resolveprefix=resolvers.resolve
24356local findfile=resolvers.findfile
24357local scanfiles=resolvers.scanfiles
24358local registerfilehash=resolvers.registerfilehash
24359local appendhash=resolvers.appendhash
24360local loadcachecontent=caches.loadcontent
24361function resolvers.locators.file(specification)
24362 local filename=specification.filename
24363 local realname=resolveprefix(filename) 
24364 if realname and realname~='' and isdir(realname) then
24365  if trace_locating then
24366   report_files("file locator %a found as %a",filename,realname)
24367  end
24368  appendhash('file',filename,true) 
24369 elseif trace_locating then
24370  report_files("file locator %a not found",filename)
24371 end
24372end
24373function resolvers.hashers.file(specification)
24374 local pathname=specification.filename
24375 local content=loadcachecontent(pathname,'files')
24376 registerfilehash(pathname,content,content==nil)
24377end
24378function resolvers.generators.file(specification)
24379 local pathname=specification.filename
24380 local content=scanfiles(pathname,false,true) 
24381 registerfilehash(pathname,content,true)
24382end
24383resolvers.concatinators.file=file.join
24384local finders=resolvers.finders
24385local notfound=finders.notfound
24386function finders.file(specification,filetype)
24387 local filename=specification.filename
24388 local foundname=findfile(filename,filetype)
24389 if foundname and foundname~="" then
24390  if trace_locating then
24391   report_files("file finder: %a found",filename)
24392  end
24393  return foundname
24394 else
24395  if trace_locating then
24396   report_files("file finder: %a not found",filename)
24397  end
24398  return notfound()
24399 end
24400end
24401local openers=resolvers.openers
24402local notfound=openers.notfound
24403local overloaded=false
24404local function textopener(tag,filename,f)
24405 return {
24406  reader=function() return f:read () end,
24407  close=function() return f:close() end,
24408 }
24409end
24410function openers.helpers.textopener(...)
24411 return textopener(...)
24412end
24413function openers.helpers.settextopener(opener)
24414 if overloaded then
24415  report_files("file opener: %s overloaded","already")
24416 else
24417  if trace_locating then
24418   report_files("file opener: %s overloaded","once")
24419  end
24420  overloaded=true
24421  textopener=opener
24422 end
24423end
24424function openers.file(specification,filetype)
24425 local filename=specification.filename
24426 if filename and filename~="" then
24427  local f=ioopen(filename,"r")
24428  if f then
24429   if trace_locating then
24430    report_files("file opener: %a opened",filename)
24431   end
24432   return textopener("file",filename,f)
24433  end
24434 end
24435 if trace_locating then
24436  report_files("file opener: %a not found",filename)
24437 end
24438 return notfound()
24439end
24440local loaders=resolvers.loaders
24441local notfound=loaders.notfound
24442function loaders.file(specification,filetype)
24443 local filename=specification.filename
24444 if filename and filename~="" then
24445  local f=ioopen(filename,"rb")
24446  if f then
24447   if trace_locating then
24448    report_files("file loader: %a loaded",filename)
24449   end
24450   local s=f:read("*a")
24451   f:close()
24452   if s then
24453    return true,s,#s
24454   end
24455  end
24456 end
24457 if trace_locating then
24458  report_files("file loader: %a not found",filename)
24459 end
24460 return notfound()
24461end
24462
24463
24464end -- of closure
24465
24466do -- create closure to overcome 200 locals limit
24467
24468package.loaded["data-con"] = package.loaded["data-con"] or true
24469
24470-- original size: 5733, stripped down to: 3900
24471
24472if not modules then modules={} end modules ['data-con']={
24473 version=1.100,
24474 comment="companion to luat-lib.mkiv",
24475 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
24476 copyright="PRAGMA ADE / ConTeXt Development Team",
24477 license="see context related readme files"
24478}
24479local setmetatable=setmetatable
24480local format,lower,gsub=string.format,string.lower,string.gsub
24481local trace_cache=false  trackers.register("resolvers.cache",function(v) trace_cache=v end)
24482local trace_containers=false  trackers.register("resolvers.containers",function(v) trace_containers=v end)
24483local trace_storage=false  trackers.register("resolvers.storage",function(v) trace_storage=v end)
24484containers=containers or {}
24485local containers=containers
24486containers.usecache=true
24487local getwritablepath=caches.getwritablepath
24488local getreadablepaths=caches.getreadablepaths
24489local cacheiswritable=caches.is_writable
24490local loaddatafromcache=caches.loaddata
24491local savedataincache=caches.savedata
24492local report_containers=logs.reporter("resolvers","containers")
24493local allocated={}
24494local cache_format=1.001 
24495local mt={
24496 __index=function(t,k)
24497  if k=="writable" then
24498   local writable=getwritablepath(t.category,t.subcategory) or { "." }
24499   t.writable=writable
24500   return writable
24501  elseif k=="readables" then
24502   local readables=getreadablepaths(t.category,t.subcategory) or { "." }
24503   t.readables=readables
24504   return readables
24505  end
24506 end,
24507 __storage__=true
24508}
24509function containers.define(category,subcategory,version,enabled,reload)
24510 if category and subcategory then
24511  local c=allocated[category]
24512  if not c then
24513   c={}
24514   allocated[category]=c
24515  end
24516  local s=c[subcategory]
24517  if not s then
24518   s={
24519    category=category,
24520    subcategory=subcategory,
24521    storage={},
24522    enabled=enabled,
24523    reload=reload,
24524    version=version or math.pi,
24525    trace=false,
24526   }
24527   setmetatable(s,mt)
24528   c[subcategory]=s
24529  end
24530  return s
24531 end
24532end
24533function containers.is_usable(container,name)
24534 return container.enabled and caches and cacheiswritable(container.writable,name)
24535end
24536function containers.is_valid(container,name)
24537 if name and name~="" then
24538  local storage=container.storage[name]
24539  return storage
24540   and storage.cache_format==cache_format 
24541   and storage.cache_version==container.version
24542 else
24543  return false
24544 end
24545end
24546function containers.read(container,name)
24547 local storage=container.storage
24548 local reload=container.reload
24549 local stored=not reload and storage[name]
24550 if not stored and container.enabled and caches and containers.usecache then
24551  stored=loaddatafromcache(container.readables,name,container.writable)
24552  if stored and stored.cache_format==cache_format and stored.cache_version==container.version then
24553   if trace_cache or trace_containers then
24554    report_containers("action %a, category %a, name %a","load",container.subcategory,name)
24555   end
24556  else
24557   stored=nil
24558  end
24559  storage[name]=stored
24560 elseif stored then
24561  if trace_cache or trace_containers then
24562   report_containers("action %a, category %a, name %a","reuse",container.subcategory,name)
24563  end
24564 end
24565 return stored
24566end
24567function containers.write(container,name,data,fast)
24568 if data then
24569  data.cache_format=cache_format
24570  data.cache_version=container.version
24571  if container.enabled and caches then
24572   local unique=data.unique
24573   local shared=data.shared
24574   data.unique=nil
24575   data.shared=nil
24576   savedataincache(container.writable,name,data,fast)
24577   if trace_cache or trace_containers then
24578    report_containers("action %a, category %a, name %a","save",container.subcategory,name)
24579   end
24580   data.unique=unique
24581   data.shared=shared
24582  end
24583  if trace_cache or trace_containers then
24584   report_containers("action %a, category %a, name %a","store",container.subcategory,name)
24585  end
24586  container.storage[name]=data
24587 end
24588 return data
24589end
24590function containers.content(container,name)
24591 return container.storage[name]
24592end
24593function containers.cleanname(name)
24594 return (gsub(lower(name),"[^%w\128-\255]+","-")) 
24595end
24596
24597
24598end -- of closure
24599
24600do -- create closure to overcome 200 locals limit
24601
24602package.loaded["data-use"] = package.loaded["data-use"] or true
24603
24604-- original size: 6168, stripped down to: 3201
24605
24606if not modules then modules={} end modules ['data-use']={
24607 version=1.001,
24608 comment="companion to luat-lib.mkiv",
24609 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
24610 copyright="PRAGMA ADE / ConTeXt Development Team",
24611 license="see context related readme files"
24612}
24613local format=string.format
24614local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
24615local report_mounts=logs.reporter("resolvers","mounts")
24616local resolvers=resolvers
24617local findfile=resolvers.findfile
24618statistics.register("used config file",function() return caches.configfiles() end)
24619statistics.register("used cache path",function() return caches.usedpaths() end)
24620function statistics.savefmtstatus(texname,formatbanner,sourcefile,banner) 
24621 local enginebanner=status.banner
24622 if formatbanner and enginebanner and sourcefile then
24623  local luvname=file.replacesuffix(texname,"luv") 
24624  local luvdata={
24625   enginebanner=enginebanner,
24626   formatbanner=formatbanner,
24627   sourcehash=md5.hex(io.loaddata(findfile(sourcefile)) or "unknown"),
24628   sourcefile=sourcefile,
24629   luaversion=LUAVERSION,
24630   luaformat=LUAFORMAT or 0,
24631   formatid=LUATEXFORMATID,
24632   functionality=LUATEXFUNCTIONALITY,
24633  }
24634  io.savedata(luvname,table.serialize(luvdata,true))
24635  lua.registerinitexfinalizer(function()
24636   if jit then
24637    logs.report("format banner","%s  lua: %s jit",banner,LUAVERSION)
24638   else
24639    logs.report("format banner","%s  lua: %s, format: %s",banner,LUAVERSION,LUAFORMAT)
24640   end
24641   logs.newline()
24642  end,"show banner")
24643 end
24644end
24645function statistics.checkfmtstatus(texname)
24646 local enginebanner=status.banner
24647 if enginebanner and texname then
24648  local luvname=file.replacesuffix(texname,"luv") 
24649  if lfs.isfile(luvname) then
24650   local luv=dofile(luvname)
24651   if luv and luv.sourcefile then
24652    local sourcehash=md5.hex(io.loaddata(findfile(luv.sourcefile)) or "unknown")
24653    local luvbanner=luv.enginebanner or "?"
24654    if luvbanner~=enginebanner then
24655     return format("engine mismatch (luv: %s <> bin: %s)",luvbanner,enginebanner)
24656    end
24657    local luvhash=luv.sourcehash or "?"
24658    if luvhash~=sourcehash then
24659     return format("source mismatch (luv: %s <> bin: %s)",luvhash,sourcehash)
24660    end
24661    local luvluaversion=luv.luaversion or 0
24662    local engluaversion=LUAVERSION or 0
24663    if luvluaversion~=engluaversion then
24664     return format("lua mismatch (luv: %s <> bin: %s)",luvluaversion,engluaversion)
24665    end
24666    local luvluaformat=luv.luaformat or 0
24667    local engluaformat=LUAFORMAT or 0
24668    if luvluaformat~=engluaformat then
24669     return format("lua bytecode format mismatch (luv: %s <> bin: %s)",luvluaformat,engluaformat)
24670    end
24671    local luvfunctionality=luv.functionality or 0
24672    local engfunctionality=status.development_id or 0
24673    if luvfunctionality~=engfunctionality then
24674     return format("functionality mismatch (luv: %s <> bin: %s)",luvfunctionality,engfunctionality)
24675    end
24676    local luvformatid=luv.formatid or 0
24677    local engformatid=status.format_id or 0
24678    if luvformatid~=engformatid then
24679     return format("formatid mismatch (luv: %s <> bin: %s)",luvformatid,engformatid)
24680    end
24681   else
24682    return "invalid status file"
24683   end
24684  else
24685   return "missing status file"
24686  end
24687 end
24688 return true
24689end
24690
24691
24692end -- of closure
24693
24694do -- create closure to overcome 200 locals limit
24695
24696package.loaded["data-zip"] = package.loaded["data-zip"] or true
24697
24698-- original size: 10789, stripped down to: 7951
24699
24700if not modules then modules={} end modules ['data-zip']={
24701 version=1.001,
24702 comment="companion to luat-lib.mkiv",
24703 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
24704 copyright="PRAGMA ADE / ConTeXt Development Team",
24705 license="see context related readme files"
24706}
24707local format,find,match=string.format,string.find,string.match
24708local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
24709local report_zip=logs.reporter("resolvers","zip")
24710local resolvers=resolvers
24711local findfile=resolvers.findfile
24712local registerfile=resolvers.registerfile
24713local splitmethod=resolvers.splitmethod
24714local prependhash=resolvers.prependhash
24715local starttiming=resolvers.starttiming
24716local extendtexmf=resolvers.extendtexmfvariable
24717local stoptiming=resolvers.stoptiming
24718local urlquery=url.query
24719zip=zip or {}
24720local zip=zip
24721local archives=zip.archives or {}
24722zip.archives=archives
24723local registeredfiles=zip.registeredfiles or {}
24724zip.registeredfiles=registeredfiles
24725local zipfiles=utilities.zipfiles
24726local openzip,closezip,validfile,wholefile,filehandle,traversezip
24727if zipfiles then
24728 local ipairs=ipairs
24729 openzip=zipfiles.open
24730 closezip=zipfiles.close
24731 validfile=zipfiles.found
24732 wholefile=zipfiles.unzip
24733 local listzip=zipfiles.list
24734 traversezip=function(zfile)
24735  return ipairs(listzip(zfile))
24736 end
24737 local streams=utilities.streams
24738 local openstream=streams.open
24739 local readstring=streams.readstring
24740 local streamsize=streams.size
24741 local metatable={ 
24742  close=streams.close,
24743  read=function(stream,n)
24744   readstring(stream,n=="*a" and streamsize(stream) or n) 
24745  end
24746 }
24747 filehandle=function(zfile,queryname)
24748  local data=wholefile(zfile,queryname)
24749  if data then
24750   local stream=openstream(data)
24751   if stream then
24752    return setmetatableindex(stream,metatable)
24753   end
24754  end
24755 end
24756else
24757 openzip=zip.open
24758 closezip=zip.close
24759 validfile=function(zfile,queryname)
24760  local dfile=zfile:open(queryname)
24761  if dfile then
24762   dfile:close()
24763   return true
24764  end
24765  return false
24766 end
24767 traversezip=function(zfile)
24768  return z:files()
24769 end
24770 wholefile=function(zfile,queryname)
24771  local dfile=zfile:open(queryname)
24772  if dfile then
24773   local s=dfile:read("*all")
24774   dfile:close()
24775   return s
24776  end
24777 end
24778 filehandle=function(zfile,queryname)
24779  local dfile=zfile:open(queryname)
24780  if dfile then
24781   return dfile
24782  end
24783 end
24784end
24785local function validzip(str) 
24786 if not find(str,"^zip://") then
24787  return "zip:///"..str
24788 else
24789  return str
24790 end
24791end
24792local function openarchive(name)
24793 if not name or name=="" then
24794  return nil
24795 else
24796  local arch=archives[name]
24797  if not arch then
24798     local full=findfile(name) or ""
24799     arch=full~="" and openzip(full) or false
24800     archives[name]=arch
24801  end
24802    return arch
24803 end
24804end
24805local function closearchive(name)
24806 if not name or (name=="" and archives[name]) then
24807  closezip(archives[name])
24808  archives[name]=nil
24809 end
24810end
24811zip.openarchive=openarchive
24812zip.closearchive=closearchive
24813function resolvers.locators.zip(specification)
24814 local archive=specification.filename
24815 local zipfile=archive and archive~="" and openarchive(archive) 
24816 if trace_locating then
24817  if zipfile then
24818   report_zip("locator: archive %a found",archive)
24819  else
24820   report_zip("locator: archive %a not found",archive)
24821  end
24822 end
24823end
24824function resolvers.concatinators.zip(zipfile,path,name) 
24825 if not path or path=="" then
24826  return format('%s?name=%s',zipfile,name)
24827 else
24828  return format('%s?name=%s/%s',zipfile,path,name)
24829 end
24830end
24831local finders=resolvers.finders
24832local notfound=finders.notfound
24833function finders.zip(specification)
24834 local original=specification.original
24835 local archive=specification.filename
24836 if archive then
24837  local query=urlquery(specification.query)
24838  local queryname=query.name
24839  if queryname then
24840   local zfile=openarchive(archive)
24841   if zfile then
24842    if trace_locating then
24843     report_zip("finder: archive %a found",archive)
24844    end
24845    if validfile(zfile,queryname) then
24846     if trace_locating then
24847      report_zip("finder: file %a found",queryname)
24848     end
24849     return specification.original
24850    elseif trace_locating then
24851     report_zip("finder: file %a not found",queryname)
24852    end
24853   elseif trace_locating then
24854    report_zip("finder: unknown archive %a",archive)
24855   end
24856  end
24857 end
24858 if trace_locating then
24859  report_zip("finder: %a not found",original)
24860 end
24861 return notfound()
24862end
24863local openers=resolvers.openers
24864local notfound=openers.notfound
24865local textopener=openers.helpers.textopener
24866function openers.zip(specification)
24867 local original=specification.original
24868 local archive=specification.filename
24869 if archive then
24870  local query=urlquery(specification.query)
24871  local queryname=query.name
24872  if queryname then
24873   local zfile=openarchive(archive)
24874   if zfile then
24875    if trace_locating then
24876     report_zip("opener; archive %a opened",archive)
24877    end
24878    local handle=filehandle(zfile,queryname)
24879    if handle then
24880     if trace_locating then
24881      report_zip("opener: file %a found",queryname)
24882     end
24883     return textopener('zip',original,handle)
24884    elseif trace_locating then
24885     report_zip("opener: file %a not found",queryname)
24886    end
24887   elseif trace_locating then
24888    report_zip("opener: unknown archive %a",archive)
24889   end
24890  end
24891 end
24892 if trace_locating then
24893  report_zip("opener: %a not found",original)
24894 end
24895 return notfound()
24896end
24897local loaders=resolvers.loaders
24898local notfound=loaders.notfound
24899function loaders.zip(specification)
24900 local original=specification.original
24901 local archive=specification.filename
24902 if archive then
24903  local query=urlquery(specification.query)
24904  local queryname=query.name
24905  if queryname then
24906   local zfile=openarchive(archive)
24907   if zfile then
24908    if trace_locating then
24909     report_zip("loader: archive %a opened",archive)
24910    end
24911    local data=wholefile(zfile,queryname)
24912    if data then
24913     if trace_locating then
24914      report_zip("loader; file %a loaded",original)
24915     end
24916     return true,data,#data
24917    elseif trace_locating then
24918     report_zip("loader: file %a not found",queryname)
24919    end
24920   elseif trace_locating then
24921    report_zip("loader; unknown archive %a",archive)
24922   end
24923  end
24924 end
24925 if trace_locating then
24926  report_zip("loader: %a not found",original)
24927 end
24928 return notfound()
24929end
24930local function registerzipfile(z,tree)
24931 local names={}
24932 local files={} 
24933 local remap={} 
24934 local n=0
24935 local filter=tree=="" and "^(.+)/(.-)$" or format("^%s/(.+)/(.-)$",tree)
24936 if trace_locating then
24937  report_zip("registering: using filter %a",filter)
24938 end
24939 starttiming()
24940 for i in traversezip(z) do
24941  local filename=i.filename
24942  local path,name=match(filename,filter)
24943  if not path then
24944   n=n+1
24945   registerfile(names,filename,"")
24946   local usedname=lower(filename)
24947   files[usedname]=""
24948   if usedname~=filename then
24949    remap[usedname]=filename
24950   end
24951  elseif name and name~="" then
24952   n=n+1
24953   register(names,name,path)
24954   local usedname=lower(name)
24955   files[usedname]=path
24956   if usedname~=name then
24957    remap[usedname]=name
24958   end
24959  else
24960  end
24961 end
24962 stoptiming()
24963 report_zip("registering: %s files registered",n)
24964 return {
24965  files=files,
24966  remap=remap,
24967 }
24968end
24969local function usezipfile(archive)
24970 local specification=splitmethod(archive) 
24971 local archive=specification.filename
24972 if archive and not registeredfiles[archive] then
24973  local z=openarchive(archive)
24974  if z then
24975   local tree=urlquery(specification.query).tree or ""
24976   if trace_locating then
24977    report_zip("registering: archive %a",archive)
24978   end
24979   prependhash('zip',archive)
24980   extendtexmf(archive) 
24981   registeredfiles[archive]=z
24982   registerfilehash(archive,registerzipfile(z,tree))
24983  elseif trace_locating then
24984   report_zip("registering: unknown archive %a",archive)
24985  end
24986 elseif trace_locating then
24987  report_zip("registering: archive %a not found",archive)
24988 end
24989end
24990resolvers.usezipfile=usezipfile
24991resolvers.registerzipfile=registerzipfile
24992function resolvers.hashers.zip(specification)
24993 local archive=specification.filename
24994 if trace_locating then
24995  report_zip("loading file %a",archive)
24996 end
24997 usezipfile(specification.original)
24998end
24999
25000
25001end -- of closure
25002
25003do -- create closure to overcome 200 locals limit
25004
25005package.loaded["data-tre"] = package.loaded["data-tre"] or true
25006
25007-- original size: 10802, stripped down to: 6619
25008
25009if not modules then modules={} end modules ['data-tre']={
25010 version=1.001,
25011 comment="companion to luat-lib.mkiv",
25012 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25013 copyright="PRAGMA ADE / ConTeXt Development Team",
25014 license="see context related readme files"
25015}
25016local type=type
25017local find,gsub,lower=string.find,string.gsub,string.lower
25018local basename,dirname,joinname=file.basename,file.dirname,file.join
25019local globdir,isdir,isfile=dir.glob,lfs.isdir,lfs.isfile
25020local P,lpegmatch=lpeg.P,lpeg.match
25021local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
25022local report_trees=logs.reporter("resolvers","trees")
25023local resolvers=resolvers
25024local finders=resolvers.finders
25025local openers=resolvers.openers
25026local loaders=resolvers.loaders
25027local locators=resolvers.locators
25028local hashers=resolvers.hashers
25029local generators=resolvers.generators
25030do
25031 local collectors={}
25032 local found={}
25033 local notfound=finders.notfound
25034 function finders.tree(specification) 
25035  local spec=specification.filename
25036  local okay=found[spec]
25037  if okay==nil then
25038   if spec~="" then
25039    local path=dirname(spec)
25040    local name=basename(spec)
25041    if path=="" then
25042     path="."
25043    end
25044    local names=collectors[path]
25045    if not names then
25046     local pattern=find(path,"/%*+$") and path or (path.."/*")
25047     names=globdir(pattern)
25048     collectors[path]=names
25049    end
25050    local pattern="/"..gsub(name,"([%.%-%+])","%%%1").."$"
25051    for i=1,#names do
25052     local fullname=names[i]
25053     if find(fullname,pattern) then
25054      found[spec]=fullname
25055      return fullname
25056     end
25057    end
25058    local pattern=lower(pattern)
25059    for i=1,#names do
25060     local fullname=lower(names[i])
25061     if find(fullname,pattern) then
25062      if isfile(fullname) then
25063       found[spec]=fullname
25064       return fullname
25065      else
25066       break
25067      end
25068     end
25069    end
25070   end
25071   okay=notfound() 
25072   found[spec]=okay
25073  end
25074  return okay
25075 end
25076end
25077do
25078 local resolveprefix=resolvers.resolve
25079 local appendhash=resolvers.appendhash
25080 local function dolocate(specification)
25081  local name=specification.filename
25082  local realname=resolveprefix(name) 
25083  if realname and realname~='' and isdir(realname) then
25084   if trace_locating then
25085    report_trees("locator %a found",realname)
25086   end
25087   appendhash('tree',name,false) 
25088  elseif trace_locating then
25089   report_trees("locator %a not found",name)
25090  end
25091 end
25092 locators.tree=dolocate
25093 locators.dirlist=dolocate
25094 locators.dirfile=dolocate
25095end
25096do
25097 local filegenerator=generators.file
25098 generators.dirlist=filegenerator
25099 generators.dirfile=filegenerator
25100end
25101do
25102 local filegenerator=generators.file
25103 local methodhandler=resolvers.methodhandler
25104 local function dohash(specification)
25105  local name=specification.filename
25106  if trace_locating then
25107   report_trees("analyzing %a",name)
25108  end
25109  methodhandler("hashers",name)
25110  filegenerator(specification)
25111 end
25112 hashers.tree=dohash
25113 hashers.dirlist=dohash
25114 hashers.dirfile=dohash
25115end
25116local resolve  do
25117 local collectors={}
25118 local splitter=lpeg.splitat("/**/")
25119 local stripper=lpeg.replacer { [P("/")*P("*")^1*P(-1)]="" }
25120 local loadcontent=caches.loadcontent
25121 local savecontent=caches.savecontent
25122 local notfound=finders.notfound
25123 local scanfiles=resolvers.scanfiles
25124 local lookup=resolvers.get_from_content
25125 table.setmetatableindex(collectors,function(t,k)
25126  local rootname=lpegmatch(stripper,k)
25127  local dataname=joinname(rootname,"dirlist")
25128  local content=loadcontent(dataname,"files",dataname)
25129  if not content then
25130   content=scanfiles(rootname,nil,nil,false,true) 
25131   savecontent(dataname,"files",content,dataname)
25132  end
25133  t[k]=content
25134  return content
25135 end)
25136 local function checked(root,p,n)
25137  if p then
25138   if type(p)=="table" then
25139    for i=1,#p do
25140     local fullname=joinname(root,p[i],n)
25141     if isfile(fullname) then 
25142      return fullname
25143     end
25144    end
25145   else
25146    local fullname=joinname(root,p,n)
25147    if isfile(fullname) then 
25148     return fullname
25149    end
25150   end
25151  end
25152  return notfound()
25153 end
25154 resolve=function(specification) 
25155  local filename=specification.filename
25156  if filename~="" then
25157   local root,rest=lpegmatch(splitter,filename)
25158   if root and rest then
25159    local path,name=dirname(rest),basename(rest)
25160    if name~=rest then
25161     local content=collectors[root]
25162     local p,n=lookup(content,name)
25163     if not p then
25164      return notfound()
25165     end
25166     local pattern=".*/"..path.."$"
25167     local istable=type(p)=="table"
25168     if istable then
25169      for i=1,#p do
25170       local pi=p[i]
25171       if pi==path or find(pi,pattern) then
25172        local fullname=joinname(root,pi,n)
25173        if isfile(fullname) then 
25174         return fullname
25175        end
25176       end
25177      end
25178     elseif p==path or find(p,pattern) then
25179      local fullname=joinname(root,p,n)
25180      if isfile(fullname) then 
25181       return fullname
25182      end
25183     end
25184     local queries=specification.queries
25185     if queries and queries.option=="fileonly" then
25186      return checked(root,p,n)
25187     else
25188      return notfound()
25189     end
25190    end
25191   end
25192   local path=dirname(filename)
25193   local name=basename(filename)
25194   local root=lpegmatch(stripper,path)
25195   local content=collectors[path]
25196   local p,n=lookup(content,name)
25197   if p then
25198    return checked(root,p,n)
25199   end
25200  end
25201  return notfound()
25202 end
25203 finders.dirlist=resolve
25204 function finders.dirfile(specification)
25205  local queries=specification.queries
25206  if queries then
25207   queries.option="fileonly"
25208  else
25209   specification.queries={ option="fileonly" }
25210  end
25211  return resolve(specification)
25212 end
25213end
25214do
25215 local fileopener=openers.file
25216 local fileloader=loaders.file
25217 openers.dirlist=fileopener
25218 loaders.dirlist=fileloader
25219 openers.dirfile=fileopener
25220 loaders.dirfile=fileloader
25221end
25222do
25223 local hashfile="dirhash.lua"
25224 local kind="HASH256"
25225 local version=1.0
25226 local loadtable=table.load
25227 local savetable=table.save
25228 local loaddata=io.loaddata
25229 function resolvers.dirstatus(patterns)
25230  local t=type(patterns)
25231  if t=="string" then
25232   patterns={ patterns }
25233  elseif t~="table" then
25234   return false
25235  end
25236  local status=loadtable(hashfile)
25237  if not status or status.version~=version or status.kind~=kind then
25238   status={
25239    version=1.0,
25240    kind=kind,
25241    hashes={},
25242   }
25243  end
25244  local hashes=status.hashes
25245  local changed={}
25246  local action=sha2[kind]
25247  local update={}
25248  for i=1,#patterns do
25249   local pattern=patterns[i]
25250   local files=globdir(pattern)
25251   for i=1,#files do
25252    local name=files[i]
25253    local hash=action(loaddata(name))
25254    if hashes[name]~=hash then
25255     changed[#changed+1]=name
25256    end
25257    update[name]=hash
25258   end
25259  end
25260  status.hashes=update
25261  savetable(hashfile,status)
25262  return #changed>0 and changed or false
25263 end
25264end
25265
25266
25267end -- of closure
25268
25269do -- create closure to overcome 200 locals limit
25270
25271package.loaded["data-sch"] = package.loaded["data-sch"] or true
25272
25273-- original size: 6945, stripped down to: 5408
25274
25275if not modules then modules={} end modules ['data-sch']={
25276 version=1.001,
25277 comment="companion to luat-lib.mkiv",
25278 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25279 copyright="PRAGMA ADE / ConTeXt Development Team",
25280 license="see context related readme files"
25281}
25282local load,tonumber=load,tonumber
25283local gsub,format=string.gsub,string.format
25284local sortedhash,concat=table.sortedhash,table.concat
25285local finders,openers,loaders=resolvers.finders,resolvers.openers,resolvers.loaders
25286local addsuffix,suffix,splitbase=file.addsuffix,file.suffix,file.splitbase
25287local md5hex=md5.hex
25288local trace_schemes=false  trackers.register("resolvers.schemes",function(v) trace_schemes=v end)
25289local report_schemes=logs.reporter("resolvers","schemes")
25290local http=require("socket.http")
25291local ltn12=require("ltn12")
25292if mbox then mbox=nil end 
25293local resolvers=resolvers
25294local schemes=resolvers.schemes or {}
25295resolvers.schemes=schemes
25296local cleaners={}
25297schemes.cleaners=cleaners
25298local threshold=24*60*60
25299directives.register("schemes.threshold",function(v) threshold=tonumber(v) or threshold end)
25300function cleaners.none(specification)
25301 return specification.original
25302end
25303function cleaners.strip(specification) 
25304 local path,name=splitbase(specification.original)
25305 if path=="" then
25306  return (gsub(name,"[^%a%d%.]+","-"))
25307 else
25308  return (gsub((gsub(path,"%.","-").."-"..name),"[^%a%d%.]+","-"))
25309 end
25310end
25311function cleaners.md5(specification)
25312 return addsuffix(md5hex(specification.original),suffix(specification.path))
25313end
25314local cleaner=cleaners.strip
25315directives.register("schemes.cleanmethod",function(v) cleaner=cleaners[v] or cleaners.strip end)
25316function resolvers.schemes.cleanname(specification)
25317 local hash=cleaner(specification)
25318 if trace_schemes then
25319  report_schemes("hashing %a to %a",specification.original,hash)
25320 end
25321 return hash
25322end
25323local cached={}
25324local loaded={}
25325local reused={}
25326local thresholds={}
25327local handlers={}
25328local runner=sandbox.registerrunner {
25329 name="curl resolver",
25330 method="execute",
25331 program="curl",
25332 template='--silent --insecure --create-dirs --output "%cachename%" "%original%"',
25333 checkers={
25334  cachename="cache",
25335  original="url",
25336 }
25337}
25338local function fetch(specification)
25339 local original=specification.original
25340 local scheme=specification.scheme
25341 local cleanname=schemes.cleanname(specification)
25342 local cachename=caches.setfirstwritablefile(cleanname,"schemes")
25343 if not cached[original] then
25344  statistics.starttiming(schemes)
25345  if not io.exists(cachename) or (os.difftime(os.time(),lfs.attributes(cachename).modification)>(thresholds[protocol] or threshold)) then
25346   cached[original]=cachename
25347   local handler=handlers[scheme]
25348   if handler then
25349    if trace_schemes then
25350     report_schemes("fetching %a, protocol %a, method %a",original,scheme,"built-in")
25351    end
25352    logs.flush()
25353    handler(specification,cachename)
25354   else
25355    if trace_schemes then
25356     report_schemes("fetching %a, protocol %a, method %a",original,scheme,"curl")
25357    end
25358    logs.flush()
25359    runner {
25360     original=original,
25361     cachename=cachename,
25362    }
25363   end
25364  end
25365  if io.exists(cachename) then
25366   cached[original]=cachename
25367   if trace_schemes then
25368    report_schemes("using cached %a, protocol %a, cachename %a",original,scheme,cachename)
25369   end
25370  else
25371   cached[original]=""
25372   if trace_schemes then
25373    report_schemes("using missing %a, protocol %a",original,scheme)
25374   end
25375  end
25376  loaded[scheme]=loaded[scheme]+1
25377  statistics.stoptiming(schemes)
25378 else
25379  if trace_schemes then
25380   report_schemes("reusing %a, protocol %a",original,scheme)
25381  end
25382  reused[scheme]=reused[scheme]+1
25383 end
25384 return cached[original]
25385end
25386local function finder(specification,filetype)
25387 return resolvers.methodhandler("finders",fetch(specification),filetype)
25388end
25389local opener=openers.file
25390local loader=loaders.file
25391local function install(scheme,handler,newthreshold)
25392 handlers  [scheme]=handler
25393 loaded [scheme]=0
25394 reused [scheme]=0
25395 finders   [scheme]=finder
25396 openers   [scheme]=opener
25397 loaders   [scheme]=loader
25398 thresholds[scheme]=newthreshold or threshold
25399end
25400schemes.install=install
25401local function http_handler(specification,cachename)
25402 local tempname=cachename..".tmp"
25403 local handle=io.open(tempname,"wb")
25404 local status,message=http.request {
25405  url=specification.original,
25406  sink=ltn12.sink.file(handle)
25407 }
25408 if not status then
25409  os.remove(tempname)
25410 else
25411  os.remove(cachename)
25412  os.rename(tempname,cachename)
25413 end
25414 return cachename
25415end
25416install('http',http_handler)
25417install('https') 
25418install('ftp')
25419statistics.register("scheme handling time",function()
25420 local l,r,nl,nr={},{},0,0
25421 for k,v in sortedhash(loaded) do
25422  if v>0 then
25423   nl=nl+1
25424   l[nl]=k..":"..v
25425  end
25426 end
25427 for k,v in sortedhash(reused) do
25428  if v>0 then
25429   nr=nr+1
25430   r[nr]=k..":"..v
25431  end
25432 end
25433 local n=nl+nr
25434 if n>0 then
25435  if nl==0 then l={ "none" } end
25436  if nr==0 then r={ "none" } end
25437  return format("%s seconds, %s processed, threshold %s seconds, loaded: %s, reused: %s",
25438   statistics.elapsedtime(schemes),n,threshold,concat(l," "),concat(l," "))
25439 else
25440  return nil
25441 end
25442end)
25443local httprequest=http.request
25444local toquery=url.toquery
25445local function fetchstring(url,data)
25446 local q=data and toquery(data)
25447 if q then
25448  url=url.."?"..q
25449 end
25450 local reply=httprequest(url)
25451 return reply 
25452end
25453schemes.fetchstring=fetchstring
25454function schemes.fetchtable(url,data)
25455 local reply=fetchstring(url,data)
25456 if reply then
25457  local s=load("return "..reply)
25458  if s then
25459   return s()
25460  end
25461 end
25462end
25463
25464
25465end -- of closure
25466
25467do -- create closure to overcome 200 locals limit
25468
25469package.loaded["data-lua"] = package.loaded["data-lua"] or true
25470
25471-- original size: 4227, stripped down to: 3049
25472
25473if not modules then modules={} end modules ['data-lua']={
25474 version=1.001,
25475 comment="companion to luat-lib.mkiv",
25476 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25477 copyright="PRAGMA ADE / ConTeXt Development Team",
25478 license="see context related readme files"
25479}
25480local package,lpeg=package,lpeg
25481local loadfile=loadfile
25482local addsuffix=file.addsuffix
25483local P,S,Cs,lpegmatch=lpeg.P,lpeg.S,lpeg.Cs,lpeg.match
25484local luasuffixes={ 'tex','lua' }
25485local libsuffixes={ 'lib' }
25486local luaformats={ 'TEXINPUTS','LUAINPUTS' }
25487local libformats={ 'CLUAINPUTS' }
25488local helpers=package.helpers or {}
25489local methods=helpers.methods or {}
25490local resolvers=resolvers
25491local resolveprefix=resolvers.resolve
25492local expandedpaths=resolvers.expandedpathlistfromvariable
25493local findfile=resolvers.findfile
25494helpers.report=logs.reporter("resolvers","libraries")
25495trackers.register("resolvers.libraries",function(v) helpers.trace=v end)
25496trackers.register("resolvers.locating",function(v) helpers.trace=v end)
25497helpers.sequence={
25498 "already loaded",
25499 "preload table",
25500 "lua variable format",
25501 "lib variable format",
25502 "lua extra list",
25503 "lib extra list",
25504 "path specification",
25505 "cpath specification",
25506 "all in one fallback",
25507 "not loaded",
25508}
25509local pattern=Cs(P("!")^0/""*(P("/")*P(-1)/"/"+P("/")^1/"/"+1)^0)
25510function helpers.cleanpath(path) 
25511 return resolveprefix(lpegmatch(pattern,path))
25512end
25513local loadedaslib=helpers.loadedaslib
25514local registerpath=helpers.registerpath
25515local lualibfile=helpers.lualibfile
25516local luaformatpaths
25517local libformatpaths
25518local function getluaformatpaths()
25519 if not luaformatpaths then
25520  luaformatpaths={}
25521  for i=1,#luaformats do
25522   registerpath("lua format","lua",luaformatpaths,expandedpaths(luaformats[i]))
25523  end
25524 end
25525 return luaformatpaths
25526end
25527local function getlibformatpaths()
25528 if not libformatpaths then
25529  libformatpaths={}
25530  for i=1,#libformats do
25531   registerpath("lib format","lib",libformatpaths,expandedpaths(libformats[i]))
25532  end
25533 end
25534 return libformatpaths
25535end
25536local function loadedbyformat(name,rawname,suffixes,islib,what)
25537 local trace=helpers.trace
25538 local report=helpers.report
25539 for i=1,#suffixes do 
25540  local format=suffixes[i]
25541  local resolved=findfile(name,format) or ""
25542  if trace then
25543   report("%s format, identifying %a using format %a",what,name,format)
25544  end
25545  if resolved~="" then
25546   if trace then
25547    report("%s format, %a found on %a",what,name,resolved)
25548   end
25549   if islib then
25550    return loadedaslib(resolved,rawname)
25551   else
25552    return loadfile(resolved)
25553   end
25554  end
25555 end
25556end
25557helpers.loadedbyformat=loadedbyformat
25558methods["lua variable format"]=function(name)
25559 if helpers.trace then
25560  helpers.report("%s format, checking %s paths","lua",#getluaformatpaths()) 
25561 end
25562 return loadedbyformat(addsuffix(lualibfile(name),"lua"),name,luasuffixes,false,"lua")
25563end
25564methods["lib variable format"]=function(name)
25565 if helpers.trace then
25566  helpers.report("%s format, checking %s paths","lib",#getlibformatpaths()) 
25567 end
25568 return loadedbyformat(addsuffix(lualibfile(name),os.libsuffix),name,libsuffixes,true,"lib")
25569end
25570resolvers.loadlualib=require 
25571
25572
25573end -- of closure
25574
25575do -- create closure to overcome 200 locals limit
25576
25577package.loaded["data-aux"] = package.loaded["data-aux"] or true
25578
25579-- original size: 2610, stripped down to: 2019
25580
25581if not modules then modules={} end modules ['data-aux']={
25582 version=1.001,
25583 comment="companion to luat-lib.mkiv",
25584 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25585 copyright="PRAGMA ADE / ConTeXt Development Team",
25586 license="see context related readme files"
25587}
25588local find=string.find
25589local type,next=type,next
25590local addsuffix,removesuffix=file.addsuffix,file.removesuffix
25591local loaddata,savedata=io.loaddata,io.savedata
25592local trace_locating=false  trackers.register("resolvers.locating",function(v) trace_locating=v end)
25593local resolvers=resolvers
25594local cleanpath=resolvers.cleanpath
25595local findfiles=resolvers.findfiles
25596local report_scripts=logs.reporter("resolvers","scripts")
25597function resolvers.updatescript(oldname,newname)
25598 local scriptpath="context/lua"
25599 local oldscript=cleanpath(oldname)
25600 local newname=addsuffix(newname,"lua")
25601 local newscripts=findfiles(newname) or {}
25602 if trace_locating then
25603  report_scripts("to be replaced old script %a",oldscript)
25604 end
25605 if #newscripts==0 then
25606  if trace_locating then
25607   report_scripts("unable to locate new script")
25608  end
25609 else
25610  for i=1,#newscripts do
25611   local newscript=cleanpath(newscripts[i])
25612   if trace_locating then
25613    report_scripts("checking new script %a",newscript)
25614   end
25615   if oldscript==newscript then
25616    if trace_locating then
25617     report_scripts("old and new script are the same")
25618    end
25619   elseif not find(newscript,scriptpath,1,true) then
25620    if trace_locating then
25621     report_scripts("new script should come from %a",scriptpath)
25622    end
25623   elseif not (find(oldscript,removesuffix(newname).."$") or find(oldscript,newname.."$")) then
25624    if trace_locating then
25625     report_scripts("invalid new script name")
25626    end
25627   else
25628    local newdata=loaddata(newscript)
25629    if newdata then
25630     if trace_locating then
25631      report_scripts("old script content replaced by new content: %s",oldscript)
25632     end
25633     savedata(oldscript,newdata)
25634     break
25635    elseif trace_locating then
25636     report_scripts("unable to load new script")
25637    end
25638   end
25639  end
25640 end
25641end
25642
25643
25644end -- of closure
25645
25646do -- create closure to overcome 200 locals limit
25647
25648package.loaded["data-tmf"] = package.loaded["data-tmf"] or true
25649
25650-- original size: 2601, stripped down to: 1549
25651
25652if not modules then modules={} end modules ['data-tmf']={
25653 version=1.001,
25654 comment="companion to luat-lib.mkiv",
25655 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25656 copyright="PRAGMA ADE / ConTeXt Development Team",
25657 license="see context related readme files"
25658}
25659local resolvers=resolvers
25660local report_tds=logs.reporter("resolvers","tds")
25661function resolvers.load_tree(tree,resolve)
25662 if type(tree)=="string" and tree~="" then
25663  local getenv,setenv=resolvers.getenv,resolvers.setenv
25664  local texos="texmf-"..os.platform
25665  local oldroot=environment.texroot
25666  local newroot=file.collapsepath(tree)
25667  local newtree=file.join(newroot,texos)
25668  local newpath=file.join(newtree,"bin")
25669  if not lfs.isdir(newtree) then
25670   report_tds("no %a under tree %a",texos,tree)
25671   os.exit()
25672  end
25673  if not lfs.isdir(newpath) then
25674   report_tds("no '%s/bin' under tree %a",texos,tree)
25675   os.exit()
25676  end
25677  local texmfos=newtree
25678  environment.texroot=newroot
25679  environment.texos=texos
25680  environment.texmfos=texmfos
25681  if resolve then
25682   resolvers.luacnfspec=resolvers.resolve(resolvers.luacnfspec)
25683  end
25684  setenv('SELFAUTOPARENT',newroot)
25685  setenv('SELFAUTODIR',newtree)
25686  setenv('SELFAUTOLOC',newpath)
25687  setenv('TEXROOT',newroot)
25688  setenv('TEXOS',texos)
25689  setenv('TEXMFOS',texmfos)
25690  setenv('TEXMFCNF',resolvers.luacnfspec,true) 
25691  setenv('PATH',newpath..io.pathseparator..getenv('PATH'))
25692  report_tds("changing from root %a to %a",oldroot,newroot)
25693  report_tds("prepending %a to PATH",newpath)
25694  report_tds("setting TEXMFCNF to %a",resolvers.luacnfspec)
25695  report_tds()
25696 end
25697end
25698
25699
25700end -- of closure
25701
25702do -- create closure to overcome 200 locals limit
25703
25704package.loaded["data-lst"] = package.loaded["data-lst"] or true
25705
25706-- original size: 2038, stripped down to: 1696
25707
25708if not modules then modules={} end modules ['data-lst']={
25709 version=1.001,
25710 comment="companion to luat-lib.mkiv",
25711 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25712 copyright="PRAGMA ADE / ConTeXt Development Team",
25713 license="see context related readme files"
25714}
25715local type=type
25716local sortedhash=table.sortedhash
25717local isdir=lfs.isdir
25718local resolvers=resolvers
25719local listers=resolvers.listers or {}
25720resolvers.listers=listers
25721local resolveprefix=resolvers.resolve
25722local configurationfiles=resolvers.configurationfiles
25723local expandedpathfromlist=resolvers.expandedpathfromlist
25724local splitpath=resolvers.splitpath
25725local knownvariables=resolvers.knownvariables
25726local report_lists=logs.reporter("resolvers","lists")
25727local report_resolved=logs.reporter("system","resolved")
25728local function tabstr(str)
25729 if not str then
25730  return "unset"
25731 elseif type(str)=='table' then
25732  return concat(str," | ")
25733 else
25734  return str
25735 end
25736end
25737function listers.variables(pattern)
25738 local result=resolvers.knownvariables(pattern)
25739 for key,value in sortedhash(result) do
25740  report_lists(key)
25741  report_lists("  env: %s",tabstr(value.environment))
25742  report_lists("  var: %s",tabstr(value.variable))
25743  report_lists("  exp: %s",tabstr(value.expansion))
25744  report_lists("  res: %s",tabstr(value.resolved))
25745 end
25746end
25747function listers.configurations()
25748 local configurations=configurationfiles()
25749 for i=1,#configurations do
25750  report_resolved("file : %s",resolveprefix(configurations[i]))
25751 end
25752 report_resolved("")
25753 local list=expandedpathfromlist(splitpath(resolvers.luacnfspec))
25754 for i=1,#list do
25755  local li=resolveprefix(list[i])
25756  if isdir(li) then
25757   report_resolved("path - %s",li)
25758  else
25759   report_resolved("path + %s",li)
25760  end
25761 end
25762end
25763
25764
25765end -- of closure
25766
25767do -- create closure to overcome 200 locals limit
25768
25769package.loaded["libs-ini"] = package.loaded["libs-ini"] or true
25770
25771-- original size: 6524, stripped down to: 4064
25772
25773if not modules then modules={} end modules ['libs-ini']={
25774 version=1.001,
25775 comment="companion to luat-lib.mkiv",
25776 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25777 copyright="PRAGMA ADE / ConTeXt Development Team",
25778 license="see context related readme files"
25779}
25780local type,unpack=type,unpack
25781local find=string.find
25782local nameonly=file.nameonly
25783local joinfile=file.join
25784local addsuffix=file.addsuffix
25785local qualifiedpath=file.is_qualified_path
25786local isfile=lfs.isfile
25787local findfile=resolvers.findfile
25788local expandpaths=resolvers.expandedpathlistfromvariable
25789local report=logs.reporter("resolvers","libraries")
25790local trace=false
25791local silent=false
25792trackers.register("resolvers.lib",function(v) trace=v end)
25793trackers.register("resolvers.lib.silent",function(v) silent=v end)
25794local function findlib(required) 
25795 local suffix=os.libsuffix or "so"
25796 if not qualifiedpath(required) then
25797  local list=directives.value("system.librarynames" )
25798  local only=nameonly(required)
25799  if type(list)=="table" then
25800   list=list[only]
25801   if type(list)~="table" then
25802    list={ only }
25803   end
25804  else
25805   list={ only }
25806  end
25807  if trace then
25808   report("using lookup list for library %a: % | t",only,list)
25809  end
25810  for i=1,#list do
25811   local name=list[i]
25812   local found=findfile(name,"lib")
25813   if not found or found=="" then
25814    found=findfile(addsuffix(name,suffix),"lib")
25815   end
25816   if found and found~="" then
25817    if trace then
25818     report("library %a resolved via %a path to %a",name,"tds lib",found)
25819    end
25820    return found
25821   end
25822  end
25823  if expandpaths then
25824   local list=expandpaths("PATH")
25825   local base=addsuffix(only,suffix)
25826   for i=1,#list do
25827    local full=joinfile(list[i],base)
25828    local found=isfile(full) and full
25829    if found and found~="" then
25830     if trace then
25831      report("library %a resolved via %a path to %a",full,"system",found)
25832     end
25833     return found
25834    end
25835   end
25836  end
25837 elseif isfile(addsuffix(required,suffix)) then
25838  if trace then
25839   report("library with qualified name %a %sfound",required,"")
25840  end
25841  return required
25842 else
25843  if trace then
25844   report("library with qualified name %a %sfound",required,"not ")
25845  end
25846 end
25847 return false
25848end
25849local foundlibraries=table.setmetatableindex(function(t,k)
25850 local v=findlib(k)
25851 t[k]=v
25852 return v
25853end)
25854function resolvers.findlib(required)
25855 return foundlibraries[required]
25856end
25857local libraries={}
25858resolvers.libraries=libraries
25859local report=logs.reporter("optional")
25860if optional then optional.loaded={} end
25861function libraries.validoptional(name)
25862 local thelib=optional and optional[name]
25863 if not thelib then
25864 elseif thelib.initialize then
25865  return thelib
25866 else
25867  report("invalid optional library %a",libname)
25868 end
25869end
25870function libraries.optionalloaded(name,libnames)
25871 local thelib=optional and optional[name]
25872 if not thelib then
25873  report("no optional %a library found",name)
25874 else
25875  local thelib_initialize=thelib.initialize
25876  if not thelib_initialize then
25877   report("invalid optional library %a",name)
25878  else
25879   if type(libnames)=="string" then
25880    libnames={ libnames }
25881   end
25882   if type(libnames)=="table" then
25883    for i=1,#libnames do
25884     local libname=libnames[i]
25885     local filename=foundlibraries[libname]
25886     if filename and filename~="" then
25887      libnames[i]=filename
25888     else
25889      report("unable to locate library %a",libname)
25890      return
25891     end
25892    end
25893    local initialized=thelib_initialize(unpack(libnames))
25894    if not initialized then
25895     report("unable to initialize library '% + t'",libnames)
25896    elseif not silent then
25897     report("using library '% + t'",libnames)
25898    end
25899    return initialized
25900   end
25901  end
25902 end
25903end
25904if FFISUPPORTED and ffi and ffi.load then
25905 local ffiload=ffi.load
25906 function ffi.load(name)
25907  local full=name and foundlibraries[name]
25908  if full then
25909   return ffiload(full)
25910  else
25911   return ffiload(name)
25912  end
25913 end
25914end
25915local dofile=dofile
25916local savedrequire=require
25917function require(name,version)
25918 if find(name,"%.lua$") or find(name,"%.lmt$") then
25919  local m=dofile(findfile(name))
25920  if m then
25921   package.loaded[name]=m
25922   return m
25923  end
25924 else
25925  return savedrequire(name)
25926 end
25927end
25928
25929
25930end -- of closure
25931
25932do -- create closure to overcome 200 locals limit
25933
25934package.loaded["luat-sta"] = package.loaded["luat-sta"] or true
25935
25936-- original size: 5608, stripped down to: 2321
25937
25938if not modules then modules={} end modules ['luat-sta']={
25939 version=1.001,
25940 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
25941 copyright="PRAGMA ADE / ConTeXt Development Team",
25942 license="see context related readme files"
25943}
25944local gmatch,match=string.gmatch,string.match
25945local type=type
25946states=states or {}
25947local states=states
25948states.data=states.data or {}
25949local data=states.data
25950states.hash=states.hash or {}
25951local hash=states.hash
25952states.tag=states.tag   or ""
25953states.filename=states.filename or ""
25954function states.save(filename,tag)
25955 tag=tag or states.tag
25956 filename=file.addsuffix(filename or states.filename,'lus')
25957 io.savedata(filename,
25958  "-- generator : luat-sta.lua\n".."-- state tag : "..tag.."\n\n"..table.serialize(data[tag or states.tag] or {},true)
25959 )
25960end
25961function states.load(filename,tag)
25962 states.filename=filename
25963 states.tag=tag or "whatever"
25964 states.filename=file.addsuffix(states.filename,'lus')
25965 data[states.tag],hash[states.tag]=(io.exists(filename) and dofile(filename)) or {},{}
25966end
25967local function set_by_tag(tag,key,value,default,persistent)
25968 local d,h=data[tag],hash[tag]
25969 if d then
25970  if type(d)=="table" then
25971   local dkey,hkey=key,key
25972   local pre,post=match(key,"(.+)%.([^%.]+)$")
25973   if pre and post then
25974    for k in gmatch(pre,"[^%.]+") do
25975     local dk=d[k]
25976     if not dk then
25977      dk={}
25978      d[k]=dk
25979     elseif type(dk)=="string" then
25980      break
25981     end
25982     d=dk
25983    end
25984    dkey,hkey=post,key
25985   end
25986   if value==nil then
25987    value=default
25988   elseif value==false then
25989   elseif persistent then
25990    value=value or d[dkey] or default
25991   else
25992    value=value or default
25993   end
25994   d[dkey],h[hkey]=value,value
25995  elseif type(d)=="string" then
25996   data[tag],hash[tag]=value,value
25997  end
25998 end
25999end
26000local function get_by_tag(tag,key,default)
26001 local h=hash[tag]
26002 if h and h[key] then
26003  return h[key]
26004 else
26005  local d=data[tag]
26006  if d then
26007   for k in gmatch(key,"[^%.]+") do
26008    local dk=d[k]
26009    if dk~=nil then
26010     d=dk
26011    else
26012     return default
26013    end
26014   end
26015   if d==false then
26016    return false
26017   else
26018    return d or default
26019   end
26020  end
26021 end
26022end
26023states.set_by_tag=set_by_tag
26024states.get_by_tag=get_by_tag
26025function states.set(key,value,default,persistent)
26026 set_by_tag(states.tag,key,value,default,persistent)
26027end
26028function states.get(key,default)
26029 return get_by_tag(states.tag,key,default)
26030end
26031
26032
26033end -- of closure
26034
26035do -- create closure to overcome 200 locals limit
26036
26037package.loaded["luat-fmt"] = package.loaded["luat-fmt"] or true
26038
26039-- original size: 12056, stripped down to: 8398
26040
26041if not modules then modules={} end modules ['luat-fmt']={
26042 version=1.001,
26043 comment="companion to mtxrun",
26044 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
26045 copyright="PRAGMA ADE / ConTeXt Development Team",
26046 license="see context related readme files"
26047}
26048local format=string.format
26049local concat=table.concat
26050local quoted=string.quoted
26051local luasuffixes=utilities.lua.suffixes
26052local report_format=logs.reporter("resolvers","formats")
26053local function primaryflags(arguments)
26054 local flags={}
26055 if arguments.silent then
26056  flags[#flags+1]="--interaction=batchmode"
26057 end
26058 return concat(flags," ")
26059end
26060local function secondaryflags(arguments)
26061 local trackers=arguments.trackers
26062 local directives=arguments.directives
26063 local flags={}
26064 if trackers and trackers~="" then
26065  flags[#flags+1]="--c:trackers="..quoted(trackers)
26066 end
26067 if directives and directives~="" then
26068  flags[#flags+1]="--c:directives="..quoted(directives)
26069 end
26070 if arguments.silent then
26071  flags[#flags+1]="--c:silent"
26072 end
26073 if arguments.errors then
26074  flags[#flags+1]="--c:errors"
26075 end
26076 if arguments.ansi then
26077  flags[#flags+1]="--c:ansi"
26078 end
26079 if arguments.ansilog then
26080  flags[#flags+1]="--c:ansilog"
26081 end
26082 if arguments.strip then
26083  flags[#flags+1]="--c:strip"
26084 end
26085 if arguments.lmtx then
26086  flags[#flags+1]="--c:lmtx"
26087 end
26088 return concat(flags," ")
26089end
26090local template=[[--ini %primaryflags% --socket --shell-escape --lua=%luafile% %texfile% %secondaryflags% %redirect%]]
26091local checkers={
26092 primaryflags="verbose",
26093 secondaryflags="verbose",
26094 luafile="readable",
26095 texfile="readable",
26096 redirect="string",
26097 binarypath="string",
26098}
26099local runners={
26100 luametatex=sandbox.registerrunner {
26101  name="make luametatex format",
26102  program="luametatex",
26103  template=template,
26104  checkers=checkers,
26105  reporter=report_format,
26106 },
26107 luatex=sandbox.registerrunner {
26108  name="make luatex format",
26109  program="luatex",
26110  template=template,
26111  checkers=checkers,
26112  reporter=report_format,
26113 },
26114 luajittex=sandbox.registerrunner {
26115  name="make luajittex format",
26116  program="luajittex",
26117  template=template,
26118  checkers=checkers,
26119  reporter=report_format,
26120 },
26121}
26122local stubfiles={
26123 luametatex="luat-cod.lmt",
26124 luatex="luat-cod.lua",
26125 luajittex="luat-cod.lua",
26126}
26127local suffixes={
26128 luametatex="mkxl",
26129 luatex="mkiv",
26130 luajittex="mkiv",
26131}
26132local function validbinarypath()
26133 if not environment.arguments.nobinarypath then
26134  local path=environment.ownpath or file.dirname(environment.ownname)
26135  if path and path~="" then
26136   path=dir.expandname(path)
26137   if path~="" and lfs.isdir(path) then
26138    return path
26139   end
26140  end
26141 end
26142end
26143local function fatalerror(startupdir,...)
26144 report_format(...)
26145 lfs.chdir(startupdir)
26146end
26147function environment.make_format(formatname)
26148 local arguments=environment.arguments
26149 local engine=environment.ownmain or "luatex"
26150 local silent=arguments.silent
26151 local errors=arguments.errors
26152 local runner=runners[engine]
26153 local startupdir=dir.current()
26154 if not runner then
26155  return fatalerror(startupdir,"the format %a cannot be generated, no runner available for engine %a",name,engine)
26156 end
26157 local luasourcename=stubfiles[engine]
26158 if not luasourcename then
26159  return fatalerror(startupdir,"no lua stub file specified for %a",engine)
26160 end
26161 local texsourcename=file.addsuffix(formatname,suffixes[engine])
26162 local fulltexsourcename=resolvers.findfile(texsourcename,"tex") or ""
26163 if fulltexsourcename=="" then
26164  return fatalerror(startupdir,"no tex source file with name %a (mkiv or tex)",formatname)
26165 end
26166 local fulltexsourcename=dir.expandname(fulltexsourcename)
26167 local texsourcepath=file.dirname(fulltexsourcename)
26168 if lfs.isfile(fulltexsourcename) then
26169  report_format("using tex source file %a",fulltexsourcename)
26170 else
26171  return fatalerror(startupdir,"no accessible tex source file with name %a",fulltexsourcename)
26172 end
26173 local fullluasourcename=dir.expandname(file.join(texsourcepath,luasourcename) or "")
26174 if lfs.isfile(fullluasourcename) then
26175  report_format("using lua stub file %a",fullluasourcename)
26176 else
26177  return fatalerror(startupdir,"no accessible lua stub file with name %a",fulltexsourcename)
26178 end
26179 local validformatpath=caches.getwritablepath("formats",engine) or ""
26180 if validformatpath=="" then
26181  return fatalerror(startupdir,"invalid format path, insufficient write access")
26182 end
26183 local binarypath=validbinarypath()
26184 report_format("changing to format path %a",validformatpath)
26185 if not lfs.chdir(validformatpath) then
26186  return fatalerror(startupdir,"unable to change to format path %a",validformatpath)
26187 end
26188 local primaryflags=primaryflags(arguments)
26189 local secondaryflags=secondaryflags(arguments)
26190 local specification={
26191  binarypath=binarypath,
26192  primaryflags=primaryflags,
26193  secondaryflags=secondaryflags,
26194  luafile=quoted(fullluasourcename),
26195  texfile=quoted(fulltexsourcename),
26196 }
26197 if silent then
26198  specification.redirect="> temp.log"
26199 end
26200 statistics.starttiming("format")
26201 local result=runner(specification)
26202 statistics.stoptiming("format")
26203 if silent then
26204  os.remove("temp.log")
26205 end
26206 report_format()
26207  if binarypath and binarypath~="" then
26208 report_format("binary path      : %s",binarypath or "?")
26209  end
26210 report_format("format path      : %s",validformatpath)
26211 report_format("luatex engine    : %s",engine)
26212 report_format("lua startup file : %s",fullluasourcename)
26213  if primaryflags~="" then
26214 report_format("primary flags    : %s",primaryflags)
26215  end
26216  if secondaryflags~="" then
26217 report_format("secondary flags  : %s",secondaryflags)
26218  end
26219 report_format("context file     : %s",fulltexsourcename)
26220 report_format("run time         : %.3f seconds",statistics.elapsed("format"))
26221 report_format("return value     : %s",result==0 and "okay" or "error")
26222 report_format()
26223 lfs.chdir(startupdir)
26224end
26225local template=[[%primaryflags% --socket --shell-escape --fmt=%fmtfile% --lua=%luafile% %texfile% %secondaryflags%]]
26226local checkers={
26227 primaryflags="verbose",
26228 secondaryflags="verbose",
26229 fmtfile="readable",
26230 luafile="readable",
26231 texfile="readable",
26232}
26233local runners={
26234 luatex=sandbox.registerrunner {
26235  name="run luatex format",
26236  program="luatex",
26237  template=template,
26238  checkers=checkers,
26239  reporter=report_format,
26240 },
26241 luametatex=sandbox.registerrunner {
26242  name="run luametatex format",
26243  program="luametatex",
26244  template=template,
26245  checkers=checkers,
26246  reporter=report_format,
26247 },
26248 luajittex=sandbox.registerrunner {
26249  name="run luajittex format",
26250  program="luajittex",
26251  template=template,
26252  checkers=checkers,
26253  reporter=report_format,
26254 },
26255}
26256function environment.run_format(formatname,scriptname,filename,primaryflags,secondaryflags,verbose)
26257 local engine=environment.ownmain or "luatex"
26258 if not formatname or formatname=="" then
26259  report_format("missing format name")
26260  return
26261 end
26262 if not scriptname or scriptname=="" then
26263  report_format("missing script name")
26264  return
26265 end
26266 if not lfs.isfile(formatname) or not lfs.isfile(scriptname) then
26267  formatname,scriptname=resolvers.locateformat(formatname)
26268 end
26269 if not formatname or formatname=="" then
26270  report_format("invalid format name")
26271  return
26272 end
26273 if not scriptname or scriptname=="" then
26274  report_format("invalid script name")
26275  return
26276 end
26277 local runner=runners[engine]
26278 if not runner then
26279  report_format("format %a cannot be run, no runner available for engine %a",file.nameonly(name),engine)
26280  return
26281 end
26282 if not filename then
26283  filename ""
26284 end
26285 local binarypath=validbinarypath()
26286 local specification={
26287  binarypath=binarypath,
26288  primaryflags=primaryflags or "",
26289  secondaryflags=secondaryflags or "",
26290  fmtfile=quoted(formatname),
26291  luafile=quoted(scriptname),
26292  texfile=filename~="" and quoted(filename) or "",
26293 }
26294 statistics.starttiming("make format")
26295 local result=runner(specification)
26296 statistics.stoptiming("make format")
26297 if verbose then
26298  report_format()
26299   if binarypath and binarypath~="" then
26300  report_format("binary path      : %s",binarypath)
26301   end
26302  report_format("luatex engine    : %s",engine)
26303  report_format("lua startup file : %s",scriptname)
26304  report_format("tex format file  : %s",formatname)
26305   if filename~="" then
26306  report_format("tex input file   : %s",filename)
26307   end
26308   if primaryflags~="" then
26309  report_format("primary flags    : %s",primaryflags)
26310   end
26311   if secondaryflags~="" then
26312  report_format("secondary flags  : %s",secondaryflags)
26313   end
26314  report_format("run time         : %0.3f seconds",statistics.elapsed("make format"))
26315  report_format("return value     : %s",result==0 and "okay" or "error")
26316  report_format()
26317 end
26318 return result
26319end
26320
26321
26322end -- of closure
26323
26324do -- create closure to overcome 200 locals limit
26325
26326package.loaded["util-jsn"] = package.loaded["util-jsn"] or true
26327
26328-- original size: 16718, stripped down to: 8910
26329
26330if not modules then modules={} end modules ['util-jsn']={
26331 version=1.001,
26332 comment="companion to m-json.mkiv",
26333 author="Hans Hagen, PRAGMA-ADE, Hasselt NL",
26334 copyright="PRAGMA ADE / ConTeXt Development Team",
26335 license="see context related readme files"
26336}
26337if utilities and utilities.json then
26338 return json
26339end
26340local P,V,R,S,C,Cc,Cs,Ct,Cf,Cg=lpeg.P,lpeg.V,lpeg.R,lpeg.S,lpeg.C,lpeg.Cc,lpeg.Cs,lpeg.Ct,lpeg.Cf,lpeg.Cg
26341local lpegmatch=lpeg.match
26342local format,gsub=string.format,string.gsub
26343local formatters=string.formatters
26344local utfchar=utf.char
26345local concat,sortedkeys=table.concat,table.sortedkeys
26346local tonumber,tostring,rawset,type,next=tonumber,tostring,rawset,type,next
26347local json=utilities.json or {}
26348utilities.json=json
26349do
26350 local lbrace=P("{")
26351 local rbrace=P("}")
26352 local lparent=P("[")
26353 local rparent=P("]")
26354 local comma=P(",")
26355 local colon=P(":")
26356 local dquote=P('"')
26357 local whitespace=lpeg.patterns.whitespace
26358 local optionalws=whitespace^0
26359 local escapes={
26360  ["b"]="\010",
26361  ["f"]="\014",
26362  ["n"]="\n",
26363  ["r"]="\r",
26364  ["t"]="\t",
26365 }
26366 local escape_un=P("\\u")/""*(C(R("09","AF","af")^-4)/function(s)
26367  return utfchar(tonumber(s,16))
26368 end)
26369 local escape_bs=P([[\]])/""*(P(1)/escapes) 
26370 local jstring=dquote*Cs((escape_un+escape_bs+(1-dquote))^0)*dquote
26371 local jtrue=P("true")*Cc(true)
26372 local jfalse=P("false")*Cc(false)
26373 local jnull=P("null")*Cc(nil)
26374 local jnumber=(1-whitespace-rparent-rbrace-comma)^1/tonumber
26375 local key=jstring
26376 local jsonconverter={ "value",
26377  hash=lbrace*Cf(Ct("")*(V("pair")*(comma*V("pair"))^0+optionalws),rawset)*rbrace,
26378  pair=Cg(optionalws*key*optionalws*colon*V("value")),
26379  array=Ct(lparent*(V("value")*(comma*V("value"))^0+optionalws)*rparent),
26380  value=optionalws*(jstring+V("hash")+V("array")+jtrue+jfalse+jnull+jnumber)*optionalws,
26381 }
26382 function json.tolua(str)
26383  return lpegmatch(jsonconverter,str)
26384 end
26385 function json.load(filename)
26386  local data=io.loaddata(filename)
26387  if data then
26388   return lpegmatch(jsonconverter,data)
26389  end
26390 end
26391end
26392do
26393 local escaper
26394 local f_start_hash=formatters[   '%w{' ]
26395 local f_start_array=formatters[   '%w[' ]
26396 local f_start_hash_new=formatters[ "\n"..'%w{' ]
26397 local f_start_array_new=formatters[ "\n"..'%w[' ]
26398 local f_start_hash_key=formatters[ "\n"..'%w"%s" : {' ]
26399 local f_start_array_key=formatters[ "\n"..'%w"%s" : [' ]
26400 local f_stop_hash=formatters[ "\n"..'%w}' ]
26401 local f_stop_array=formatters[ "\n"..'%w]' ]
26402 local f_key_val_seq=formatters[ "\n"..'%w"%s" : %s' ]
26403 local f_key_val_str=formatters[ "\n"..'%w"%s" : "%s"'  ]
26404 local f_key_val_num=f_key_val_seq
26405 local f_key_val_yes=formatters[ "\n"..'%w"%s" : true'  ]
26406 local f_key_val_nop=formatters[ "\n"..'%w"%s" : false' ]
26407 local f_key_val_null=formatters[ "\n"..'%w"%s" : null'  ]
26408 local f_val_num=formatters[ "\n"..'%w%s' ]
26409 local f_val_str=formatters[ "\n"..'%w"%s"'  ]
26410 local f_val_yes=formatters[ "\n"..'%wtrue'  ]
26411 local f_val_nop=formatters[ "\n"..'%wfalse' ]
26412 local f_val_null=formatters[ "\n"..'%wnull'  ]
26413 local f_val_empty=formatters[ "\n"..'%w{ }'  ]
26414 local f_val_seq=f_val_num
26415 local t={}
26416 local n=0
26417 local function is_simple_table(tt) 
26418  local l=#tt
26419  if l>0 then
26420   for i=1,l do
26421    if type(tt[i])=="table" then
26422     return false
26423    end
26424   end
26425   local nn=n
26426   n=n+1 t[n]="[ "
26427   for i=1,l do
26428    if i>1 then
26429     n=n+1 t[n]=", "
26430    end
26431    local v=tt[i]
26432    local tv=type(v)
26433    if tv=="number" then
26434     n=n+1 t[n]=v
26435    elseif tv=="string" then
26436     n=n+1 t[n]='"'
26437     n=n+1 t[n]=lpegmatch(escaper,v) or v
26438     n=n+1 t[n]='"'
26439    elseif tv=="boolean" then
26440     n=n+1 t[n]=v and "true" or "false"
26441    elseif v then
26442     n=n+1 t[n]=tostring(v)
26443    else
26444     n=n+1 t[n]="null"
26445    end
26446   end
26447   n=n+1 t[n]=" ]"
26448   local s=concat(t,"",nn+1,n)
26449   n=nn
26450   return s
26451  end
26452  return false
26453 end
26454 local function tojsonpp(root,name,depth,level,size)
26455  if root then
26456   local indexed=size>0
26457   n=n+1
26458   if level==0 then
26459    if indexed then
26460     t[n]=f_start_array(depth)
26461    else
26462     t[n]=f_start_hash(depth)
26463    end
26464   elseif name then
26465    if tn=="string" then
26466     name=lpegmatch(escaper,name) or name
26467    elseif tn~="number" then
26468     name=tostring(name)
26469    end
26470    if indexed then
26471     t[n]=f_start_array_key(depth,name)
26472    else
26473     t[n]=f_start_hash_key(depth,name)
26474    end
26475   else
26476    if indexed then
26477     t[n]=f_start_array_new(depth)
26478    else
26479     t[n]=f_start_hash_new(depth)
26480    end
26481   end
26482   depth=depth+1
26483   if indexed then 
26484    for i=1,size do
26485     if i>1 then
26486      n=n+1 t[n]=","
26487     end
26488     local v=root[i]
26489     local tv=type(v)
26490     if tv=="number" then
26491      n=n+1 t[n]=f_val_num(depth,v)
26492     elseif tv=="string" then
26493      v=lpegmatch(escaper,v) or v
26494      n=n+1 t[n]=f_val_str(depth,v)
26495     elseif tv=="table" then
26496      if next(v) then
26497       local st=is_simple_table(v)
26498       if st then
26499        n=n+1 t[n]=f_val_seq(depth,st)
26500       else
26501        tojsonpp(v,nil,depth,level+1,#v)
26502       end
26503      else
26504       n=n+1
26505       t[n]=f_val_empty(depth)
26506      end
26507     elseif tv=="boolean" then
26508      n=n+1
26509      if v then
26510       t[n]=f_val_yes(depth,v)
26511      else
26512       t[n]=f_val_nop(depth,v)
26513      end
26514     else
26515      n=n+1
26516      t[n]=f_val_null(depth)
26517     end
26518    end
26519   elseif next(root) then
26520    local sk=sortedkeys(root)
26521    for i=1,#sk do
26522     if i>1 then
26523      n=n+1 t[n]=","
26524     end
26525     local k=sk[i]
26526     local v=root[k]
26527     local tv=type(v)
26528     local tk=type(k)
26529     if tv=="number" then
26530      if tk=="number" then
26531       n=n+1 t[n]=f_key_val_num(depth,k,v)
26532      elseif tk=="string" then
26533       k=lpegmatch(escaper,k) or k
26534       n=n+1 t[n]=f_key_val_num(depth,k,v)
26535      end
26536     elseif tv=="string" then
26537      if tk=="number" then
26538       v=lpegmatch(escaper,v) or v
26539       n=n+1 t[n]=f_key_val_str(depth,k,v)
26540      elseif tk=="string" then
26541       k=lpegmatch(escaper,k) or k
26542       v=lpegmatch(escaper,v) or v
26543       n=n+1 t[n]=f_key_val_str(depth,k,v)
26544      elseif i>1 then
26545       n=n-1
26546      end
26547     elseif tv=="table" then
26548      local l=#v
26549      if l>0 then
26550       local st=is_simple_table(v)
26551       if not st then
26552        tojsonpp(v,k,depth,level+1,l)
26553       elseif tk=="number" then
26554        n=n+1 t[n]=f_key_val_seq(depth,k,st)
26555       elseif tk=="string" then
26556        k=lpegmatch(escaper,k) or k
26557        n=n+1 t[n]=f_key_val_seq(depth,k,st)
26558       end
26559      elseif next(v) then
26560       tojsonpp(v,k,depth,level+1,0)
26561      elseif i>1 then
26562       n=n-1
26563      end
26564     elseif tv=="boolean" then
26565      if tk=="number" then
26566       n=n+1
26567       if v then
26568        t[n]=f_key_val_yes(depth,k)
26569       else
26570        t[n]=f_key_val_nop(depth,k)
26571       end
26572      elseif tk=="string" then
26573       k=lpegmatch(escaper,k) or k
26574       n=n+1
26575       if v then
26576        t[n]=f_key_val_yes(depth,k)
26577       else
26578        t[n]=f_key_val_nop(depth,k)
26579       end
26580      elseif i>1 then
26581       n=n-1
26582      end
26583     else
26584      if tk=="number" then
26585       n=n+1
26586       t[n]=f_key_val_null(depth,k)
26587      elseif tk=="string" then
26588       k=lpegmatch(escaper,k) or k
26589       n=n+1
26590       t[n]=f_key_val_null(depth,k)
26591      elseif i>1 then
26592       n=n-1
26593      end
26594     end
26595    end
26596   end
26597   n=n+1
26598   if indexed then
26599    t[n]=f_stop_array(depth-1)
26600   else
26601    t[n]=f_stop_hash(depth-1)
26602   end
26603  end
26604 end
26605 local function tojson(value,n)
26606  local kind=type(value)
26607  if kind=="table" then
26608   local done=false
26609   local size=#value
26610   if size==0 then
26611    for k,v in next,value do
26612     if done then
26613      n=n+1;t[n]=',"'
26614     else
26615      n=n+1;t[n]='{"'
26616      done=true
26617     end
26618     n=n+1;t[n]=lpegmatch(escaper,k) or k
26619     n=n+1;t[n]='":'
26620     t,n=tojson(v,n)
26621    end
26622    if done then
26623     n=n+1;t[n]="}"
26624    else
26625     n=n+1;t[n]="{}"
26626    end
26627   elseif size==1 then
26628    n=n+1;t[n]="["
26629    t,n=tojson(value[1],n)
26630    n=n+1;t[n]="]"
26631   else
26632    for i=1,size do
26633     if done then
26634      n=n+1;t[n]=","
26635     else
26636      n=n+1;t[n]="["
26637      done=true
26638     end
26639     t,n=tojson(value[i],n)
26640    end
26641    n=n+1;t[n]="]"
26642   end
26643  elseif kind=="string"  then
26644   n=n+1;t[n]='"'
26645   n=n+1;t[n]=lpegmatch(escaper,value) or value
26646   n=n+1;t[n]='"'
26647  elseif kind=="number" then
26648   n=n+1;t[n]=value
26649  elseif kind=="boolean" then
26650   n=n+1;t[n]=tostring(value)
26651  else
26652   n=n+1;t[n]="null"
26653  end
26654  return t,n
26655 end
26656 local function jsontostring(value,pretty)
26657  local kind=type(value)
26658  if kind=="table" then
26659   if not escaper then
26660    local escapes={
26661     ["\\"]="\\u005C",
26662     ["\""]="\\u0022",
26663    }
26664    for i=0,0x1F do
26665     escapes[utfchar(i)]=format("\\u%04X",i)
26666    end
26667    escaper=Cs((
26668     (R('\0\x20')+S('\"\\'))/escapes+P(1)
26669    )^1 )
26670   end
26671   t={}
26672   n=0
26673   if pretty then
26674    tojsonpp(value,name,0,0,#value)
26675    value=concat(t,"",1,n)
26676   else
26677    t,n=tojson(value,0)
26678    value=concat(t,"",1,n)
26679   end
26680   t=nil
26681   n=0
26682   return value
26683  elseif kind=="string" or kind=="number" then
26684   return lpegmatch(escaper,value) or value
26685  else
26686   return tostring(value)
26687  end
26688 end
26689 json.tostring=jsontostring
26690 function json.tojson(value)
26691  return jsontostring(value,true)
26692 end
26693end
26694
26695
26696end -- of closure
26697
26698-- used libraries    : l-bit32.lua l-lua.lua l-macro.lua l-sandbox.lua l-package.lua l-lpeg.lua l-function.lua l-string.lua l-table.lua l-io.lua l-number.lua l-set.lua l-os.lua l-file.lua l-gzip.lua l-md5.lua l-sha.lua l-url.lua l-dir.lua l-boolean.lua l-unicode.lua l-math.lua util-str.lua util-tab.lua util-fil.lua util-sac.lua util-sto.lua util-prs.lua util-fmt.lua util-soc-imp-reset.lua util-soc-imp-socket.lua util-soc-imp-copas.lua util-soc-imp-ltn12.lua util-soc-imp-mime.lua util-soc-imp-url.lua util-soc-imp-headers.lua util-soc-imp-tp.lua util-soc-imp-http.lua util-soc-imp-ftp.lua util-soc-imp-smtp.lua trac-set.lua trac-log.lua trac-inf.lua trac-pro.lua util-lua.lua util-deb.lua util-tpl.lua util-sbx.lua util-mrg.lua util-env.lua luat-env.lua util-zip.lua lxml-tab.lua lxml-lpt.lua lxml-mis.lua lxml-aux.lua lxml-xml.lua trac-xml.lua data-ini.lua data-exp.lua data-env.lua data-tmp.lua data-met.lua data-res.lua data-pre.lua data-inp.lua data-out.lua data-fil.lua data-con.lua data-use.lua data-zip.lua data-tre.lua data-sch.lua data-lua.lua data-aux.lua data-tmf.lua data-lst.lua libs-ini.lua luat-sta.lua luat-fmt.lua util-jsn.lua
26699-- skipped libraries : -
26700-- original bytes    : 1068584
26701-- stripped bytes    : 426011
26702
26703-- end library merge
26704
26705-- We need this hack till luatex is fixed.
26706--
26707-- for k,v in pairs(arg) do print(k,v) end
26708
26709if arg and (arg[0] == 'luatex' or arg[0] == 'luatex.exe') and arg[1] == "--luaonly" then
26710    arg[-1]=arg[0] arg[0]=arg[2] for k=3,#arg do arg[k-2]=arg[k] end arg[#arg]=nil arg[#arg]=nil
26711end
26712
26713-- End of hack.
26714
26715local format, gsub, gmatch, match, find = string.format, string.gsub, string.gmatch, string.match, string.find
26716local concat = table.concat
26717
26718local ownname = environment and environment.ownname or arg[0] or 'mtxrun.lua'
26719local ownpath = gsub(match(ownname,"^(.+)[\\/].-$") or ".","\\","/")
26720local owntree = environment and environment.ownpath or ownpath
26721
26722local ownlibs = { -- order can be made better
26723
26724    'l-bit32.lua',
26725    'l-lua.lua',
26726    'l-macro.lua',
26727    'l-sandbox.lua',
26728    'l-package.lua',
26729    'l-lpeg.lua',
26730    'l-function.lua',
26731    'l-string.lua',
26732    'l-table.lua',
26733    'l-io.lua',
26734    'l-number.lua',
26735    'l-set.lua',
26736    'l-os.lua',
26737    'l-file.lua',
26738    'l-gzip.lua',
26739    'l-md5.lua',
26740    'l-sha.lua',
26741    'l-url.lua',
26742    'l-dir.lua',
26743    'l-boolean.lua',
26744    'l-unicode.lua',
26745    'l-math.lua',
26746
26747    'util-str.lua', -- code might move to l-string
26748    'util-tab.lua',
26749    'util-fil.lua',
26750    'util-sac.lua',
26751    'util-sto.lua',
26752    'util-prs.lua',
26753    'util-fmt.lua',
26754
26755    'util-soc-imp-reset.lua',
26756    'util-soc-imp-socket.lua',
26757    'util-soc-imp-copas.lua',
26758    'util-soc-imp-ltn12.lua',
26759 -- 'util-soc-imp-mbox.lua',
26760    'util-soc-imp-mime.lua',
26761    'util-soc-imp-url.lua',
26762    'util-soc-imp-headers.lua',
26763    'util-soc-imp-tp.lua',
26764    'util-soc-imp-http.lua',
26765    'util-soc-imp-ftp.lua',
26766    'util-soc-imp-smtp.lua',
26767
26768    'trac-set.lua',
26769    'trac-log.lua',
26770    'trac-inf.lua', -- was before trac-set
26771    'trac-pro.lua', -- not really needed
26772    'util-lua.lua', -- indeed here?
26773    'util-deb.lua',
26774
26775    'util-tpl.lua',
26776    'util-sbx.lua',
26777    'util-mrg.lua',
26778
26779    'util-env.lua',
26780    'luat-env.lua', -- can come before inf (as in mkiv)
26781
26782    'util-zip.lua',
26783
26784    'lxml-tab.lua',
26785    'lxml-lpt.lua',
26786 -- 'lxml-ent.lua',
26787    'lxml-mis.lua',
26788    'lxml-aux.lua',
26789    'lxml-xml.lua',
26790
26791    'trac-xml.lua',
26792
26793    'data-ini.lua',
26794    'data-exp.lua',
26795    'data-env.lua',
26796    'data-tmp.lua',
26797    'data-met.lua',
26798    'data-res.lua',
26799    'data-pre.lua',
26800    'data-inp.lua',
26801    'data-out.lua',
26802    'data-fil.lua',
26803    'data-con.lua',
26804    'data-use.lua',
26805--  'data-tex.lua',
26806--  'data-bin.lua',
26807    'data-zip.lua',
26808    'data-tre.lua',
26809    'data-sch.lua',
26810    'data-lua.lua',
26811    'data-aux.lua', -- updater
26812    'data-tmf.lua',
26813    'data-lst.lua',
26814
26815    'libs-ini.lua',
26816
26817    'luat-sta.lua',
26818    'luat-fmt.lua',
26819
26820    'util-jsn.lua',
26821}
26822
26823-- c:/data/develop/tex-context/tex/texmf-win64/bin/../../texmf-context/tex/context/base/mkiv/data-tmf.lua
26824-- c:/data/develop/context/sources/data-tmf.lua
26825
26826local ownlist = {
26827 -- '.',
26828 -- ownpath ,
26829    owntree .. "/../../../../context/sources", -- HH's development path
26830    --
26831    owntree .. "/../../texmf-local/tex/context/base/mkiv",
26832    owntree .. "/../../texmf-context/tex/context/base/mkiv",
26833    owntree .. "/../../texmf/tex/context/base/mkiv",
26834    owntree .. "/../../../texmf-local/tex/context/base/mkiv",
26835    owntree .. "/../../../texmf-context/tex/context/base/mkiv",
26836    owntree .. "/../../../texmf/tex/context/base/mkiv",
26837    --
26838    owntree .. "/../../texmf-local/tex/context/base",
26839    owntree .. "/../../texmf-context/tex/context/base",
26840    owntree .. "/../../texmf/tex/context/base",
26841    owntree .. "/../../../texmf-local/tex/context/base",
26842    owntree .. "/../../../texmf-context/tex/context/base",
26843    owntree .. "/../../../texmf/tex/context/base",
26844}
26845
26846if ownpath == "." then table.remove(ownlist,1) end
26847
26848own = {
26849    name = ownname,
26850    path = ownpath,
26851    tree = owntree,
26852    list = ownlist,
26853    libs = ownlibs,
26854}
26855
26856local function locate_libs()
26857    for l=1,#ownlibs do
26858        local lib = ownlibs[l]
26859        for p =1,#ownlist do
26860            local pth = ownlist[p]
26861            local filename = pth .. "/" .. lib
26862            local found = lfs.isfile(filename)
26863            if found then
26864                package.path = package.path .. ";" .. pth .. "/?.lua" -- in case l-* does a require
26865                return pth
26866            end
26867        end
26868    end
26869end
26870
26871local function load_libs()
26872    local found = locate_libs()
26873    if found then
26874        for l=1,#ownlibs do
26875            local filename = found .. "/" .. ownlibs[l]
26876            local codeblob = loadfile(filename)
26877            if codeblob then
26878                codeblob()
26879            end
26880        end
26881    else
26882        resolvers = nil
26883    end
26884end
26885
26886if not resolvers then
26887    load_libs()
26888end
26889
26890if not resolvers then
26891    print("")
26892    print("Mtxrun is unable to start up due to lack of libraries. You may")
26893    print("try to run 'lua mtxrun.lua --selfmerge' in the path where this")
26894    print("script is located (normally under ..../scripts/context/lua) which")
26895    print("will make this script library independent.")
26896    os.exit()
26897end
26898
26899-- verbosity
26900
26901----- e_verbose = environment.arguments["verbose"]
26902
26903local e_verbose = false
26904
26905-- some common flags (also passed through environment)
26906
26907local e_silent       = environment.argument("silent")
26908local e_errors       = environment.argument("errors")
26909local e_noconsole    = environment.argument("noconsole")
26910
26911local e_trackers     = environment.argument("trackers")
26912local e_directives   = environment.argument("directives")
26913local e_experiments  = environment.argument("experiments")
26914
26915local t = { }
26916
26917if type(e_directives) == "string" then
26918    t[#t+1] = e_directives
26919end
26920
26921if type(e_silent) == "string" then
26922    t[#t+1] = format("logs.blocked={%s}",e_silent)
26923elseif e_silent == true then
26924    t[#t+1] = "logs.blocked"
26925end
26926
26927if type(e_errors) == "string" then
26928    t[#t+1] = format("logs.errors={%s}",e_errors)
26929elseif e_errors == true then
26930    t[#t+1] = "logs.errors"
26931end
26932
26933if e_noconsole then
26934    t[#t+1] = format("logs.target=file")
26935end
26936
26937if #t > 0 then
26938    e_directives = concat(t,",")
26939end
26940
26941if e_trackers    then trackers   .enable(e_trackers)    end
26942if e_directives  then directives .enable(e_directives)  end
26943if e_experiments then experiments.enable(e_experiments) end
26944
26945if not environment.trackers    then environment.trackers    = e_trackers    end
26946if not environment.directives  then environment.directives  = e_directives  end
26947if not environment.experiments then environment.experiments = e_experiments end
26948
26949--
26950
26951resolvers.reset()
26952
26953local helpinfo = [[
26954<?xml version="1.0" ?>
26955<application>
26956 <metadata>
26957  <entry name="name">mtxrun</entry>
26958  <entry name="detail">ConTeXt TDS Runner Tool</entry>
26959  <entry name="version">1.33</entry>
26960 </metadata>
26961 <flags>
26962  <category name="basic">
26963   <subcategory>
26964    <flag name="script"><short>run an mtx script (lua prefered method) (<ref name="noquotes"/>), no script gives list</short></flag>
26965    <flag name="evaluate"><short>run code passed on the commandline (between quotes) (=loop) (exit|quit aborts)</short></flag>
26966    <flag name="execute"><short>run a script or program (texmfstart method) (<ref name="noquotes"/>)</short></flag>
26967    <flag name="resolve"><short>resolve prefixed arguments</short></flag>
26968    <flag name="ctxlua"><short>run internally (using preloaded libs)</short></flag>
26969    <flag name="internal"><short>run script using built in libraries (same as <ref name="ctxlua"/>)</short></flag>
26970    <flag name="locate"><short>locate given filename in database (default) or system (<ref name="first"/> <ref name="all"/> <ref name="detail"/>)</short></flag>
26971   </subcategory>
26972   <subcategory>
26973    <flag name="tree" value="pathtotree"><short>use given texmf tree (default file: setuptex.tmf)</short></flag>
26974    <flag name="path" value="runpath"><short>go to given path before execution</short></flag>
26975    <flag name="ifchanged" value="filename"><short>only execute when given file has changed (md checksum)</short></flag>
26976    <flag name="iftouched" value="old,new"><short>only execute when given file has changed (time stamp)</short></flag>
26977   </subcategory>
26978   <subcategory>
26979    <flag name="makestubs"><short>create stubs for (context related) scripts</short></flag>
26980    <flag name="removestubs"><short>remove stubs (context related) scripts</short></flag>
26981    <flag name="stubpath" value="binpath"><short>paths where stubs wil be written</short></flag>
26982    <flag name="windows"><short>create windows (mswin) stubs</short></flag>
26983    <flag name="unix"><short>create unix (linux) stubs</short></flag>
26984    <flag name="addbinarypath"><short>prepend the (found) binarypath to runners</short></flag>
26985   </subcategory>
26986   <subcategory>
26987    <flag name="verbose"><short>give a bit more info</short></flag>
26988    <flag name="trackers" value="list"><short>enable given trackers</short></flag>
26989    <flag name="progname" value="str"><short>format or backend</short></flag>
26990    <flag name="systeminfo" value="str"><short>show current operating system, processor, etc</short></flag>
26991   </subcategory>
26992   <subcategory>
26993    <flag name="edit"><short>launch editor with found file</short></flag>
26994    <flag name="launch"><short>launch files like manuals, assumes os support (<ref name="all"/>,<ref name="list"/>)</short></flag>
26995   </subcategory>
26996   <subcategory>
26997    <flag name="timedrun"><short>run a script and time its run</short></flag>
26998    <flag name="autogenerate"><short>regenerate databases if needed (handy when used to run context in an editor)</short></flag>
26999   </subcategory>
27000   <subcategory>
27001    <flag name="usekpse"><short>use kpse as fallback (when no mkiv and cache installed, often slower)</short></flag>
27002    <flag name="forcekpse"><short>force using kpse (handy when no mkiv and cache installed but less functionality)</short></flag>
27003   </subcategory>
27004   <subcategory>
27005    <flag name="prefixes"><short>show supported prefixes</short></flag>
27006   </subcategory>
27007   <subcategory>
27008    <flag name="generate"><short>generate file database</short></flag>
27009   </subcategory>
27010   <subcategory>
27011    <flag name="variables"><short>show configuration variables</short></flag>
27012    <flag name="configurations"><short>show configuration order</short></flag>
27013   </subcategory>
27014   <subcategory>
27015    <flag name="directives"><short>show (known) directives</short></flag>
27016    <flag name="trackers"><short>show (known) trackers</short></flag>
27017    <flag name="experiments"><short>show (known) experiments</short></flag>
27018   </subcategory>
27019   <subcategory>
27020    <flag name="expand-braces"><short>expand complex variable</short></flag>
27021    <flag name="resolve-path"><short>expand variable (completely resolve paths)</short></flag>
27022    <flag name="expand-path"><short>expand variable (resolve paths)</short></flag>
27023    <flag name="expand-var"><short>expand variable (resolve references)</short></flag>
27024    <flag name="show-path"><short>show path expansion of ...</short></flag>
27025    <flag name="var-value"><short>report value of variable</short></flag>
27026    <flag name="find-file"><short>report file location</short></flag>
27027    <flag name="find-path"><short>report path of file</short></flag>
27028   </subcategory>
27029   <subcategory>
27030    <flag name="pattern" value="string"><short>filter variables</short></flag>
27031   </subcategory>
27032  </category>
27033 </flags>
27034</application>
27035]]
27036
27037local application = logs.application {
27038    name     = "mtxrun",
27039    banner   = "ConTeXt TDS Runner Tool 1.32",
27040    helpinfo = helpinfo,
27041}
27042
27043local report = application.report
27044
27045messages = messages or { } -- for the moment
27046
27047runners = runners  or { } -- global (might become local)
27048
27049runners.applications = {
27050    ["lua"] = "luatex --luaonly --socket",
27051    ["luc"] = "luatex --luaonly --socket",
27052    ["pl"] = "perl",
27053    ["py"] = "python",
27054    ["rb"] = "ruby",
27055}
27056
27057runners.suffixes = {
27058    'rb', 'lua', 'py', 'pl'
27059}
27060
27061runners.registered = {
27062    texexec      = { 'texexec.rb',      false },  -- context mkii runner (only tool not to be luafied)
27063    texutil      = { 'texutil.rb',      true  },  -- old perl based index sorter for mkii (old versions need it)
27064    texfont      = { 'texfont.pl',      true  },  -- perl script that makes mkii font metric files
27065    texfind      = { 'texfind.pl',      false },  -- perltk based tex searching tool, mostly used at pragma
27066    texshow      = { 'texshow.pl',      false },  -- perltk based context help system, will be luafied
27067 -- texwork      = { 'texwork.pl',      false },  -- perltk based editing environment, only used at pragma
27068    makempy      = { 'makempy.pl',      true  },
27069    mptopdf      = { 'mptopdf.pl',      true  },
27070    pstopdf      = { 'pstopdf.rb',      true  },  -- converts ps (and some more) images, does some cleaning (replaced)
27071 -- examplex     = { 'examplex.rb',     false },
27072    concheck     = { 'concheck.rb',     false },
27073    runtools     = { 'runtools.rb',     true  },
27074    textools     = { 'textools.rb',     true  },
27075    tmftools     = { 'tmftools.rb',     true  },
27076    ctxtools     = { 'ctxtools.rb',     true  },
27077    rlxtools     = { 'rlxtools.rb',     true  },
27078    pdftools     = { 'pdftools.rb',     true  },
27079    mpstools     = { 'mpstools.rb',     true  },
27080 -- exatools     = { 'exatools.rb',     true  },
27081    xmltools     = { 'xmltools.rb',     true  },
27082 -- luatools     = { 'luatools.lua',    true  },
27083    mtxtools     = { 'mtxtools.rb',     true  },
27084    pdftrimwhite = { 'pdftrimwhite.pl', false },
27085}
27086
27087runners.launchers = {
27088    windows = { },
27089    unix    = { },
27090}
27091
27092-- like runners.libpath("framework"): looks on script's subpath
27093
27094function runners.libpath(...)
27095    package.prepend_libpath(file.dirname(environment.ownscript),...)
27096    package.prepend_libpath(file.dirname(environment.ownname)  ,...)
27097end
27098
27099function runners.prepare()
27100    local checkname = environment.argument("ifchanged")
27101    if type(checkname) == "string" and checkname ~= "" then
27102        local oldchecksum = file.loadchecksum(checkname)
27103        local newchecksum = file.checksum(checkname)
27104        if oldchecksum == newchecksum then
27105            if e_verbose then
27106                report("file '%s' is unchanged",checkname)
27107            end
27108            return "skip"
27109        elseif e_verbose then
27110            report("file '%s' is changed, processing started",checkname)
27111        end
27112        file.savechecksum(checkname)
27113    end
27114    local touchname = environment.argument("iftouched")
27115    if type(touchname) == "string" and touchname ~= "" then
27116        local oldname, newname = string.splitup(touchname, ",")
27117        if oldname and newname and oldname ~= "" and newname ~= "" then
27118            if not file.needs_updating(oldname,newname) then
27119                if e_verbose then
27120                    report("file '%s' and '%s' have same age",oldname,newname)
27121                end
27122                return "skip"
27123            elseif e_verbose then
27124                report("file '%s' is older than '%s'",oldname,newname)
27125            end
27126        end
27127    end
27128    local runpath = environment.argument("path")
27129    if type(runpath) == "string" and not lfs.chdir(runpath) then
27130        report("unable to change to path '%s'",runpath)
27131        return "error"
27132    end
27133    runners.prepare = function() end
27134    return "run"
27135end
27136
27137function runners.execute_script(fullname,internal,nosplit)
27138    local noquote = environment.argument("noquotes")
27139    if fullname and fullname ~= "" then
27140        local state = runners.prepare()
27141        if state == 'error' then
27142            return false
27143        elseif state == 'skip' then
27144            return true
27145        elseif state == "run" then
27146            local path, name, suffix = file.splitname(fullname)
27147            local result = ""
27148            if path ~= "" then
27149                result = fullname
27150            elseif name then
27151                name = gsub(name,"^int[%a]*:",function()
27152                    internal = true
27153                    return ""
27154                end )
27155                name = gsub(name,"^script:","")
27156                if suffix == "" and runners.registered[name] and runners.registered[name][1] then
27157                    name = runners.registered[name][1]
27158                    suffix = file.suffix(name)
27159                end
27160                if suffix == "" then
27161                    -- loop over known suffixes
27162                    for _,s in pairs(runners.suffixes) do
27163                        result = resolvers.findfile(name .. "." .. s, 'texmfscripts')
27164                        if result ~= "" then
27165                            break
27166                        end
27167                    end
27168                elseif runners.applications[suffix] then
27169                    result = resolvers.findfile(name, 'texmfscripts')
27170                else
27171                    -- maybe look on path
27172                    result = resolvers.findfile(name, 'other text files')
27173                end
27174            end
27175            if result and result ~= "" then
27176                if not no_split then
27177                    local before, after = environment.splitarguments(fullname) -- already done
27178                    environment.arguments_before, environment.arguments_after = before, after
27179                end
27180                if internal then
27181                    arg = { } for _,v in pairs(environment.arguments_after) do arg[#arg+1] = v end
27182                    environment.ownscript = result
27183                    dofile(result)
27184                else
27185local texmfcnf =  resolvers.getenv("TEXMFCNF")
27186if not texmfcnf or texmfcnf == "" then
27187    texmfcnf = resolvers.expandedpathfromlist(resolvers.splitpath(resolvers.resolve(resolvers.luacnfspec)))
27188    resolvers.setenv("TEXMFCNF",table.concat(texmfcnf,";")) -- for running texexec etc (after tl change to texmf-dist)
27189end
27190                    local binary = runners.applications[file.suffix(result)]
27191                    result = string.quoted(string.unquoted(result))
27192                 -- if string.match(result,' ') and not string.match(result,"^\".*\"$") then
27193                 --     result = '"' .. result .. '"'
27194                 -- end
27195                    if binary and binary ~= "" then
27196                        result = binary .. " " .. result
27197                    end
27198                    local command = result .. " " .. environment.reconstructcommandline(environment.arguments_after,noquote)
27199                    if e_verbose then
27200                        report()
27201                        report("executing: %s",command)
27202                        report()
27203                        report()
27204                        io.flush()
27205                    end
27206                    local code = os.execute(command)
27207                    if code == 0 then
27208                        return true
27209                    else
27210                        if binary then
27211                            binary = file.addsuffix(binary,os.binsuffix)
27212                            for p in gmatch(os.getenv("PATH"),"[^"..io.pathseparator.."]+") do
27213                                if lfs.isfile(file.join(p,binary)) then
27214                                    return false
27215                                end
27216                            end
27217                            report()
27218                            report("This script needs '%s' which seems not to be installed.",binary)
27219                            report()
27220                        end
27221                        return false
27222                    end
27223                end
27224            end
27225        end
27226    end
27227    return false
27228end
27229
27230function runners.execute_program(fullname)
27231    local noquote = environment.argument("noquotes")
27232    if fullname and fullname ~= "" then
27233        local state = runners.prepare()
27234        if state == 'error' then
27235            return false
27236        elseif state == 'skip' then
27237            return true
27238        elseif state == "run" then
27239            local before, after = environment.splitarguments(fullname)
27240            for k=1,#after do after[k] = resolvers.resolve(after[k]) end
27241            environment.initializearguments(after)
27242            fullname = gsub(fullname,"^bin:","")
27243            local command = fullname .. " " .. (environment.reconstructcommandline(after or "",noquote) or "")
27244            report()
27245            report("executing: %s",command)
27246            report()
27247            report()
27248            io.flush()
27249            local code = os.execute(command)
27250            return code == 0
27251        end
27252    end
27253    return false
27254end
27255
27256-- the --usekpse flag will fallback (not default) on kpse (hm, we can better update mtx-stubs)
27257
27258local windows_stub = '@echo off\013\010setlocal\013\010set ownpath=%%~dp0%%\013\010texlua "%%ownpath%%mtxrun.lua" --usekpse --execute %s %%*\013\010endlocal\013\010'
27259local unix_stub    = '#!/bin/sh\010mtxrun --usekpse --execute %s \"$@\"\010'
27260
27261function runners.handle_stubs(create)
27262    local stubpath = environment.argument('stubpath') or '.' -- 'auto' no longer subpathssupported
27263    local windows  = environment.argument('windows') or environment.argument('mswin') or false
27264    local unix     = environment.argument('unix') or environment.argument('linux') or false
27265    if not windows and not unix then
27266        if os.platform == "unix" then
27267            unix = true
27268        else
27269            windows = true
27270        end
27271    end
27272    for _,v in pairs(runners.registered) do
27273        local name, doit = v[1], v[2]
27274        if doit then
27275            local base = gsub(file.basename(name), "%.(.-)$", "")
27276            if create then
27277                if windows then
27278                    io.savedata(file.join(stubpath,base..".bat"),format(windows_stub,name))
27279                    report("windows stub for '%s' created",base)
27280                end
27281                if unix then
27282                    io.savedata(file.join(stubpath,base),format(unix_stub,name))
27283                    report("unix stub for '%s' created",base)
27284                end
27285            else
27286                if windows and (os.remove(file.join(stubpath,base..'.bat')) or os.remove(file.join(stubpath,base..'.cmd'))) then
27287                    report("windows stub for '%s' removed", base)
27288                end
27289                if unix and (os.remove(file.join(stubpath,base)) or os.remove(file.join(stubpath,base..'.sh'))) then
27290                    report("unix stub for '%s' removed",base)
27291                end
27292            end
27293        end
27294    end
27295end
27296
27297function runners.resolve_string(filename)
27298    if filename and filename ~= "" then
27299        runners.report_location(resolvers.resolve(filename))
27300    end
27301end
27302
27303-- differs from texmfstart where locate appends .com .exe .bat ... todo
27304
27305function runners.locate_file(filename) -- was given file but only searches in tree
27306    if filename and filename ~= "" then
27307        if environment.argument("first") then
27308            runners.report_location(resolvers.findfile(filename))
27309         -- resolvers.dowithfilesandreport(resolvers.findfile,filename)
27310        elseif environment.argument("all") then
27311            local result, status = resolvers.findfiles(filename)
27312            if status and environment.argument("detail") then
27313                runners.report_location(status)
27314            else
27315                runners.report_location(result)
27316            end
27317        else
27318            runners.report_location(resolvers.findgivenfile(filename))
27319         -- resolvers.dowithfilesandreport(resolvers.findgivenfile,filename)
27320        end
27321    end
27322end
27323
27324function runners.locate_platform()
27325    runners.report_location(os.platform)
27326end
27327
27328function runners.report_location(result)
27329    if type(result) == "table" then
27330        for i=1,#result do
27331            if i > 1 then
27332                io.write("\n")
27333            end
27334            io.write(result[i])
27335        end
27336    else
27337        io.write(result)
27338    end
27339end
27340
27341function runners.edit_script(filename) -- we assume that gvim is present on most systems (todo: also in cnf file)
27342    local editor = os.getenv("MTXRUN_EDITOR") or os.getenv("TEXMFSTART_EDITOR") or os.getenv("EDITOR") or 'gvim'
27343    local rest = resolvers.resolve(filename)
27344    if rest ~= "" then
27345        local command = editor .. " " .. rest
27346        if e_verbose then
27347            report()
27348            report("starting editor: %s",command)
27349            report()
27350            report()
27351        end
27352        os.launch(command)
27353    end
27354end
27355
27356function runners.save_script_session(filename, list)
27357    if type(list) == "table" then
27358        local t = { }
27359        for i=1,#list do
27360            local key = list[i]
27361            t[key] = environment.arguments[key]
27362        end
27363        io.savedata(filename,table.serialize(t,true))
27364    end
27365end
27366
27367function runners.load_script_session(filename)
27368    if lfs.isfile(filename) then
27369        local t = io.loaddata(filename)
27370        if t then
27371            t = loadstring(t)
27372            if t then t = t() end
27373            for key, value in pairs(t) do
27374                environment.arguments[key] = value
27375            end
27376        end
27377    end
27378end
27379
27380function resolvers.launch(str)
27381    -- maybe we also need to test on mtxrun.launcher.suffix environment
27382    -- variable or on windows consult the assoc and ftype vars and such
27383    local launchers = runners.launchers[os.platform] if launchers then
27384        local suffix = file.suffix(str) if suffix then
27385            local runner = launchers[suffix] if runner then
27386                str = runner .. " " .. str
27387            end
27388        end
27389    end
27390    os.launch(str)
27391end
27392
27393function runners.launch_file(filename)
27394    local allresults = environment.arguments["all"]
27395    local pattern    = environment.arguments["pattern"]
27396    local listonly   = environment.arguments["list"]
27397    if not pattern or pattern == "" then
27398        pattern = filename
27399    end
27400    if not pattern or pattern == "" then
27401        report("provide name or --pattern=")
27402    else
27403        local t = resolvers.findfiles(pattern,nil,allresults)
27404        if not t or #t == 0 then
27405            t = resolvers.findfiles("*/" .. pattern,nil,allresults)
27406        end
27407        if not t or #t == 0 then
27408            t = resolvers.findfiles("*/" .. pattern .. "*",nil,allresults)
27409        end
27410        if t and #t > 0 then
27411            for i=1,#t do
27412                local name = t[i]
27413                if listonly then
27414                    report("% 3i:  %-30s %s",i,file.basename(name),file.dirname(name))
27415                else
27416                    report("launching: %s",name)
27417                    resolvers.launch(name)
27418                    if not allresults then
27419                        break
27420                    end
27421                end
27422            end
27423            if listonly then
27424                io.write("\n")
27425                io.write("\n[select number]\n\n>> ")
27426                local answer = tonumber(io.read())
27427                if answer then
27428                    io.write("\n")
27429                    local name = t[answer]
27430                    if name then
27431                        report("launching: %s",name)
27432                        resolvers.launch(name)
27433                    else
27434                        report("invalid number")
27435                    end
27436                end
27437            end
27438        else
27439            report("no match for %s", pattern)
27440        end
27441    end
27442end
27443
27444local mtxprefixes = {
27445    { "^mtx%-",    "mtx-"  },
27446    { "^mtx%-t%-", "mtx-t-" },
27447}
27448
27449function runners.find_mtx_script(filename)
27450    local function found(name)
27451        local path = file.dirname(name)
27452        if path and path ~= "" then
27453            return false
27454        else
27455            local fullname = own and own.path and file.join(own.path,name)
27456            return io.exists(fullname) and fullname
27457        end
27458    end
27459    filename = file.addsuffix(filename,"lua")
27460    local basename = file.removesuffix(file.basename(filename))
27461    local suffix = file.suffix(filename)
27462    -- qualified path, raw name
27463    local fullname = file.is_qualified_path(filename) and io.exists(filename) and filename
27464    if fullname and fullname ~= "" then
27465        return fullname
27466    end
27467    -- current path, raw name
27468    fullname = "./" .. filename
27469    fullname = io.exists(fullname) and fullname
27470    if fullname and fullname ~= "" then
27471        return fullname
27472    end
27473    -- mtx- prefix checking
27474    for i=1,#mtxprefixes do
27475        local mtxprefix = mtxprefixes[i]
27476        mtxprefix = find(filename,mtxprefix[1]) and "" or mtxprefix[2]
27477        -- context namespace, mtx-<filename>
27478        fullname = mtxprefix .. filename
27479        fullname = found(fullname) or resolvers.findfile(fullname)
27480        if fullname and fullname ~= "" then
27481            return fullname
27482        end
27483        -- context namespace, mtx-<filename>s
27484        fullname = mtxprefix .. basename .. "s" .. "." .. suffix
27485        fullname = found(fullname) or resolvers.findfile(fullname)
27486        if fullname and fullname ~= "" then
27487            return fullname
27488        end
27489        -- context namespace, mtx-<filename minus trailing s>
27490        fullname = mtxprefix .. gsub(basename,"s$","") .. "." .. suffix
27491        fullname = found(fullname) or resolvers.findfile(fullname)
27492        if fullname and fullname ~= "" then
27493            return fullname
27494        end
27495    end
27496    -- context namespace, just <filename>
27497    fullname = resolvers.findfile(filename)
27498    return fullname
27499end
27500
27501function runners.register_arguments(...)
27502    local arguments = environment.arguments_after
27503    local passedon = { ... }
27504    for i=#passedon,1,-1 do
27505        local pi = passedon[i]
27506        if pi then
27507            table.insert(arguments,1,pi)
27508        end
27509    end
27510end
27511
27512function runners.execute_ctx_script(filename,...)
27513    runners.register_arguments(...)
27514    local arguments = environment.arguments_after
27515    local fullname = runners.find_mtx_script(filename) or ""
27516    if file.suffix(fullname) == "cld" then
27517        -- handy in editors where we force --autopdf
27518        report("running cld script: %s",filename)
27519        table.insert(arguments,1,fullname)
27520        table.insert(arguments,"--autopdf")
27521        fullname = runners.find_mtx_script("context") or ""
27522    end
27523    -- retry after generate but only if --autogenerate
27524    if fullname == "" and environment.argument("autogenerate") then -- might become the default
27525        resolvers.renewcache()
27526        trackers.enable("resolvers.locating")
27527        resolvers.load()
27528        --
27529        fullname = runners.find_mtx_script(filename) or ""
27530    end
27531    -- that should do it
27532    if fullname ~= "" then
27533        local state = runners.prepare()
27534        if state == 'error' then
27535            return false
27536        elseif state == 'skip' then
27537            return true
27538        elseif state == "run" then
27539            -- load and save ... kind of undocumented
27540            arg = { } for _,v in pairs(arguments) do arg[#arg+1] = resolvers.resolve(v) end
27541            environment.initializearguments(arg)
27542            local loadname = environment.arguments['load']
27543            if loadname then
27544                if type(loadname) ~= "string" then loadname = file.basename(fullname) end
27545                loadname = file.replacesuffix(loadname,"cfg")
27546                runners.load_script_session(loadname)
27547            end
27548            filename = environment.files[1]
27549            if e_verbose then
27550                report("using script: %s (if --path is used don't run on path where mtxrun lives)\n",fullname)
27551            end
27552            environment.ownscript = fullname
27553            dofile(fullname)
27554            local savename = environment.arguments['save']
27555            if savename then
27556                if type(savename) ~= "string" then savename = file.basename(fullname) end
27557                savename = file.replacesuffix(savename,"cfg")
27558                runners.save_script_session(savename,save_list)
27559            end
27560            return true
27561        end
27562    else
27563        if filename == "" or filename == "help" then
27564            local context = resolvers.findfile("mtx-context.lua")
27565            trackers.enable("resolvers.locating")
27566            if context ~= "" then
27567                local result = dir.glob((gsub(context,"mtx%-context","mtx-*"))) -- () needed
27568                local valid = { }
27569                table.sort(result)
27570                for i=1,#result do
27571                    local scriptname = result[i]
27572                    local scriptbase = match(scriptname,".*mtx%-([^%-]-)%.lua")
27573                    if scriptbase then
27574                        local data = io.loaddata(scriptname)
27575                        local application = match(data,"local application.-=.-(%{.-%})")
27576                        if application then
27577                            application = loadstring("return " .. application)
27578                            if application then
27579                                application = application()
27580                                local banner = application.banner
27581                                if banner then
27582                                    local description, version = match(banner,"^(.-) ([%d.]+)$")
27583                                    if description then
27584                                        valid[#valid+1] = { scriptbase, version, description }
27585                                    else
27586                                        valid[#valid+1] = { scriptbase, "", banner }
27587                                    end
27588                                end
27589                            end
27590                        end
27591                    end
27592                end
27593                if #valid > 0 then
27594                    application.identify()
27595                    report("no script name given, known scripts:")
27596                    report()
27597                    for k=1,#valid do
27598                        local v = valid[k]
27599                        report("%-12s  %4s  %s",v[1],v[2],v[3])
27600                    end
27601                end
27602            else
27603                report("no script name given")
27604            end
27605        else
27606            filename = file.addsuffix(filename,"lua")
27607            if file.is_qualified_path(filename) then
27608                report("unknown script '%s'",filename)
27609            else
27610                report("unknown script '%s' or 'mtx-%s'",filename,filename)
27611            end
27612        end
27613        return false
27614    end
27615end
27616
27617function runners.prefixes()
27618    application.identify()
27619    report()
27620    report(concat(resolvers.allprefixes(true)," "))
27621end
27622
27623function runners.timedrun(filename) -- just for me
27624    if filename and filename ~= "" then
27625        runners.timed(function() os.execute(filename) end)
27626    end
27627end
27628
27629function runners.timed(action)
27630    statistics.timed(action,true)
27631end
27632
27633function runners.associate(filename)
27634    os.launch(filename)
27635end
27636
27637function runners.evaluate(code,filename) -- for Luigi
27638    local environment = table.setmetatableindex(_G)
27639    if code == "loop" then
27640        while true do
27641            io.write("lua > ")
27642            local code = io.read()
27643            if code == "quit" or code == "exit"  then
27644                break
27645            elseif code ~= "" then
27646                local temp = string.match(code,"^= (.*)$")
27647                if temp then
27648                    code = "inspect("..temp..")"
27649                end
27650                local compiled, message = load(code,"console","t",environment)
27651                if type(compiled) ~= "function" then
27652                    compiled = load("inspect("..code..")","console","t",environment)
27653                end
27654                if type(compiled) ~= "function" then
27655                    io.write("! " .. (message or code).."\n")
27656                else
27657                    io.write(compiled())
27658                end
27659            end
27660        end
27661    else
27662        if type(code) ~= "string" or code == "" then
27663            code = filename
27664        end
27665        if code ~= "" then
27666            local compiled, message = load(code,"console","t",environment)
27667            if type(compiled) ~= "function" then
27668                compiled = load("inspect("..code..")","console","t",environment)
27669            end
27670            if type(compiled) ~= "function" then
27671                io.write("invalid lua code: " .. (message or code))
27672                return
27673            end
27674            io.write(compiled())
27675        end
27676    end
27677end
27678
27679function runners.gethelp(filename)
27680    local url = environment.argument("url")
27681    if url and url ~= "" then
27682        local command = string.gsub(environment.argument("command") or "unknown","^%s*\\*(.-)%s*$","%1")
27683        url = utilities.templates.replace(url,{ command = command })
27684        os.launch(url)
27685    else
27686        report("no --url given")
27687    end
27688end
27689
27690function runners.systeminfo()
27691    report("architecture      : %s",os.platform  or "<unset>")
27692    report("operating system  : %s",os.name      or "<unset>")
27693    report("file architecture : %s",os.type      or "<unset>")
27694    report("binary path       : %s",os.selfdir   or "<unset>")
27695    report("binary suffix     : %s",os.binsuffix or "<unset>")
27696    report("library suffix    : %s",os.libsuffix or "<unset>")
27697end
27698
27699-- this is a bit dirty ... first we store the first filename and next we
27700-- split the arguments so that we only see the ones meant for this script
27701-- ... later we will use the second half
27702
27703local filename = environment.files[1] or ""
27704local ok      = true
27705
27706local before, after = environment.splitarguments(filename)
27707environment.arguments_before, environment.arguments_after = before, after
27708environment.initializearguments(before)
27709
27710e_verbose = environment.arguments["verbose"] -- delayed till here (we need the ones before script)
27711
27712if e_verbose then
27713    trackers.enable("resolvers.locating")
27714end
27715
27716-- maybe the unset has to go to this level
27717
27718local is_mkii_stub = runners.registered[file.removesuffix(file.basename(filename))]
27719
27720local e_argument = environment.argument
27721
27722if e_argument("timedlog") then
27723    logs.settimedlog()
27724end
27725
27726if e_argument("usekpse") or e_argument("forcekpse") or is_mkii_stub then
27727
27728    resolvers.load_tree(e_argument('tree'),true) -- force resolve of TEXMFCNF
27729
27730    os.setenv("engine","")
27731    os.setenv("progname","")
27732
27733    local remapper = {
27734        otf   = "opentype fonts",
27735        ttf   = "truetype fonts",
27736        ttc   = "truetype fonts",
27737        pfb   = "type1 fonts",
27738        other = "other text files",
27739    }
27740
27741    local progname = e_argument("progname") or 'context'
27742
27743    local function kpse_initialized()
27744        texconfig.kpse_init = true
27745        local t = os.clock()
27746        local k = kpse.original.new("luatex",progname)
27747        local dummy = k:find_file("mtxrun.lua") -- so that we're initialized
27748        report("kpse fallback with progname '%s' initialized in %s seconds",progname,os.clock()-t)
27749        kpse_initialized = function() return k end
27750        return k
27751    end
27752
27753    local findfile = resolvers.findfile
27754    local showpath = resolvers.showpath
27755
27756    if e_argument("forcekpse") then
27757
27758        function resolvers.findfile(name,kind)
27759            return (kpse_initialized():find_file(resolvers.cleanpath(name),(kind ~= "" and (remapper[kind] or kind)) or "tex") or "") or ""
27760        end
27761        function resolvers.showpath(name)
27762            return (kpse_initialized():show_path(name)) or ""
27763        end
27764
27765    elseif e_argument("usekpse") or is_mkii_stub then
27766
27767        resolvers.load()
27768
27769        function resolvers.findfile(name,kind)
27770            local found = findfile(name,kind) or ""
27771            if found ~= "" then
27772                return found
27773            else
27774                return (kpse_initialized():find_file(resolvers.cleanpath(name),(kind ~= "" and (remapper[kind] or kind)) or "tex") or "") or ""
27775            end
27776        end
27777        function resolvers.showpath(name)
27778            local found = showpath(name) or ""
27779            if found ~= "" then
27780                return found
27781            else
27782                return (kpse_initialized():show_path(name)) or ""
27783            end
27784        end
27785
27786    end
27787
27788    function runners.loadbase()
27789    end
27790
27791else
27792
27793    function runners.loadbase(...)
27794        if not resolvers.load(...) then
27795            report("forcing cache reload")
27796            resolvers.renewcache()
27797            trackers.enable("resolvers.locating")
27798            if not resolvers.load(...) then
27799                report("the resolver databases are not present or outdated")
27800            end
27801        end
27802    end
27803
27804    resolvers.load_tree(e_argument('tree'),e_argument("resolve"))
27805
27806end
27807
27808-- joke .. reminds me of messing with gigi terminals
27809
27810do
27811
27812    local a_locale = e_argument("locale")
27813
27814    if a_locale then
27815
27816        -- I really hate this crap but am too tired of discussing it over and over
27817        -- again so for the sake of usiage outside context we will provide ways to
27818        -- use locales in an otherwise supposed to be locale agnostic system. And
27819        -- forget about support in case of interferences.
27820
27821        report()
27822        report(what == "force" and "forcing locale:" or "original locale:")
27823        report()
27824        report("  collate  : %s",status.lc_collate  or "<unset>")
27825        report("  ctype    : %s",status.lc_ctype    or "<unset>")
27826        report("  monetary : %s",status.lc_monetary or "<unset>")
27827        report("  numeric  : %s",status.lc_numeric  or "<unset>")
27828        report("  time     : %s",status.lc_time     or "<unset>")
27829        report()
27830
27831    end
27832
27833    if a_locale == "force" then
27834        os.setlocale(status.lc_collate ,"collate")
27835        os.setlocale(status.lc_ctype   ,"ctype")
27836        os.setlocale(status.lc_monetary,"monetary")
27837        os.setlocale(status.lc_numeric ,"numeric")
27838        os.setlocale(status.lc_time    ,"time")
27839    else
27840        function os.setlocale()
27841        end
27842    end
27843
27844end
27845
27846-- if e_argument("ansi") or e_argument("ansilog") then
27847
27848--     logs.setformatters(e_argument("ansi") and "ansi" or "ansilog")
27849
27850--  -- local script = e_argument("script") or e_argument("scripts")
27851--  --
27852--  -- if type(script) == "string" then
27853--  --     logs.writer("]0;"..script.."") -- for Alan to test
27854--  -- end
27855
27856-- end
27857
27858if e_argument("script") or e_argument("scripts") then
27859
27860    -- run a script by loading it (using libs), pass args
27861
27862    if e_argument("nofiledatabase") then
27863        -- handy for mtx-update
27864    else
27865        runners.loadbase()
27866    end
27867    if is_mkii_stub then
27868        ok = runners.execute_script(filename,false,true)
27869    else
27870        ok = runners.execute_ctx_script(filename)
27871    end
27872
27873elseif e_argument("evaluate") then
27874
27875    runners.evaluate(e_argument("evaluate"),filename)
27876
27877elseif e_argument("selfmerge") then
27878
27879    -- embed used libraries
27880
27881    runners.loadbase()
27882    local found = locate_libs()
27883
27884    if found then
27885        local mtxrun = resolvers.findfile("mtxrun.lua") -- includes local name
27886        if lfs.isfile(mtxrun) then
27887            utilities.merger.selfmerge(mtxrun,own.libs,{ found })
27888            application.report("runner updated on resolved path: %s",mtxrun)
27889        else
27890            utilities.merger.selfmerge(own.name,own.libs,{ found })
27891            application.report("runner updated on relative path: %s",own.name)
27892        end
27893    end
27894
27895elseif e_argument("selfclean") then
27896
27897    -- remove embedded libraries
27898
27899    runners.loadbase()
27900
27901    local mtxrun = resolvers.findfile("mtxrun.lua") -- includes local name
27902    if lfs.isfile(mtxrun) then
27903        utilities.merger.selfclean(mtxrun)
27904        application.report("runner cleaned on resolved path: %s",mtxrun)
27905    else
27906        utilities.merger.selfclean(own.name)
27907        application.report("runner cleaned on relative path: %s",own.name)
27908    end
27909
27910elseif e_argument("selfupdate") then
27911
27912    runners.loadbase()
27913    trackers.enable("resolvers.locating")
27914    resolvers.updatescript(own.name,"mtxrun")
27915
27916elseif e_argument("ctxlua") or e_argument("internal") then
27917
27918    -- run a script by loading it (using libs)
27919
27920    runners.loadbase()
27921    ok = runners.execute_script(filename,true)
27922
27923elseif e_argument("execute") then
27924
27925    -- execute script
27926
27927    runners.loadbase()
27928    ok = runners.execute_script(filename)
27929
27930elseif e_argument("direct") then
27931
27932    -- equals bin:
27933
27934    runners.loadbase()
27935    ok = runners.execute_program(filename)
27936
27937elseif e_argument("edit") then
27938
27939    -- edit file
27940
27941    runners.loadbase()
27942    runners.edit_script(filename)
27943
27944elseif e_argument("launch") then
27945
27946    runners.loadbase()
27947    runners.launch_file(filename)
27948
27949elseif e_argument("associate") then
27950
27951    runners.associate(filename)
27952
27953elseif e_argument("gethelp") then
27954
27955    runners.gethelp()
27956
27957elseif e_argument("makestubs") then
27958
27959    -- make stubs (depricated)
27960
27961    runners.handle_stubs(true)
27962
27963elseif e_argument("removestubs") then
27964
27965    -- remove stub (depricated)
27966
27967    runners.loadbase()
27968    runners.handle_stubs(false)
27969
27970elseif e_argument("resolve") then
27971
27972    -- resolve string
27973
27974    runners.loadbase()
27975    runners.resolve_string(filename)
27976
27977elseif e_argument("locate") then
27978
27979    -- locate file (only database)
27980
27981    runners.loadbase()
27982    runners.locate_file(filename)
27983
27984elseif e_argument("platform") or e_argument("show-platform") then
27985
27986    -- locate platform
27987
27988    runners.loadbase()
27989    runners.locate_platform()
27990
27991elseif e_argument("prefixes") then
27992
27993    runners.loadbase()
27994    runners.prefixes()
27995
27996elseif e_argument("timedrun") then
27997
27998    -- locate platform
27999
28000    runners.loadbase()
28001    runners.timedrun(filename)
28002
28003elseif e_argument("variables") or e_argument("show-variables") or e_argument("expansions") or e_argument("show-expansions") then
28004
28005    -- luatools: runners.execute_ctx_script("mtx-base","--expansions",filename)
28006
28007    resolvers.load("nofiles")
28008    resolvers.listers.variables(e_argument("pattern"))
28009
28010elseif e_argument("configurations") or e_argument("show-configurations") then
28011
28012    -- luatools: runners.execute_ctx_script("mtx-base","--configurations",filename)
28013
28014    resolvers.load("nofiles")
28015    resolvers.listers.configurations()
28016
28017elseif e_argument("find-file") then
28018
28019    -- luatools: runners.execute_ctx_script("mtx-base","--find-file",filename)
28020
28021    resolvers.load()
28022    local e_all     = e_argument("all")
28023    local e_pattern = e_argument("pattern")
28024    local e_format  = e_argument("format")
28025    local finder    = e_all and resolvers.findfiles or resolvers.findfile
28026    if not e_pattern then
28027        runners.register_arguments(filename)
28028        environment.initializearguments(environment.arguments_after)
28029        resolvers.dowithfilesandreport(finder,environment.files,e_format)
28030    elseif type(e_pattern) == "string" then
28031        resolvers.dowithfilesandreport(finder,{ e_pattern },e_format)
28032    end
28033
28034elseif e_argument("find-path") then
28035
28036    -- luatools: runners.execute_ctx_script("mtx-base","--find-path",filename)
28037
28038    resolvers.load()
28039    local path = resolvers.findpath(filename)
28040    if e_verbose then
28041        report(path)
28042    else
28043        print(path)
28044    end
28045
28046elseif e_argument("expand-braces") then
28047
28048    -- luatools: runners.execute_ctx_script("mtx-base","--expand-braces",filename)
28049
28050    resolvers.load("nofiles")
28051    runners.register_arguments(filename)
28052    environment.initializearguments(environment.arguments_after)
28053    resolvers.dowithfilesandreport(resolvers.expandbraces, environment.files)
28054
28055elseif e_argument("expand-path") then
28056
28057    -- luatools: runners.execute_ctx_script("mtx-base","--expand-path",filename)
28058
28059    resolvers.load("nofiles")
28060    runners.register_arguments(filename)
28061    environment.initializearguments(environment.arguments_after)
28062    resolvers.dowithfilesandreport(resolvers.expandpath, environment.files)
28063
28064elseif e_argument("resolve-path") then
28065
28066    resolvers.load("nofiles")
28067    runners.register_arguments(filename)
28068    environment.initializearguments(environment.arguments_after)
28069    resolvers.dowithfilesandreport(resolvers.cleanedpathlist, environment.files)
28070
28071elseif e_argument("expand-var") or e_argument("expand-variable") then
28072
28073    -- luatools: runners.execute_ctx_script("mtx-base","--expand-var",filename)
28074
28075    resolvers.load("nofiles")
28076    runners.register_arguments(filename)
28077    environment.initializearguments(environment.arguments_after)
28078    resolvers.dowithfilesandreport(resolvers.expansion, environment.files)
28079
28080elseif e_argument("show-path") or e_argument("path-value") then
28081
28082    -- luatools: runners.execute_ctx_script("mtx-base","--show-path",filename)
28083
28084    resolvers.load("nofiles")
28085    runners.register_arguments(filename)
28086    environment.initializearguments(environment.arguments_after)
28087    resolvers.dowithfilesandreport(resolvers.showpath, environment.files)
28088
28089elseif e_argument("var-value") or e_argument("show-value") then
28090
28091    -- luatools: runners.execute_ctx_script("mtx-base","--show-value",filename)
28092
28093    resolvers.load("nofiles")
28094    runners.register_arguments(filename)
28095    environment.initializearguments(environment.arguments_after)
28096    resolvers.dowithfilesandreport(resolvers.variable,environment.files)
28097
28098elseif e_argument("format-path") then
28099
28100    -- luatools: runners.execute_ctx_script("mtx-base","--format-path",filename)
28101
28102    resolvers.load()
28103    report(caches.getwritablepath("format"))
28104
28105-- elseif e_argument("pattern") then
28106--
28107--     -- luatools
28108--
28109--     runners.execute_ctx_script("mtx-base","--pattern='" .. e_argument("pattern") .. "'",filename)
28110
28111elseif e_argument("generate") then
28112
28113    -- luatools
28114
28115    if filename and filename ~= "" then
28116        resolvers.load("nofiles")
28117        trackers.enable("resolvers.locating")
28118        resolvers.renew(filename)
28119    else
28120        resolvers.renewcache()
28121        trackers.enable("resolvers.locating")
28122        resolvers.load()
28123    end
28124
28125    e_verbose = true
28126
28127elseif e_argument("make") or e_argument("ini") or e_argument("compile") then
28128
28129    -- luatools: runners.execute_ctx_script("mtx-base","--make",filename)
28130
28131    resolvers.load()
28132    trackers.enable("resolvers.locating")
28133    environment.make_format(filename)
28134
28135elseif e_argument("run") then
28136
28137    -- luatools
28138
28139    runners.execute_ctx_script("mtx-base","--run",filename)
28140
28141elseif e_argument("fmt") then
28142
28143    -- luatools
28144
28145    runners.execute_ctx_script("mtx-base","--fmt",filename)
28146
28147elseif e_argument("help") and filename=='base' then
28148
28149    -- luatools
28150
28151    runners.execute_ctx_script("mtx-base","--help")
28152
28153elseif e_argument("version") then
28154
28155    application.version()
28156
28157    application.report("source path",environment.ownbin)
28158
28159elseif e_argument("directives") then
28160
28161    directives.show()
28162
28163elseif e_argument("trackers") then
28164
28165    trackers.show()
28166
28167elseif e_argument("experiments") then
28168
28169    experiments.show()
28170
28171elseif e_argument("exporthelp") then
28172
28173    runners.loadbase()
28174    application.export(e_argument("exporthelp"),filename)
28175
28176elseif e_argument("systeminfo") then
28177
28178    runners.systeminfo()
28179
28180elseif e_argument("locale") then
28181
28182    -- already done
28183
28184elseif e_argument("help") or filename=='help' or filename == "" then
28185
28186    application.help()
28187
28188elseif find(filename,"^bin:") then
28189
28190    runners.loadbase()
28191    ok = runners.execute_program(filename)
28192
28193elseif is_mkii_stub then
28194
28195    -- execute mkii script
28196
28197    runners.loadbase()
28198    ok = runners.execute_script(filename,false,true)
28199
28200elseif false then
28201
28202    runners.loadbase()
28203    ok = runners.execute_ctx_script(filename)
28204    if not ok then
28205        ok = runners.execute_script(filename)
28206    end
28207
28208elseif environment.files[1] == 'texmfcnf.lua' then -- so that we don't need to load mtx-base
28209
28210    resolvers.load("nofiles")
28211    resolvers.listers.configurations()
28212
28213else
28214    runners.loadbase()
28215    runners.execute_ctx_script("mtx-base",filename)
28216
28217end
28218
28219if e_verbose then
28220    report()
28221    report("elapsed lua time: %0.3f seconds",os.runtime())
28222end
28223
28224if os.type ~= "windows" then
28225    texio.write("\n") -- is this still valid?
28226end
28227
28228if ok == false then ok = 1 elseif ok == true or ok == nil then ok = 0 end
28229
28230if lua and lua.getexitcode then
28231    ok = lua.getexitcode()
28232end
28233
28234-- os.exit(ok,true) -- true forces a cleanup in 5.2+
28235
28236os.exit(ok)         -- true forces a cleanup in 5.2+ but reports a wrong number then
28237