syst-lua.lua /size: 12 Kb    last modification: 2020-07-01 14:35
1
if
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 9
local
find
=
string
.
find
10
local
S
,
C
,
P
,
lpegmatch
,
lpegtsplitat
=
lpeg
.
S
,
lpeg
.
C
,
lpeg
.
P
,
lpeg
.
match
,
lpeg
.
tsplitat
11 12
commands
=
commands
or
{
}
13
local
commands
=
commands
14
local
context
=
context
15
local
implement
=
interfaces
.
implement
16 17
local
ctx_protected_cs
=
context
.
protected
.
cs
-- more efficient
18
local
ctx_firstoftwoarguments
=
context
.
firstoftwoarguments
19
local
ctx_secondoftwoarguments
=
context
.
secondoftwoarguments
20
local
ctx_firstofoneargument
=
context
.
firstofoneargument
21
local
ctx_gobbleoneargument
=
context
.
gobbleoneargument
22 23
implement
{
-- will be overloaded later
24
name
=
"
writestatus
"
,
25
arguments
=
"
2 strings
"
,
26
actions
=
logs
.
status
,
27
}
28 29
function
commands
.
doifelse
(
b
)
30
if
b
then
31
ctx_firstoftwoarguments
(
)
32
else
33
ctx_secondoftwoarguments
(
)
34
end
35
end
36 37
function
commands
.
doifelsesomething
(
b
)
38
if
b
and
b
~
=
"
"
then
39
ctx_firstoftwoarguments
(
)
40
else
41
ctx_secondoftwoarguments
(
)
42
end
43
end
44 45
function
commands
.
doif
(
b
)
46
if
b
then
47
ctx_firstofoneargument
(
)
48
else
49
ctx_gobbleoneargument
(
)
50
end
51
end
52 53
function
commands
.
doifsomething
(
b
)
54
if
b
and
b
~
=
"
"
then
55
ctx_firstofoneargument
(
)
56
else
57
ctx_gobbleoneargument
(
)
58
end
59
end
60 61
function
commands
.
doifnot
(
b
)
62
if
b
then
63
ctx_gobbleoneargument
(
)
64
else
65
ctx_firstofoneargument
(
)
66
end
67
end
68 69
function
commands
.
doifnotthing
(
b
)
70
if
b
and
b
~
=
"
"
then
71
ctx_gobbleoneargument
(
)
72
else
73
ctx_firstofoneargument
(
)
74
end
75
end
76 77
commands
.
testcase
=
commands
.
doifelse
-- obsolete
78 79
function
commands
.
boolcase
(
b
)
80
context
(
b
and
1
or
0
)
81
end
82 83
function
commands
.
doifelsespaces
(
str
)
84
if
find
(
str
,
"
^ +$
"
)
then
85
ctx_firstoftwoarguments
(
)
86
else
87
ctx_secondoftwoarguments
(
)
88
end
89
end
90 91
local
pattern
=
lpeg
.
patterns
.
validdimen
92 93
function
commands
.
doifelsedimenstring
(
str
)
94
if
lpegmatch
(
pattern
,
str
)
then
95
ctx_firstoftwoarguments
(
)
96
else
97
ctx_secondoftwoarguments
(
)
98
end
99
end
100 101
local
p_first
=
C
(
(
1
-
P
(
"
,
"
)
-
P
(
-1
)
)
^
0
)
102 103
implement
{
104
name
=
"
firstinset
"
,
105
arguments
=
"
string
"
,
106
actions
=
function
(
str
)
context
(
lpegmatch
(
p_first
,
str
or
"
"
)
)
end
,
107
public
=
true
,
108
}
109 110
implement
{
111
name
=
"
ntimes
"
,
112
arguments
=
{
"
string
"
,
"
integer
"
}
,
113
actions
=
{
string
.
rep
,
context
}
114
}
115 116
implement
{
117
name
=
"
execute
"
,
118
arguments
=
"
string
"
,
119
actions
=
os
.
execute
-- wrapped in sandbox
120
}
121 122
implement
{
123
name
=
"
doifelsesame
"
,
124
arguments
=
"
2 strings
"
,
125
actions
=
function
(
a
,
b
)
126
if
a
=
=
b
then
127
ctx_firstoftwoarguments
(
)
128
else
129
ctx_secondoftwoarguments
(
)
130
end
131
end
132
}
133 134
implement
{
135
name
=
"
doifsame
"
,
136
arguments
=
"
2 strings
"
,
137
actions
=
function
(
a
,
b
)
138
if
a
=
=
b
then
139
ctx_firstofoneargument
(
)
140
else
141
ctx_gobbleoneargument
(
)
142
end
143
end
144
}
145 146
implement
{
147
name
=
"
doifnotsame
"
,
148
arguments
=
"
2 strings
"
,
149
actions
=
function
(
a
,
b
)
150
if
a
=
=
b
then
151
ctx_gobbleoneargument
(
)
152
else
153
ctx_firstofoneargument
(
)
154
end
155
end
156
}
157 158
-- This is a bit of a joke as I never really needed floating point expressions (okay,
159
-- maybe only with scaling because there one can get numbers that are too large for
160
-- dimensions to deal with). Of course one can write a parser in \TEX\ speak but then
161
-- one also needs to implement a bunch of functions. It doesn't pay of so we just
162
-- stick to the next gimmick. It looks inefficient but performance is actually quite
163
-- efficient.
164 165
local
concat
=
table
.
concat
166
local
utfchar
=
utf
.
char
167
local
load
,
type
,
tonumber
=
load
,
type
,
tonumber
168 169
local
xmath
=
xmath
or
math
170
local
xcomplex
=
xcomplex
or
{
}
171 172
local
cmd
=
tokens
.
commands
173 174
local
get_next
=
token
.
get_next
175
local
get_command
=
token
.
get_command
176
local
get_mode
=
token
.
get_mode
177
local
get_index
=
token
.
get_index
178
local
get_csname
=
token
.
get_csname
179
local
get_macro
=
token
.
get_macro
180 181
local
put_next
=
token
.
put_next
182 183
local
scan_token
=
token
.
scan_token
184 185
local
getdimen
=
tex
.
getdimen
186
local
getglue
=
tex
.
getglue
187
local
getcount
=
tex
.
getcount
188
local
gettoks
=
tex
.
gettoks
189
local
gettex
=
tex
.
get
190 191
local
context
=
context
192
local
dimenfactors
=
number
.
dimenfactors
193 194
local
result
=
{
"
return
"
}
195
local
word
=
{
}
196
local
r
=
1
197
local
w
=
0
198 199
local
report
=
logs
.
reporter
(
"
system
"
,
"
expression
"
)
200 201
local
function
unexpected
(
c
)
202
report
(
"
unexpected token %a
"
,
c
)
203
end
204 205
local
expression
206 207
if
CONTEXTLMTXMODE
=
=
0
then
208 209
expression
=
function
(
)
210
local
w
=
0
211
local
r
=
1
212
while
true
do
213
local
t
=
get_next
(
)
214
local
n
=
get_command
(
t
)
215
local
c
=
cmd
[
n
]
216
-- todo, helper: returns number
217
if
c
=
=
"
letter
"
then
218
w
=
w
+
1
;
word
[
w
]
=
utfchar
(
get_mode
(
t
)
)
219
else
220
if
w
>
0
then
221
local
s
=
concat
(
word
,
"
"
,
1
,
w
)
222
local
d
=
dimenfactors
[
s
]
223
if
d
then
224
r
=
r
+
1
;
result
[
r
]
=
"
*
"
225
r
=
r
+
1
;
result
[
r
]
=
1
/
d
226
else
227
if
xmath
[
s
]
then
228
r
=
r
+
1
;
result
[
r
]
=
"
xmath.
"
229
elseif
xcomplex
[
s
]
then
230
r
=
r
+
1
;
result
[
r
]
=
"
xcomplex.
"
231
end
232
r
=
r
+
1
;
result
[
r
]
=
s
233
end
234
w
=
0
235
end
236
if
c
=
=
"
other_char
"
then
237
r
=
r
+
1
;
result
[
r
]
=
utfchar
(
get_mode
(
t
)
)
238
elseif
c
=
=
"
spacer
"
then
239
-- r = r + 1 ; result[r] = " "
240
elseif
c
=
=
"
relax
"
then
241
break
242
elseif
c
=
=
"
assign_int
"
then
243
r
=
r
+
1
;
result
[
r
]
=
getcount
(
get_index
(
t
)
)
244
elseif
c
=
=
"
assign_dimen
"
then
245
r
=
r
+
1
;
result
[
r
]
=
getdimen
(
get_index
(
t
)
)
246
elseif
c
=
=
"
assign_glue
"
then
247
r
=
r
+
1
;
result
[
r
]
=
getglue
(
get_index
(
t
)
)
248
elseif
c
=
=
"
assign_toks
"
then
249
r
=
r
+
1
;
result
[
r
]
=
gettoks
(
get_index
(
t
)
)
250
elseif
c
=
=
"
char_given
"
or
c
=
=
"
math_given
"
or
c
=
=
"
xmath_given
"
then
251
r
=
r
+
1
;
result
[
r
]
=
get_mode
(
t
)
252
elseif
c
=
=
"
last_item
"
then
253
local
n
=
get_csname
(
t
)
254
if
n
then
255
local
s
=
gettex
(
n
)
256
if
s
then
257
r
=
r
+
1
;
result
[
r
]
=
s
258
else
259
unexpected
(
c
)
260
end
261
else
262
unexpected
(
c
)
263
end
264
elseif
c
=
=
"
call
"
then
265
local
n
=
get_csname
(
t
)
266
if
n
then
267
local
s
=
get_macro
(
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
c
=
=
"
the
"
or
c
=
=
"
convert
"
or
c
=
=
"
lua_expandable_call
"
then
277
put_next
(
t
)
278
scan_token
(
)
-- expands
279
else
280
unexpected
(
c
)
281
end
282
end
283
end
284
local
code
=
concat
(
result
,
"
"
,
1
,
r
)
285
local
func
=
load
(
code
)
286
if
type
(
func
)
=
=
"
function
"
then
287
context
(
func
(
)
)
288
else
289
report
(
"
invalid lua %a
"
,
code
)
290
end
291
end
292 293
else
294 295
local
get_cmdchrcs
=
tokens
.
get_cmdchrcs
or
token
.
get_cmdchrcs
296 297
local
letter_code
=
cmd
.
letter
298
local
other_char_code
=
cmd
.
other_char
299
local
spacer_code
=
cmd
.
spacer
300
local
other_char_code
=
cmd
.
other_char
301
local
relax_code
=
cmd
.
relax
302
local
register_int_code
=
cmd
.
register_int
303
local
internal_int_code
=
cmd
.
internal_int
304
local
register_dimen_code
=
cmd
.
register_dimen
305
local
internal_dimen_code
=
cmd
.
internal_dimen
306
local
register_glue_code
=
cmd
.
register_glue
307
local
internal_glue_code
=
cmd
.
internal_glue
308
local
register_toks_code
=
cmd
.
register_toks
309
local
internal_toks_code
=
cmd
.
internal_toks
310
local
char_given_code
=
cmd
.
char_given
311
local
math_given_code
=
cmd
.
math_given
312
local
xmath_given_code
=
cmd
.
xmath_given
313
local
some_item_code
=
cmd
.
some_item
314
local
call_code
=
cmd
.
call
315
local
the_code
=
cmd
.
the
316
local
convert_code
=
cmd
.
convert
317
local
lua_expandable_call_code
=
cmd
.
lua_expandable_call
318 319
local
function
unexpected
(
c
)
320
report
(
"
unexpected token %a
"
,
c
)
321
end
322 323
expression
=
function
(
)
324
local
w
=
0
325
local
r
=
1
326
while
true
do
327
local
t
=
get_next
(
)
328
local
n
,
i
=
get_cmdchrcs
(
t
)
329
if
n
=
=
letter_code
then
330
w
=
w
+
1
;
word
[
w
]
=
utfchar
(
i
)
331
else
332
if
w
>
0
then
333
-- we could use a metatable for all math, complex and factors
334
local
s
=
concat
(
word
,
"
"
,
1
,
w
)
335
local
d
=
dimenfactors
[
s
]
336
if
d
then
337
r
=
r
+
1
;
result
[
r
]
=
"
*
"
338
r
=
r
+
1
;
result
[
r
]
=
1
/
d
339
else
340
if
xmath
[
s
]
then
341
r
=
r
+
1
;
result
[
r
]
=
"
xmath.
"
342
elseif
xcomplex
[
s
]
then
343
r
=
r
+
1
;
result
[
r
]
=
"
xcomplex.
"
344
end
345
r
=
r
+
1
;
result
[
r
]
=
s
346
end
347
w
=
0
348
end
349
if
n
=
=
other_char_code
then
350
r
=
r
+
1
;
result
[
r
]
=
utfchar
(
i
)
351
elseif
n
=
=
spacer_code
then
352
-- r = r + 1 ; result[r] = " "
353
elseif
n
=
=
relax_code
then
354
break
355
elseif
n
=
=
register_int_code
or
n
=
=
internal_int_code
then
356
r
=
r
+
1
;
result
[
r
]
=
getcount
(
i
)
357
elseif
n
=
=
register_dimen_code
or
n
=
=
internal_dimen_code
then
358
r
=
r
+
1
;
result
[
r
]
=
getdimen
(
i
)
359
elseif
n
=
=
register_glue_code
or
n
=
=
n
=
=
register_dimen_code_glue_code
then
360
r
=
r
+
1
;
result
[
r
]
=
getglue
(
i
)
361
elseif
n
=
=
register_toks_code
or
n
=
=
n
=
=
register_dimen_code_toks_code
then
362
r
=
r
+
1
;
result
[
r
]
=
gettoks
(
i
)
363
elseif
n
=
=
char_given_code
or
n
=
=
math_given_code
or
n
=
=
xmath_given_code
then
364
r
=
r
+
1
;
result
[
r
]
=
i
365
elseif
n
=
=
some_item_code
then
366
local
n
=
get_csname
(
t
)
367
if
n
then
368
local
s
=
gettex
(
n
)
369
if
s
then
370
r
=
r
+
1
;
result
[
r
]
=
s
371
else
372
unexpected
(
c
)
373
end
374
else
375
unexpected
(
c
)
376
end
377
elseif
n
=
=
call_code
then
378
local
n
=
get_csname
(
t
)
379
if
n
then
380
local
s
=
get_macro
(
n
)
381
if
s
then
382
r
=
r
+
1
;
result
[
r
]
=
s
383
else
384
unexpected
(
c
)
385
end
386
else
387
unexpected
(
c
)
388
end
389
elseif
n
=
=
the_code
or
n
=
=
convert_code
or
n
=
=
lua_expandable_call_code
then
390
put_next
(
t
)
391
scan_token
(
)
-- expands
392
else
393
unexpected
(
c
)
394
end
395
end
396
end
397
local
code
=
concat
(
result
,
"
"
,
1
,
r
)
398
local
func
=
load
(
code
)
399
if
type
(
func
)
=
=
"
function
"
then
400
context
(
func
(
)
)
401
else
402
report
(
"
invalid lua %a
"
,
code
)
403
end
404
end
405 406
end
407 408
implement
{
409
public
=
true
,
410
name
=
"
expression
"
,
411
actions
=
expression
,
412
}
413