syst-lua.lmt /size: 16 Kb    last modification: 2023-12-21 09:44
1if not modules then modules = { } end modules ['syst-lua'] = {
2    version   = 1.001,
3    comment   = "companion to syst-lua.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
9local load, type, tonumber = load, type, tonumber
10local find, gsub = string.find, string.gsub
11local concat = table.concat
12local utfchar = utf.char
13local S, C, P, lpegmatch, lpegtsplitat = lpeg.S, lpeg.C, lpeg.P, lpeg.match, lpeg.tsplitat
14
15local xmath                    = xmath    or math
16local xcomplex                 = xcomplex or { }
17
18----- scannext                 = token.scannext
19local scancmdchr               = token.scancmdchrexpanded
20local scantoken                = token.scantoken
21local getcsname                = token.getcsname
22
23local cmd                      = tokens.commands
24local letter_code              = cmd.letter
25local other_char_code          = cmd.other_char
26local spacer_code              = cmd.spacer
27local other_char_code          = cmd.other_char
28local relax_code               = cmd.relax
29local register_int_code        = cmd.register_int
30local internal_int_code        = cmd.internal_int
31local register_dimen_code      = cmd.register_dimen
32local internal_dimen_code      = cmd.internal_dimen
33local register_glue_code       = cmd.register_glue
34local internal_glue_code       = cmd.internal_glue
35local register_toks_code       = cmd.register_toks
36local internal_toks_code       = cmd.internal_toks
37local char_given_code          = cmd.char_given
38local math_given_code          = cmd.math_given
39local xmath_given_code         = cmd.xmath_given
40local some_item_code           = cmd.some_item
41
42local getdimen                 = tex.getdimen
43local getglue                  = tex.getglue
44local getcount                 = tex.getcount
45local gettoks                  = tex.gettoks
46local gettex                   = tex.get
47
48local context                  = context
49commands                       = commands or { }
50local commands                 = commands
51local context                  = context
52local implement                = interfaces.implement
53local dimenfactors             = number.dimenfactors
54
55local ctx_protected_cs         = context.protected.cs -- more efficient
56local ctx_firstoftwoarguments  = context.firstoftwoarguments
57local ctx_secondoftwoarguments = context.secondoftwoarguments
58local ctx_firstofoneargument   = context.firstofoneargument
59local ctx_gobbleoneargument    = context.gobbleoneargument
60
61local values                   = tokens.values
62local boolean_code             = values.boolean
63
64implement { -- will be overloaded later
65    name      = "writestatus",
66    arguments = "2 arguments",
67    actions   = logs.status,
68}
69
70function commands.doifelse(b)
71    if b then
72        ctx_firstoftwoarguments()
73    else
74        ctx_secondoftwoarguments()
75    end
76end
77
78function commands.doifelsesomething(b)
79    if b and b ~= "" then
80        ctx_firstoftwoarguments()
81    else
82        ctx_secondoftwoarguments()
83    end
84end
85
86function commands.doif(b)
87    if b then
88        ctx_firstofoneargument()
89    else
90        ctx_gobbleoneargument()
91    end
92end
93
94function commands.doifsomething(b)
95    if b and b ~= "" then
96        ctx_firstofoneargument()
97    else
98        ctx_gobbleoneargument()
99    end
100end
101
102function commands.doifnot(b)
103    if b then
104        ctx_gobbleoneargument()
105    else
106        ctx_firstofoneargument()
107    end
108end
109
110function commands.doifnotthing(b)
111    if b and b ~= "" then
112        ctx_gobbleoneargument()
113    else
114        ctx_firstofoneargument()
115    end
116end
117
118commands.testcase = commands.doifelse -- obsolete
119
120function commands.boolcase(b)
121    context(b and 1 or 0)
122end
123
124function commands.doifelsespaces(str)
125    if find(str,"^ +$") then
126        ctx_firstoftwoarguments()
127    else
128        ctx_secondoftwoarguments()
129    end
130end
131
132local pattern = lpeg.patterns.validdimen
133
134function commands.doifelsedimenstring(str)
135    if lpegmatch(pattern,str) then
136        ctx_firstoftwoarguments()
137    else
138        ctx_secondoftwoarguments()
139    end
140end
141
142local p_first = C((1-P(",")-P(-1))^0)
143
144implement {
145    name      = "firstinset",
146    arguments = "string",
147    actions   = function(str) context(lpegmatch(p_first,str or "")) end,
148    public    = true,
149}
150
151implement {
152    name      = "ntimes",
153    arguments = { "string", "integer" },
154    actions   = { string.rep, context }
155}
156
157implement {
158    name      = "execute",
159    arguments = "string",
160    actions   = os.execute -- wrapped in sandbox
161}
162
163implement {
164    name      = "doifelsesame",
165    arguments = "2 strings",
166    actions   = function(a,b)
167        if a == b then
168            ctx_firstoftwoarguments()
169        else
170            ctx_secondoftwoarguments()
171        end
172    end
173}
174
175implement {
176    name      = "doifsame",
177    arguments = "2 strings",
178    actions   = function(a,b)
179        if a == b then
180            ctx_firstofoneargument()
181        else
182            ctx_gobbleoneargument()
183        end
184    end
185}
186
187implement {
188    name      = "doifnotsame",
189    arguments = "2 strings",
190    actions   = function(a,b)
191        if a == b then
192            ctx_gobbleoneargument()
193        else
194            ctx_firstofoneargument()
195        end
196    end
197}
198
199-- This is a bit of a joke as I never really needed floating point expressions (okay,
200-- maybe only with scaling because there one can get numbers that are too large for
201-- dimensions to deal with). Of course one can write a parser in \TEX\ speak but then
202-- one also needs to implement a bunch of functions. It doesn't pay of so we just
203-- stick to the next gimmick. It looks inefficient but performance is actually quite
204-- efficient.
205
206do
207
208    local result = { "return " }
209    local word   = { }
210    local r      = 1
211    local w      = 0
212
213    local report = logs.reporter("system","expression")
214
215    local function unexpected(c)
216        report("unexpected token %a",c)
217    end
218
219    local function unexpected(c)
220        report("unexpected token %a",c)
221    end
222
223    local function expression()
224        local w = 0
225        local r = 1
226        while true do
227        local n, i = scancmdchr()
228            if n == letter_code then
229                w = w + 1 ; word[w] = utfchar(i)
230            else
231                if w > 0 then
232                    -- we could use a metatable for all math, complex and factors
233                    local s = concat(word,"",1,w)
234                    local d = dimenfactors[s]
235                    if d then
236                        r = r + 1 ; result[r] = "*"
237                        r = r + 1 ; result[r] = 1/d
238                    else
239                        if xmath[s] then
240                            r = r + 1 ; result[r] = "xmath."
241                        elseif xcomplex[s] then
242                            r = r + 1 ; result[r] = "xcomplex."
243                        end
244                        r = r + 1 ; result[r] = s
245                    end
246                    w = 0
247                end
248                if     n == other_char_code then
249                    r = r + 1 ; result[r] = utfchar(i)
250                elseif n == spacer_code then
251                -- r = r + 1 ; result[r] = " "
252                elseif n == relax_code then
253                    break
254                elseif n == register_int_code or n == internal_int_code then
255                    r = r + 1 ; result[r] = getcount(i)
256                elseif n == register_dimen_code or n == internal_dimen_code then
257                    r = r + 1 ; result[r] = getdimen(i)
258                elseif n == register_glue_code or n == n == register_dimen_code_glue_code then
259                    r = r + 1 ; result[r] = getglue(i)
260                elseif n == register_toks_code or n == n == register_dimen_code_toks_code then
261                    r = r + 1 ; result[r] = gettoks(i)
262                elseif n == char_given_code or n == math_given_code or n == xmath_given_code then
263                    r = r + 1 ; result[r] = i
264                elseif n == some_item_code then
265                    local n = getcsname(t)
266                    if n then
267                        local s = gettex(n)
268                        if s then
269                            r = r + 1 ; result[r] = s
270                        else
271                            unexpected(c)
272                        end
273                    else
274                        unexpected(c)
275                    end
276             -- elseif n == call_code then
277             --     local n = getcsname(t)
278             --     if n then
279             --         local s = get_macro(n)
280             --         if s then
281             --             r = r + 1 ; result[r] = s
282             --         else
283             --             unexpected(c)
284             --         end
285             --     else
286             --         unexpected(c)
287             --     end
288             -- elseif n == the_code or n == convert_code or n == lua_expandable_call_code then
289             --     put_next(t)
290             --     scantoken() -- expands
291                else
292                    unexpected(c)
293                end
294            end
295        end
296        local code = concat(result,"",1,r)
297        local func = load(code)
298        if type(func) == "function" then
299            context(func())
300        else
301            report("invalid lua %a",code)
302        end
303    end
304
305    implement {
306        public  = true,
307        name    = "expression",
308        actions = expression,
309    }
310
311end
312
313do
314
315    interfaces.implement {
316        name      = "iflua",
317        public    = true,
318        usage     = "condition",
319        arguments = "string",
320        actions   = function(s)
321            local c = load("return(" .. s .. ")")
322            return boolean_code, (c and c()) and true or false
323        end,
324    }
325
326end
327
328do
329
330    -- This is some 20% slower than native but we only provide this for compatibility
331    -- reasons so we don't care that much about it. Eventually we can drop the built-in
332    -- method.
333
334    local channels = { }
335    local lastdone = { }
336
337    local findbinfile = resolvers.findbinfile
338    local loadbinfile = resolvers.loadbinfile
339    local opentexfile = resolvers.opentexfile
340
341    local scaninteger = tokens.scanners.integer
342    local scankeyword = tokens.scanners.keyword
343    local scanstring  = tokens.scanners.string
344    local scancsname  = tokens.scanners.csname
345
346    local setmacro    = tokens.setters.macro
347    local rlncatcodes = tex.rlncatcodes
348    local texgetcount = tex.getcount
349
350    local bytes       = string.bytes
351    local getcatcode  = tex.getcatcode
352
353    local char, concat = string.char, table.concat
354
355    -- This uses the normal bin lookup method that we also use for other files,
356    -- and in principle there is no limit on the amount of files other than the
357    -- operating system imposes.
358
359    local t = { }
360    local l = 0
361
362    implement {
363        name    = "openin",
364        public  = true,
365        usage   = "value",
366        actions = function()
367            local n = scaninteger()
368                      scankeyword("=")
369            local s = scanstring(true)
370            local c = channels[n]
371            if c then
372                c:close()
373            end
374            local f = findbinfile(s,"tex")
375            if f then
376                channels[n] = opentexfile(f)
377                lastdone[n] = false
378            else
379                channels[n] = false
380                lastdone[n] = true
381            end
382        end,
383    }
384
385    implement {
386        name    = "closein",
387        public  = true,
388        usage   = "value",
389        actions = function()
390            local n = scaninteger()
391            local c = channels[n]
392            if c then
393                c:close()
394            end
395            channels[n] = false
396            t = { }
397        end,
398    }
399
400    -- This is not the fastest routine but hardly used, occasionally for line by line
401    -- input in e.g. tikz which is not that fast anyway so I'll deal with it when it
402    -- really is a bottleneck.
403
404    local readerror = function(what,n)
405        tex.error(string.formatters["too many %s brace tokens in read from channel %i"](what,n))
406    end
407
408    interfaces.implement {
409        name    = "read",
410        public  = true,
411        usage   = "value",
412        actions = function(prefix)
413            local n = scaninteger()
414            local c = channels[n]
415            if scankeyword("line") and c then
416                c:gotoline(scaninteger())
417            end
418            scankeyword("to")
419            local m = scancsname(true)
420            local g = 0
421            local s
422            l = 0
423            if c then
424                while true do
425                    local s = c and c:reader()
426                    if s then
427                        l = l + 1
428                        s = gsub(s," *$","")
429                        t[l] = s
430                        for c in bytes(s) do
431                            local cc = getcatcode(c)
432                            if cc == 1 then
433                                g = g + 1
434                            elseif cc == 2 then
435                                g = g - 1
436                            end
437                        end
438                        if g <= 0 then
439                            break
440                        end
441                    else
442                        break
443                    end
444                end
445                if g > 0 then
446                    readerror("left",n)
447                    s = ""
448                elseif g < 0 then
449                    readerror("right",n)
450                    s = ""
451                elseif l == 0 then
452                    if c:endoffile() then
453                        lastdone[n] = true
454                        s = "\\par"
455                    else
456                        s = ""
457                    end
458                    channels[n] = false
459                else
460                    local e = texgetcount("endlinechar") -- we can have tex.endline if needed
461                    if e < 0 or e > 127 then
462                        e = ""
463                    else
464                        e = " "
465                        l = l + 1
466                        t[l] = ""
467                    end
468                    s = concat(t, e, 1, l)
469                end
470            else
471                s = ""
472            end
473            setmacro(m, s, prefix) -- checks for frozen
474        end,
475    }
476
477    -- This is an etex extension. All characters become catcode 12 but a space gets code
478    -- 10. The etex manual specifies a lineending of catcode 12 too. Should we strip spaces
479    -- at the end? A bit weird command that we never use anyway.
480
481    implement {
482        name      = "readline",
483        public    = true,
484        usage     = "value",
485        actions   = function(prefix)
486            local n = scaninteger()
487            local c = channels[n]
488            if scankeyword("line") and c then
489                c:gotoline(scaninteger())
490            end
491            scankeyword("to")
492            local m = scancsname(true)
493            local s = c and c:reader()
494            if s then
495                local e = texgetcount("endlinechar") -- we can have tex.endline if needed
496                if e > 0 then -- forget about 0
497                    s = s .. char(e)
498                end
499            else
500                channels[n] = false
501                s = ""
502            end
503            setmacro(rlncatcodes, m, s, prefix) -- checks for frozen
504        end,
505    }
506
507    implement {
508        name      = "readlinedirect",
509        public    = true,
510        untraced  = true,
511        actions   = function(prefix)
512            local n = scaninteger()
513            local c = channels[n]
514            if scankeyword("line") and c then
515                c:gotoline(scaninteger())
516            end
517            local s = c and c:reader()
518            if s then
519                local e = texgetcount("endlinechar") -- we can have tex.endline if needed
520                if e > 0 then -- forget about 0
521                    s = s .. char(e)
522                end
523                context(s)
524            else
525                channels[n] = false
526            end
527        end,
528    }
529
530    -- This one uses the special lua condition option which is kind of experimental
531    -- but seems to work fine.
532
533    local boolean_value = tokens.values.boolean
534
535    implement {
536        name      = "ifeof",
537        public    = true,
538        usage     = "condition",
539        actions   = function()
540            local n = scaninteger()
541            return boolean_value, not channels[n]
542        end,
543    }
544
545    -- This one doesn't belong here and it might become a real primitive if we need it
546    -- frequently. So, for the moment we keep it in this file.
547
548    local getnest = tex.getnest
549
550    implement {
551        name      = "ifmvl",
552        public    = true,
553        usage     = "condition",
554        actions   = function()
555            return boolean_value, getnest("ptr") == 0
556        end,
557    }
558
559end
560