Source Browser ?

    if not modules then modules = { } end modules ['syst-aux'] = {
2    version   = 1.001,
3    comment   = "companion to syst-aux.mkiv",
4    author    = "Hans Hagen, PRAGMA-ADE, Hasselt NL",
5    copyright = "PRAGMA ADE / ConTeXt Development Team",
6    license   = "see context related readme files"
7}
8
9-- slower than lpeg:
10--
11-- utfmatch(str,"(.?)(.*)$")
12-- utf.sub(str,1,1)
13
14local tonumber, next, type = tonumber, next, type
15local utfsub = utf.sub
16local P, S, R, C, Cc, Cs, Carg, lpegmatch = lpeg.P, lpeg.S, lpeg.R, lpeg.C, lpeg.Cc, lpeg.Cs, lpeg.Carg, lpeg.match
17local find, formatters = string.find, string.formatters
18
19local context           = context
20local implement         = interfaces.implement
21local setmacro          = interfaces.setmacro
22local setcatcode        = tex.setcatcode
23local texget            = tex.get
24local utf8character     = lpeg.patterns.utf8character
25local settings_to_array = utilities.parsers.settings_to_array
26local settings_to_set   = utilities.parsers.settings_to_set
27
28local pattern           = C(utf8character^-1) * C(P(1)^0)
29
30implement {
31    name      = "getfirstcharacter",
32    arguments = "string",
33    actions   = function(str)
34        local first, rest = lpegmatch(pattern,str)
35        setmacro("firstcharacter",first)
        setmacro("remainingcharacters",rest)
37    end
38}
39
40implement {
41    name      = "thefirstcharacter",
42    arguments = "string",
43    actions   = function(str)
44        local first, rest = lpegmatch(pattern,str)
45        context(first)
46    end
47}
48
49implement {
    name      = "theremainingcharacters",
51    arguments = "string",
52    actions   = function(str)
53        local first, rest = lpegmatch(pattern,str)
54        context(rest)
55    end
56}
57
58local pattern      = C(utf8character^-1)
59local ctx_doifelse = commands.doifelse
60
61implement {
62    name      = "doifelsefirstchar",
63    arguments = "2 strings",
64    actions   = function(str,chr)
65        ctx_doifelse(lpegmatch(pattern,str) == chr)
66    end
67}
68
69implement {
70    name      = "getsubstring",
71    arguments = "3 strings",
72    actions   = function(str,first,last)
73        context(utfsub(str,tonumber(first),tonumber(last)))
74    end
75}
76
77-- function commands.addtocommalist(list,item)
78--     if list == "" then
79--         context(item)
80--     else
81--         context("%s,%s",list,item) -- using tex.print is some 10% faster
82--     end
83-- end
84--
85-- function commands.removefromcommalist(list,item)
86--     if list == "" then
87--         context(item)
88--     else
89--         -- okay, using a proper lpeg is probably faster
90--         -- we could also check for #l = 1
91--         local l = settings_to_array(list)
92--         local t, n = { }
93--         for i=1,#l do
94--             if l[i] ~= item then
95--                 n = n + 1
96--                 t[n] = item
97--             end
98--         end
99--         if n == 0 then
100--             context(item)
101--         else
102--             context(concat(list,","))
103--         end
104--     end
105-- end
106
107local pattern = (C((1-P("%"))^1) * Carg(1)) / function(n,d)
108    return formatters["%.0fsp"](d * tonumber(n)/100) end * P("%") * P(-1) -- .0 ?
109
110-- percentageof("10%",65536*10)
111
112implement {
113    name      = "percentageof",
114    arguments = { "string", "dimen" },
115    actions   = function(str,dim)
116        context(lpegmatch(pattern,str,1,dim) or str)
117    end
118}
119
120-- \gdef\setpercentdimen#1#2%
121--   {#1=\ctxcommand{percentageof("#2",\number#1)}\relax}
122
123local space     = P(" ") / ""
124local spaces    = P(" ")^0 / ""
125local nohash    = 1 - P("#")
126local digit     = R("09")
127local double    = P("##") / "#"
128local single    = P("#")
129local sentinel  = spaces * (nohash^1 / "\\%0")
130local whatever  = S("+-/*_^=:") + digit
131local sargument = (single * digit)^1
132local dargument = (double * digit)^1
133local swhatever = (single * whatever)^1
134local dwhatever = (double * whatever)^1
135
136-- different ones:
137
138local space     = P(" ")
139local spaces    = space^0
140
141-- see syst-aux.lua for historic variants
142
143local global    = nil
144local protected = nil
145local permanent = nil
146local expanded  = nil
147local mutable   = nil
148local immutable = nil
149local optional  = nil
150local tolerant  = nil
151local instance  = nil
152local frozen    = nil
153local csname    = nil
154local rest      = nil
155
156local function catcodes_s()
157    setcatcode(32,10) -- space
158    setcatcode(13, 5) -- endofline
159end
160
161local function catcodes_n()
162    setcatcode(32, 9) -- ignore
163    setcatcode(13, 9) -- ignore
164end
165
166local function oldoption(s)
167    if optional > 1 then
168        optional = optional - 1
169        return s .. "#*"
170    else
171        return s
172    end
173end
174
175local option = (
176        P("single")    * Cc(1)
177      + P("double")    * Cc(2)
178      + P("triple")    * Cc(3)
179      + P("quadruple") * Cc(4)
180      + P("quintuple") * Cc(5)
181      + P("sixtuple")
182  ) * (P("empty") + P("argument"))
183
184local pattern = (
185    (
186        spaces * (
187            ( P("spaces")     * space / catcodes_s )
188          + ( P("nospaces")   * space / catcodes_n )
189          + ( P("global")     * space / function()  global    = true end)
190          + ( P("protected")  * space / function()  protected = true end)
191          + ( P("permanent")  * space / function()  permanent = true end)
192          + ( P("expanded")   * space / function()  expanded  = true end)
193          + ( P("tolerant")   * space / function()  tolerant  = true end)
194          + ( P("instance")   * space / function()  instance  = true end)
195          + ( P("frozen")     * space / function()  frozen    = true end)
196          + ( P("mutable")    * space / function()  mutable   = true end)
197          + ( P("immutable")  * space / function()  immutable = true end)
198          + ( P("unexpanded") * space / function()  protected = true end)
199          + ( option          * space / function(s) tolerant  = true
200                                                    optional  = s    end)
201        )
202    )^0
203  * spaces * ( C((1-S(" #["))^1) )
204  * spaces *   Cs(
205        (Cs(P("[") * dargument * P("]")) / oldoption + dwhatever)^1 * sentinel^-1 * double^-1
206      + (Cs(P("[") * sargument * P("]")) / oldoption + swhatever)^1 * sentinel^-1 * single^-1
207      + sentinel^-1 * (double+single)^-1
208    )
209)
210
211local ctx_dostarttexdefinition = context.dostarttexdefinition
212
213local function texdefinition_one(str)
214    global    = false
215    protected = false
216    permanent = false
217    expanded  = false
218    mutable   = false
219    immutable = false
220    optional  = 0
221    tolerant  = false
222    instance  = false
223    frozen    = false
224    csname, rest = lpegmatch(pattern,str)
225    ctx_dostarttexdefinition()
226end
227
228local function texdefinition_two()
229    context (
230        (tolerant  and [[\tolerant]]  or "") ..
231        (frozen    and [[\frozen]]    or "") ..
232        (protected and [[\protected]] or "") ..
233        (permanent and [[\permanent]] or "") ..
234        (instance  and [[\instance]]  or "") ..
235        (mutable   and [[\mutable]]   or "") ..
236        (immutable and [[\immutable]] or "") ..
237--         [[\expandafter]] .. (global and (expanded and [[\xdef]] or [[\gdef]]) or (expanded and [[\edef]] or [[\def]])) ..
238--         [[\csname ]] .. csname .. [[\endcsname ]] ..
239        (global and (expanded and [[\xdefcsname ]] or [[\gdefcsname ]]) or (expanded and [[\edefcsname ]] or [[\defcsname ]])) ..
240        csname .. [[\endcsname ]] ..
241        rest
242    )
243end
244
245implement { name = "texdefinition_one", actions = texdefinition_one, scope = "private", arguments = "string" }
246implement { name = "texdefinition_two", actions = texdefinition_two, scope = "private" }
247
248do
249
250    -- Quite probably we don't yet have characters loaded so we delay some
251    -- aliases.
252
253    local _lower_, _upper_, _strip_
254
255    _lower_ = function(s)
256        if characters and characters.lower then
257            _lower_ = characters.lower
258            return _lower_(s)
259        end
260        return string.lower(s)
261    end
262
263    _upper_ = function(s)
264        if characters and characters.upper then
265            _upper_ = characters.upper
266            return _upper_(s)
267        end
268        return string.upper(s)
269    end
270
271    _strip_ = function(s)
272        -- or utf.strip
273        if string.strip then
274            _strip_ = string.strip
275            return _strip_(s)
276        end
277        return s
278    end
279
280    local function lower(s) context(_lower_(s)) end
281    local function upper(s) context(_upper_(s)) end
282    local function strip(s) context(_strip_(s)) end
283
284    implement { name = "upper", arguments = "string", actions = upper }
285    implement { name = "lower", arguments = "string", actions = lower }
286    implement { name = "strip", arguments = "string", actions = strip }
287
288end
289
290implement {
291    name      = "converteddimen",
292    arguments = { "dimen", "string" },
293    actions   = function(dimen,unit)
294        context(number.todimen(dimen,unit or "pt","%0.5f")) -- no unit appended (%F)
295    end
296}
297
298-- where, not really the best spot for this:
299
300implement {
301    name      = "immediatemessage",
302    public    = true,
303    arguments = { "'message'", "string" },
304    actions   = logs.status
305}
306
307implement {
308    name      = "writestring",
309    public    = true,
310    protected = true,
311    arguments = "string",
312    actions   = function (s)
313        logs.writer(s,"\n")
314    end,
315}
316
317implement {
318    name      = "writeline",
319    public    = true,
320    protected = true,
321    actions   = logs.newline,
322}
323
324implement {
325    name    = "resettimer",
326    actions = function()
327        statistics.resettiming("whatever")
328        statistics.starttiming("whatever")
329    end
330}
331
332implement {
333    name    = "benchmarktimer",
334    actions = function()
335        statistics.benchmarktimer("whatever")
336    end
337}
338
339implement {
340    name    = "elapsedtime",
341    actions = function()
342        statistics.stoptiming("whatever")
343        context(statistics.elapsedtime("whatever"))
344    end
345}
346
347implement {
348    name      = "elapsedsteptime",
349    arguments = "integer",
350    actions   = function(n)
351        statistics.stoptiming("whatever")
352        local t = statistics.elapsed("whatever")/(n > 0 and n or 1)
353        if t > 0 then
354            context("%0.9f",t)
355        else
356            context(0)
357        end
358    end
359}
360
361local accuracy = table.setmetatableindex(function(t,k)
362    local v = formatters["%0." ..k .. "f"]
363    t[k] = v
364    return v
365end)
366
367implement {
368    name      = "rounded",
369    arguments = "integer",
370    actions   = function(n,m) context(accuracy[n](m)) end
371}
372
373-- not faster but just less tracing:
374
375local ctx_protected_cs         = context.protected.cs -- more efficient
376
377local ctx_firstoftwoarguments  = ctx_protected_cs.firstoftwoarguments
378local ctx_secondoftwoarguments = ctx_protected_cs.secondoftwoarguments
379local ctx_firstofoneargument   = ctx_protected_cs.firstofoneargument
380local ctx_gobbleoneargument    = ctx_protected_cs.gobbleoneargument
381
382context.firstoftwoarguments    = ctx_firstoftwoarguments
383context.secondoftwoarguments   = ctx_secondoftwoarguments
384context.firstofoneargument     = ctx_firstofoneargument
385context.gobbleoneargument      = ctx_gobbleoneargument
386
387local ctx_iftrue  = context.iftrue
388local ctx_iffalse = context.iffalse
389
390local hash = utilities.parsers.hashes.settings_to_set
391
392local function doifelsecommon(a,b)
393    if a == b then
394        setmacro("commalistelement",a)
395        if a == "" then
396            ctx_secondoftwoarguments()
397        else
398            ctx_firstoftwoarguments()
399        end
400        return
401    end
402    local ba = find(a,",",1,true)
403    local bb = find(b,",",1,true)
404    if ba and bb then
405        local ha = hash[a]
406        local hb = hash[b]
407     -- local ha = settings_to_set(a)
408     -- local hb = settings_to_set(b)
409        for k in next, ha do
410            if hb[k] then
411                setmacro("commalistelement",k)
412                ctx_firstoftwoarguments()
413                return
414            end
415        end
416    elseif ba then
417        if hash[a][b] then
418     -- if settings_to_set(a)[b] then
419            setmacro("commalistelement",b)
420            ctx_firstoftwoarguments()
421            return
422        end
423    elseif bb then
424        if hash[b][a] then
425     -- if settings_to_set(b)[a] then
426            setmacro("commalistelement",a)
427            ctx_firstoftwoarguments()
428            return
429        end
430    end
431    setmacro("commalistelement","")
432    ctx_secondoftwoarguments()
433end
434
435local function doifcommon(a,b)
436    if a == b then
437        setmacro("commalistelement",a)
438        if a == "" then
439            ctx_gobbleoneargument()
440        else
441            ctx_firstofoneargument()
442        end
443        return
444    end
445    local ba = find(a,",",1,true)
446    local bb = find(b,",",1,true)
447    if ba and bb then
448        local ha = hash[a]
449        local hb = hash[b]
450     -- local ha = settings_to_set(a)
451     -- local hb = settings_to_set(b)
452        for k in next, ha do
453            if hb[k] then
454                setmacro("commalistelement",k)
455                ctx_firstofoneargument()
456                return
457            end
458        end
459    elseif ba then
460        if hash[a][b] then
461     -- if settings_to_set(a)[b] then
462            setmacro("commalistelement",b)
463            ctx_firstofoneargument()
464            return
465        end
466    elseif bb then
467        if hash[b][a] then
468     -- if settings_to_set(b)[a] then
469            setmacro("commalistelement",a)
470            ctx_firstofoneargument()
471            return
472        end
473    end
474    setmacro("commalistelement","")
475    ctx_gobbleoneargument()
476end
477
478local function doifnotcommon(a,b)
479    if a == b then
480        setmacro("commalistelement",a)
481        if a == "" then
482            ctx_firstofoneargument()
483        else
484            ctx_gobbleoneargument()
485        end
486        return
487    end
488    local ba = find(a,",",1,true)
489    local bb = find(b,",",1,true)
490    if ba and bb then
491        local ha = hash[a]
492        local hb = hash[b]
493     -- local ha = settings_to_set(a)
494     -- local hb = settings_to_set(b)
495        for k in next, ha do
496            if hb[k] then
497                setmacro("commalistelement",k)
498                ctx_gobbleoneargument()
499                return
500            end
501        end
502    elseif ba then
503        if hash[a][b] then
504     -- if settings_to_set(a)[b] then
505            setmacro("commalistelement",b)
506            ctx_gobbleoneargument()
507            return
508        end
509    elseif bb then
510        if hash[b][a] then
511     -- if settings_to_set(b)[a] then
512            setmacro("commalistelement",a)
513            ctx_gobbleoneargument()
514            return
515        end
516    end
517    setmacro("commalistelement","")
518    ctx_firstofoneargument()
519end
520
521-- local function hascommonargumentcondition(a,b)
522--     if a == b then
523--         setmacro("commalistelement",a)
524--         if a == "" then
525--             ctx_iffalse()
526--         else
527--             ctx_iftrue()
528--         end
529--         return
530--     end
531--     local ba = find(a,",",1,true)
532--     local bb = find(b,",",1,true)
533--     if ba and bb then
534--         local ha = hash[a]
535--         local hb = hash[b]
536--         for k in next, ha do
537--             if hb[k] then
538--                 setmacro("commalistelement",k)
539--                 ctx_iftrue()
540--                 return
541--             end
542--         end
543--     elseif ba then
544--         if hash[a][b] then
545--             setmacro("commalistelement",b)
546--             ctx_iftrue()
547--             return
548--         end
549--     elseif bb then
550--         if hash[b][a] then
551--             setmacro("commalistelement",a)
552--             ctx_iftrue()
553--             return
554--         end
555--     end
556--     setmacro("commalistelement","")
557--     ctx_iffalse()
558-- end
559
560local function doifelseinset(a,b)
561    if a == b then
562        setmacro("commalistelement",a)
563        if a == "" then
564            ctx_secondoftwoarguments()
565        else
566            ctx_firstoftwoarguments()
567        end
568        return
569    end
570    local bb = find(b,",",1,true)
571    if bb then
572        if hash[b][a] then
573     -- if settings_to_set(b)[a] then
574            setmacro("commalistelement",a)
575            ctx_firstoftwoarguments()
576            return
577        end
578    end
579    setmacro("commalistelement","")
580    ctx_secondoftwoarguments()
581end
582
583local function doifinset(a,b)
584    if a == b then
585        setmacro("commalistelement",a)
586        if a == "" then
587            ctx_gobbleoneargument()
588        else
589            ctx_firstofoneargument()
590        end
591        return
592    end
593    local bb = find(b,",",1,true)
594    if bb then
595       if hash[b][a] then
596    -- if settings_to_set(b)[a] then
597            setmacro("commalistelement",a)
598            ctx_firstofoneargument()
599            return
600        end
601    end
602    setmacro("commalistelement","")
603    ctx_gobbleoneargument()
604end
605
606local function doifnotinset(a,b)
607    if a == b then
608        setmacro("commalistelement",a)
609        if a == "" then
610            ctx_firstofoneargument()
611        else
612            ctx_gobbleoneargument()
613        end
614        return
615    end
616    local bb = find(b,",",1,true)
617    if bb then
618        if hash[b][a] then
619     -- if settings_to_set(b)[a] then
620            setmacro("commalistelement",a)
621            ctx_gobbleoneargument()
622            return
623        end
624    end
625    setmacro("commalistelement","")
626    ctx_firstofoneargument()
627end
628
629implement {
630    name      = "doifelsecommon",
631    actions   = doifelsecommon,
632    arguments = "2 strings",
633}
634
635implement {
636    name      = "doifcommon",
637    actions   = doifcommon,
638    arguments = "2 strings",
639}
640
641implement {
642    name      = "doifnotcommon",
643    actions   = doifnotcommon,
644    arguments = "2 strings",
645}
646
647-- implement {
648--     name      = "hascommonargumentcondition",
649--     actions   = hascommonargumentcondition,
650--     arguments = "2 strings",
651--     arguments = "2 arguments",
652-- }
653
654implement {
655    name      = "doifelseinset",
656    actions   = doifelseinset,
657    arguments = "2 strings",
658--  arguments = "2 arguments",
659}
660
661implement {
662    name      = "doifinset",
663    actions   = doifinset,
664    arguments = "2 strings",
665}
666
667implement {
668    name      = "doifnotinset",
669    actions   = doifnotinset,
670    arguments = "2 strings",
671}
672
673-- done elsewhere:
674--
675-- local function firstinset(a)
676--     local aa = hash[a]
677--     context(aa and aa[1] or a)
678-- end
679--
680-- implement {
681--     name      = "firstinset",
682--     actions   = firstinset,
683--     arguments = "string",
684--     private   = false,
685-- }
686
687-- implement {
688--     name      = "stringcompare",
689--     arguments = "2 strings",
690--     actions   = function(a,b)
691--         context((a == b and 0) or (a > b and 1) or -1)
692--     end
693-- }
694--
695-- implement {
696--     name      = "doifelsestringafter",
697--     arguments = "2 strings",
698--     actions   = function(a,b)
699--         ctx_doifelse((a == b and 0) or (a > b and 1) or -1)
700--     end
701-- }
702--
703-- implement {
704--     name      = "doifelsestringbefore",
705--     arguments = "2 strings",
706--     actions   = function(a,b)
707--         ctx_doifelse((a == b and 0) or (a < b and -1) or 1)
708--     end
709-- }
710
711-- implement { -- not faster than addtocommalist
712--     name      = "additemtolist", -- unique
713--     arguments = "2 strings",
714--     actions   = function(l,s)
715--         if l == "" or s == l then
716--          -- s = s
717--         elseif find("," .. l .. ",","," .. s .. ",") then
718--             s = l
719--         else
720--             s = l .. "," .. s
721--         end
722--         context(s)
723--     end
724-- }
725
726local bp = number.dimenfactors.bp
727
728implement {
729    name      = "tobigpoints",
730    actions   = function(d) context("%.5F",bp * d) end,
731    arguments = "dimension",
732}
733
734implement {
735    name      = "towholebigpoints",
736    actions   = function(d) context("%r",bp * d) end,
737    arguments = "dimension",
738}
739
740-- for now here:
741
742local function getshape(s)
743    local t = texget(s)
744    local n = t and #t or 0
745    context(n)
746    if n > 0 then
747        for i=1,n do
748            local ti = t[i]
749            if type(ti) == "table" then
750                context(" %isp %isp",ti[1],ti[2])
751            else
752                context(" %i",ti)
753            end
754        end
755    end
756end
757
758implement {
759    name    = "getparshape",
760    public  = true,
761    actions = function() getshape("parshape") end,
762}
763implement {
764    name    = "getclubpenalties",
765    public  = true,
766    actions = function() getshape("clubpenalties") end,
767}
768implement {
769    name    = "getinterlinepenalties",
770    public  = true,
771    actions = function() getshape("interlinepenalties") end,
772    }
773implement {
774    name    = "getdisplaywidowpenalties",
775    public  = true,
776    actions = function() getshape("displaywidowpenalties") end,
777}
778implement {
779    name    = "getwidowpenalties",
780    public  = true,
781    actions = function() getshape("widowpenalties") end,
782}
783
784implement {
785    name      = "loopcs",
786    public    = true,
787    arguments = { "integerargument", "csname" },
788    actions   = function(n,cs)
789       local c = context[cs]
790       if n < 0 then
791           for i=-n,1 do c() end
792       else
793           for i= 1,n do c() end
794       end
795    end
796}
797implement {
798    name      = "loopcsn",
799    public    = true,
800    arguments = { "integerargument", "csname" },
801    actions   = function(n,cs)
802       local c = context[cs]
803       if n < 0 then
804           for i=-n,1 do c(i) end
805       else
806           for i= 1,n do c(i) end
807       end
808    end
809}
810