"Fossies" - the Fresh Open Source Software Archive 
Member "TeXmacs-2.1.2-src/TeXmacs/progs/convert/latex/tmtex.scm" (5 May 2022, 131460 Bytes) of package /linux/misc/TeXmacs-2.1.2-src.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
1
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; MODULE : tmtex.scm
5 ;; DESCRIPTION : conversion of TeXmacs trees into TeX/LaTeX trees
6 ;; COPYRIGHT : (C) 2002 Joris van der Hoeven
7 ;;
8 ;; This software falls under the GNU general public license version 3 or later.
9 ;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
10 ;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
11 ;;
12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13
14 (texmacs-module (convert latex tmtex)
15 (:use (convert tools tmpre)
16 (convert tools old-tmtable)
17 (convert tools tmlength)
18 (convert rewrite tmtm-brackets)
19 (convert latex texout)
20 (doc tmdoc-markup)
21 (convert latex latex-tools)))
22
23 (use-modules (ice-9 format))
24
25 (tm-define tmtex-debug-mode? #f)
26
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;; Global variables
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30
31 (tm-define tmtex-style "generic")
32 (tm-define tmtex-packages '())
33 (tm-define tmtex-replace-style? #t)
34 (define tmtex-languages '())
35 (define tmtex-colors '())
36 (define tmtex-colormaps '())
37 (define tmtex-env (make-ahash-table))
38 (define tmtex-macros (make-ahash-table))
39 (define tmtex-dynamic (make-ahash-table))
40 (define tmtex-serial 0)
41 (define tmtex-ref-cnt 1)
42 (define tmtex-auto-produce 0)
43 (define tmtex-auto-consume 0)
44 (define tmtex-image-root-url (unix->url "image"))
45 (define tmtex-image-root-string "image")
46 (define tmtex-appendices? #f)
47 (define tmtex-indirect-bib? #f)
48 (define tmtex-mathjax? #f)
49
50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 ;; Style
52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53
54 (texmacs-modes
55 ;;; Elsevier styles
56 (elsevier-style% (in? tmtex-style '("elsart" "jsc" "elsarticle"
57 "ifac")))
58 (jsc-style% (in? tmtex-style '("jsc")) elsevier-style%)
59 (elsarticle-style% (in? tmtex-style '("elsarticle")) elsevier-style%)
60 (elsart-style% (in? tmtex-style '("elsart")) elsevier-style%)
61 (ifac-style% (in? tmtex-style '("ifac")) elsevier-style%)
62
63 ;;; ACM styles
64 (acm-style% (in? tmtex-style '("acmconf" "sig-alternate"
65 "acm_proc_article-sp"
66 "acmsmall" "acmlarge" "acmtog"
67 "sigconf" "sigchi" "sigplan"
68 "acmart")))
69 (acm-art-style% (in? tmtex-style '("acmsmall" "acmlarge" "acmtog"
70 "sigconf" "sigchi" "sigplan"
71 "acmart")) acm-style%)
72 (sig-alternate-style% (in? tmtex-style '("sig-alternate")) acm-style%)
73 (acm-conf-style% (in? tmtex-style '("acmconf" "sig-alternate"
74 "acm_proc_article-sp")) acm-style%)
75 (acm-small-style% (in? tmtex-style '("acmsmall")) acm-art-style%)
76 (acm-large-style% (in? tmtex-style '("acmlarge")) acm-art-style%)
77 (acm-tog-style% (in? tmtex-style '("acmtog")) acm-art-style%)
78 (acm-sigconf-style% (in? tmtex-style '("sigconf")) acm-art-style%)
79 (acm-sigchi-style% (in? tmtex-style '("sigchi")) acm-art-style%)
80 (acm-sigplan-style% (in? tmtex-style '("sigplan")) acm-art-style%)
81
82 ;; AMS styles
83 (ams-style% (in? tmtex-style '("amsart")))
84
85 ;; Revtex styles
86 (revtex-style% (in? tmtex-style '("aip" "aps")))
87 (aip-style% (in? tmtex-style '("aip")) revtex-style%)
88 (aps-style% (in? tmtex-style '("aps")) revtex-style%)
89 (sv-style% (in? tmtex-style '("svjour" "svjour3"
90 "llncs" "svmono")))
91
92 ;; Springer styles
93 (springer-style% (in? tmtex-style '("svjour" "svjour3"
94 "llncs" sv-style%)))
95 (svjour-style% (in? tmtex-style '("svjour"
96 "svjour3")) springer-style%)
97 (llncs-style% (in? tmtex-style '("llncs")) springer-style%)
98 (svmono-style% (in? tmtex-style '("svmono")) sv-style%)
99
100 ;; IEEE styles
101 (ieee-style% (in? tmtex-style '("ieeeconf" "ieeetran")))
102 (ieee-conf-style% (in? tmtex-style '("ieeeconf")) ieee-style%)
103 (ieee-tran-style% (in? tmtex-style '("ieeetran")) ieee-style%)
104
105 ;; Other styles
106 (beamer-style% (in? tmtex-style '("beamer" "old-beamer")))
107 (natbib-package% (in? "cite-author-year" tmtex-packages)))
108
109 (tm-define (tmtex-style-init body)
110 (noop))
111
112 (tm-define (tmtex-style-preprocess doc) doc)
113
114 (define (import-tmtex-styles)
115 (cond ((elsevier-style?) (import-from (convert latex tmtex-elsevier)))
116 ((acm-style?) (import-from (convert latex tmtex-acm)))
117 ((ams-style?) (import-from (convert latex tmtex-ams)))
118 ((revtex-style?) (import-from (convert latex tmtex-revtex)))
119 ((ieee-style?) (import-from (convert latex tmtex-ieee)))
120 ((beamer-style?) (import-from (convert latex tmtex-beamer)))
121 ((or (springer-style?) (svmono-style?))
122 (import-from (convert latex tmtex-springer)))
123 (else (noop))))
124
125 (tm-define (tmtex-provided-packages) '())
126
127 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
128 ;; Initialization from options
129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
130
131 (define (tmtex-initialize opts)
132 (set! tmtex-ref-cnt 1)
133 (set! tmtex-env (make-ahash-table))
134 (set! tmtex-macros (make-ahash-table))
135 (set! tmtex-dynamic (make-ahash-table))
136 (set! tmtex-serial 0)
137 (set! tmtex-auto-produce 0)
138 (set! tmtex-auto-consume 0)
139 (set! tmtex-mathjax? #f)
140 (if (== (url-suffix current-save-target) "tex")
141 (begin
142 (set! tmtex-image-root-url (url-unglue current-save-target 4))
143 (with suf (url-suffix tmtex-image-root-url)
144 (when (!= suf "")
145 (set! tmtex-image-root-url
146 (url-unglue tmtex-image-root-url
147 (+ (string-length suf) 1)))))
148 (set! tmtex-image-root-string
149 (url->unix (url-tail tmtex-image-root-url))))
150 (begin
151 (set! tmtex-image-root-url (unix->url "image"))
152 (set! tmtex-image-root-string "image")))
153 (set! tmtex-appendices? #f)
154 (set! tmtex-replace-style?
155 (== (assoc-ref opts "texmacs->latex:replace-style") "on"))
156 (set! tmtex-indirect-bib?
157 (== (assoc-ref opts "texmacs->latex:indirect-bib") "on"))
158 (set! tmtex-use-macros?
159 (== (assoc-ref opts "texmacs->latex:use-macros") "on"))
160 (when (== (assoc-ref opts "texmacs->latex:mathjax") "on")
161 (tmtex-env-set "mode" "math")
162 (set! tmtex-mathjax? #t))
163 (with charset (assoc-ref opts "texmacs->latex:encoding")
164 (if tmtex-cjk-document? (set! charset "utf-8"))
165 (cond ((== charset "utf-8")
166 (set! tmtex-use-catcodes? #f)
167 (set! tmtex-use-ascii? #f)
168 (set! tmtex-use-unicode? #t))
169 ((== charset "cork")
170 (set! tmtex-use-catcodes? #t)
171 (set! tmtex-use-ascii? #f)
172 (set! tmtex-use-unicode? #f))
173 ((== charset "ascii")
174 (set! tmtex-use-catcodes? #f)
175 (set! tmtex-use-ascii? #t)
176 (set! tmtex-use-unicode? #f)))))
177
178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
179 ;; Determination of the mode in which commands are used
180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
181
182 (define command-text-uses (make-ahash-table))
183 (define command-math-uses (make-ahash-table))
184
185 (define (compute-mode-stats t mode)
186 (when (tree-compound? t)
187 (let* ((h (if (== mode (tree "math"))
188 command-math-uses
189 command-text-uses))
190 (n (or (ahash-ref h (tree-label t)) 0)))
191 (ahash-set! h (tree-label t) (+ n 1))
192 (for-each (lambda (i)
193 (with nmode (tree-child-env t i "mode" mode)
194 (compute-mode-stats (tree-ref t i) nmode)))
195 (.. 0 (tree-arity t))))))
196
197 (define (init-mode-stats t)
198 (set! command-text-uses (make-ahash-table))
199 (set! command-math-uses (make-ahash-table))
200 (compute-mode-stats (tm->tree t) "text"))
201
202 (define (mode-protect t)
203 (cond ((and (pair? t) (symbol? (car t))
204 (string-starts? (symbol->string (car t)) "tmtext"))
205 `(text ,t))
206 ((and (pair? t) (symbol? (car t))
207 (or (string-starts? (symbol->string (car t)) "tmmath")
208 (string-starts? (symbol->string (car t)) "math")))
209 `(ensuremath ,t))
210 ((func? t '!concat)
211 `(!concat ,@(map mode-protect (cdr t))))
212 (else t)))
213
214 (define (tmtex-pre t)
215 (cond ((tm-func? t 'para)
216 (cons '!paragraph (map-in-order tmtex-pre (tm-children t))))
217 ((tm-func? t 'concat)
218 (cons '!paragraph (map-in-order tmtex-pre (tm-children t))))
219 ((tm-func? t 'mtm 2)
220 `(mtm ,(cadr t) ,(tmtex-pre (caddr t))))
221 ((and (tm-func? t 'assign 2) (tm-atomic? (tm-ref t 0)))
222 (let* ((name (tm-ref t 0))
223 (tag (string->symbol name))
224 (tnr (or (ahash-ref command-text-uses tag) 0))
225 (mnr (or (ahash-ref command-math-uses tag) 0)))
226 ;;(display* tag ", " tnr ", " mnr "\n")
227 (cond ((and (string-ends? name "*")
228 (or (string-starts? name "itemize")
229 (string-starts? name "enumerate")
230 (string-starts? name "description")))
231 "")
232 ((>= tnr mnr)
233 (with r (tmtex t)
234 ;;(display* t " -> " r "\n")
235 (when (and (> mnr 0) (func? r 'newcommand 2))
236 (with val (mode-protect (caddr r))
237 (set! r (list (car r) (cadr r) val))))
238 r))
239 (else
240 (tmtex-env-set "mode" "math")
241 (with r (tmtex t)
242 (tmtex-env-reset "mode")
243 ;;(display* t " -> " r "\n")
244 (when (and (> tnr 0) (func? r 'newcommand 2))
245 (with val (mode-protect (caddr r))
246 (set! r (list (car r) (cadr r) val))))
247 r)))))
248 (else (tmtex t))))
249
250 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
251 ;; Data
252 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
253
254 (logic-table tmtex-table-props%
255 (block ("" "l" "" #t))
256 (block* ("" "c" "" #t))
257 (wide-block ("{\\noindent}" "@{}X@{}" "" #t))
258 (tabular ("" "l" "" #f))
259 (tabular* ("" "c" "" #f))
260 (wide-tabular ("{\\noindent}" "@{}X@{}" "" #f))
261 (matrix ((,(string->symbol "left(")) "c" (,(string->symbol "right)")) #f))
262 (det ((left|) "c" (right|) #f))
263 (bmatrix ((,(string->symbol "left[")) "c" (,(string->symbol "right]")) #f))
264 (stack ("" "c" "" #f))
265 (choice ((left\{) "l" (right.) #f))
266 (tabbed ("" "l" "" #f))
267 (tabbed* ("" "l" "" #f))
268 (rcl-table ("{\\setlength\\arraylinesep{0.4em}\\everymath={\\displaystyle}"
269 "rcl" "}" #f)))
270
271 (logic-table tex-with-cmd%
272 (("font-family" "rm") tmtextrm)
273 (("font-family" "ss") tmtextsf)
274 (("font-family" "tt") tmtexttt)
275 (("font-series" "medium") tmtextmd)
276 (("font-series" "bold") tmtextbf)
277 (("font-shape" "right") tmtextup)
278 (("font-shape" "slanted") tmtextsl)
279 (("font-shape" "italic") tmtextit)
280 (("font-shape" "small-caps") tmtextsc)
281 (("par-columns" "2") (!begin "multicols" "2"))
282 (("par-columns" "3") (!begin "multicols" "3"))
283 (("par-mode" "center") (!begin "center"))
284 (("par-mode" "left") (!begin "flushleft"))
285 (("par-mode" "right") (!begin "flushright")))
286
287 (logic-table tex-with-cmd-math%
288 (("font" "cal") mathcal)
289 (("font" "cal*") mathscr)
290 (("font" "cal**") EuScript)
291 (("font" "Euler") mathfrak)
292 (("font" "Bbb") mathbb)
293 (("font" "Bbb*") mathbbm)
294 (("font" "Bbb**") mathbbmss)
295 (("font" "Bbb***") mathbb)
296 (("font" "Bbb****") mathds)
297 (("font-family" "rm") mathrm)
298 (("font-family" "ss") mathsf)
299 (("font-family" "tt") mathtt)
300 (("font-series" "medium") tmmathmd)
301 (("font-series" "bold") tmmathbf)
302 (("font-shape" "right") mathrm)
303 (("font-shape" "slanted") mathit)
304 (("font-shape" "italic") mathit)
305 (("font-shape" "small-caps") mathrm)
306 (("math-font" "cal") mathcal)
307 (("math-font" "cal*") mathscr)
308 (("math-font" "cal**") EuScript)
309 (("math-font" "Euler") mathfrak)
310 (("math-font" "Bbb") mathbb)
311 (("math-font" "Bbb*") mathbbm)
312 (("math-font" "Bbb**") mathbbmss)
313 (("math-font" "Bbb***") mathbb)
314 (("math-font" "Bbb****") mathds)
315 (("math-font-family" "mr") mathrm)
316 (("math-font-family" "ms") mathsf)
317 (("math-font-family" "mt") mathtt)
318 (("math-font-family" "normal") mathnormal)
319 (("math-font-family" "rm") mathrm)
320 (("math-font-family" "ss") mathsf)
321 (("math-font-family" "tt") mathtt)
322 (("math-font-family" "bf") mathbf)
323 (("math-font-family" "it") mathit)
324 (("math-font-series" "bold") tmmathbf))
325
326 (logic-table tex-assign-cmd%
327 (("font-family" "rm") rmfamily)
328 (("font-family" "ss") ssfamily)
329 (("font-family" "tt") ttfamily)
330 (("font-series" "medium") mdseries)
331 (("font-series" "bold") bfseries)
332 (("font-shape" "right") upshape)
333 (("font-shape" "slanted") slshape)
334 (("font-shape" "italic") itshape)
335 (("font-shape" "small-caps") scshape))
336
337 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
338 ;; Manipulation of the environment
339 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
340
341 (define (tmtex-env-list var)
342 (let ((r (ahash-ref tmtex-env var)))
343 (if r r '())))
344
345 (define (tmtex-env-get var)
346 (let ((val (tmtex-env-list var)))
347 (and (pair? val) (car val))))
348
349 (define (tmtex-env-get-previous var)
350 (let ((val (tmtex-env-list var)))
351 (if (or (null? val) (null? (cdr val))) #f
352 (cadr val))))
353
354 (define (tmtex-math-mode?)
355 (== (tmtex-env-get "mode") "math"))
356
357 (tm-define (tmtex-env-set var val)
358 (ahash-set! tmtex-env var (cons val (tmtex-env-list var))))
359
360 (tm-define (tmtex-env-reset var)
361 (let ((val (tmtex-env-list var)))
362 (if (nnull? val)
363 (ahash-set! tmtex-env var (cdr val)))))
364
365 (tm-define (tmtex-env-assign var val)
366 (tmtex-env-reset var)
367 (tmtex-env-set var val))
368
369 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
370 ;; Frequently used TeX construction subroutines
371 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
372
373 (tm-define (tmtex-concat-sep l)
374 (set! l (list-intersperse l '(!concat (tmsep) " ")))
375 (if (null? l) '() `((!concat ,@l))))
376
377 (tm-define (tmtex-concat-Sep l)
378 (set! l (list-intersperse l '(!concat (tmSep) " ")))
379 (if (null? l) '() `((!concat ,@l))))
380
381 (define (tex-concat-similar l)
382 (cond ((or (null? l) (null? (cdr l))) l)
383 ((> (length l) 1000)
384 (let* ((s (quotient (length l) 2))
385 (h (list-head l s))
386 (t (list-tail l s)))
387 (tex-concat-similar `((!concat ,@h) (!concat ,@t)))))
388 (else
389 (let ((r (tex-concat-similar (cdr l))))
390 (cond ((and (func? (car l) '!sub) (func? (car r) '!sub))
391 (cons (list '!sub (tex-concat (list (cadar l) (cadar r))))
392 (cdr r)))
393 ((and (func? (car l) '!sup) (func? (car r) '!sup))
394 (cons (list '!sup (tex-concat (list (cadar l) (cadar r))))
395 (cdr r)))
396 (else (cons (car l) r)))))))
397
398 (define (tex-concat-list l)
399 (cond ((null? l) l)
400 ((== (car l) "") (tex-concat-list (cdr l)))
401 ((func? (car l) '!concat) (append (cdar l) (tex-concat-list (cdr l))))
402 (else (cons (car l) (tex-concat-list (cdr l))))))
403
404 (tm-define (tex-concat l)
405 (:synopsis "Horizontal concatenation of list of LaTeX expressions")
406 (let ((r (tex-concat-similar (tex-concat-list l))))
407 (if (null? r) ""
408 (if (null? (cdr r)) (car r)
409 (cons '!concat r)))))
410
411 (define (tex-concat-strings l)
412 (cond ((< (length l) 2) l)
413 ((and (string? (car l)) (string? (cadr l)))
414 (tex-concat-strings (cons (string-append (car l) (cadr l)) (cddr l))))
415 (else (cons (car l) (tex-concat-strings (cdr l))))))
416
417 (tm-define (tex-concat* l)
418 (:synopsis "Variant of tex-concat which concatenates adjacent strings")
419 (tex-concat (tex-concat-strings l)))
420
421 (tm-define (tex-apply . l)
422 (if (or (tmtex-math-mode?) (logic-in? (car l) tmpre-sectional%)) l
423 (list '!group l)))
424
425 (tm-define (tex-math-apply . l)
426 (if (tmtex-math-mode?) l
427 (list 'ensuremath l)))
428
429 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
430 ;; Strings
431 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
432
433 (define (string-starts? s r)
434 (and (>= (string-length s) (string-length r))
435 (== (substring s 0 (string-length r)) r)))
436
437 (define (tmtex-modified-token op s i)
438 (tex-math-apply op
439 (if (= (string-length s) (+ i 1))
440 (substring s i (string-length s))
441 (tex-apply (string->symbol (substring s i (string-length s)))))))
442
443 (logic-table latex-special-symbols%
444 ("less" #\<)
445 ("gtr" #\>)
446 ("box" (Box))
447 ("over" #\:)
448 ("||" (|)) ;; |
449 ("precdot" (tmprecdot)))
450
451 (logic-table latex-text-symbols%
452 ("#20AC" euro)
453 ("cent" textcent)
454 ("circledR" textregistered)
455 ("copyright" textcopyright)
456 ("currency" textcurrency)
457 ("degree" textdegree)
458 ("mu" textmu)
459 ("onehalf" textonehalf)
460 ("onequarter" textonequarter)
461 ("onesuperior" textonesuperior)
462 ("paragraph" P)
463 ("threequarters" textthreequarters)
464 ("threesuperior" textthreesuperior)
465 ("trademark" texttrademark)
466 ("twosuperior" texttwosuperior)
467 ("yen" textyen))
468
469 (tm-define (tmtex-token-sub s group?)
470 (cond ((logic-ref latex-special-symbols% s)
471 (logic-ref latex-special-symbols% s))
472 ((string-starts? s "up-") (tmtex-modified-token 'mathrm s 3))
473 ;;((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4))
474 ((and (string-starts? s "bbb-")
475 (>= (string-length s) 5)
476 (string-number? (substring s 4 5)))
477 (tmtex-modified-token 'mathbbm s 4))
478 ((string-starts? s "bbb-") (tmtex-modified-token 'mathbb s 4))
479 ((string-starts? s "cal-") (tmtex-modified-token 'mathcal s 4))
480 ((string-starts? s "frak-") (tmtex-modified-token 'mathfrak s 5))
481 ((string-starts? s "b-cal-")
482 (tex-math-apply 'tmmathbf (tmtex-modified-token 'mathcal s 6)))
483 ((string-starts? s "b-up-") (tmtex-modified-token 'mathbf s 5))
484 ((string-starts? s "b-") (tmtex-modified-token 'tmmathbf s 2))
485 ((and (not (tmtex-math-mode?)) (logic-ref latex-text-symbols% s))
486 (list '!group (list (logic-ref latex-text-symbols% s))))
487 ((and (string-starts? s "#") (not tmtex-use-catcodes?))
488 (let* ((qs (string-append "<" s ">"))
489 (cv (string-convert qs "Cork" "UTF-8")))
490 (list '!widechar (string->symbol cv))))
491 ((and (string-starts? s "#") tmtex-use-catcodes?)
492 (let* ((qs (string-append "<" s ">"))
493 (us (string-convert qs "Cork" "UTF-8"))
494 (cv (string-convert us "UTF-8" "LaTeX")))
495 (list '!widechar (string->symbol cv))))
496 (else (let* ((s2 (string-replace s "-" ""))
497 (ss (list (string->symbol s2))))
498 (cond ((logic-in? (car ss) tmtex-protected-symbol%)
499 (with sy (string->symbol (string-append "tmx" s2))
500 (list '!symbol (list sy))))
501 ((not (logic-in? (car ss) latex-symbol%))
502 (display* "TeXmacs] non converted symbol: " s "\n")
503 (list '!symbol (list 'nonconverted s2)))
504 (group? (list '!group ss))
505 (else (list '!symbol ss)))))))
506
507 (define (tmtex-token l routine group?)
508 (receive (p1 p2) (list-break (cdr l) (lambda (x) (== x #\>)))
509 (let* ((s (list->string p1))
510 (q (if (null? p2) '() (cdr p2)))
511 (r (routine q)))
512 (cons (tmtex-token-sub s group?) r))))
513
514 (define (tmtex-text-sub head l)
515 (if (string? head)
516 (append (string->list head) (tmtex-text-list (cdr l)))
517 (append (list head) (tmtex-text-list (cdr l)))))
518
519 (define (tmtex-special-char? c)
520 (string-index "#$%&_{}" c))
521
522 (define (tmtex-break-char? c)
523 (string-index "+ -:=,?;()[]{}<>/" c))
524
525 (define (tmtex-text-list-space l)
526 (cond ((null? l) l)
527 ((== (car l) #\space)
528 (cons (list (string->symbol " ")) (tmtex-text-list-space (cdr l))))
529 (else (tmtex-text-list l))))
530
531 (define (tmtex-text-list l)
532 (if (null? l) l
533 (let ((c (car l)))
534 (cond ((== c #\<) (tmtex-token l tmtex-text-list #t))
535 ((== c #\space) (cons c (tmtex-text-list-space (cdr l))))
536 ((tmtex-special-char? c)
537 (cons (list (string->symbol (char->string c)))
538 (tmtex-text-list (cdr l))))
539 ((== c #\~) (tmtex-text-sub "\\~{}" l))
540 ((== c #\^) (tmtex-text-sub "\\^{}" l))
541 ((== c #\\) (tmtex-text-sub '(textbackslash) l))
542 ((== c #\`) (tmtex-text-sub "`" l))
543 ((== c #\00) (tmtex-text-sub "\\`{}" l))
544 ((== c #\01) (tmtex-text-sub "\\'{}" l))
545 ((== c #\04) (tmtex-text-sub "\\\"{}" l))
546 ((== c #\05) (tmtex-text-sub "\\H{}" l))
547 ((== c #\06) (tmtex-text-sub "\\r{}" l))
548 ((== c #\07) (tmtex-text-sub "\\v{}" l))
549 ((== c #\10) (tmtex-text-sub "\\u{}" l))
550 ((== c #\11) (tmtex-text-sub "\\={}" l))
551 ((== c #\12) (tmtex-text-sub "\\.{}" l))
552 ((== c #\14) (tmtex-text-sub "\\k{}" l))
553 ((== c #\20) (tmtex-text-sub "``" l))
554 ((== c #\21) (tmtex-text-sub "''" l))
555 ((== c #\22) (tmtex-text-sub ",," l))
556 ((== c #\25) (tmtex-text-sub "--" l))
557 ((== c #\26) (tmtex-text-sub "---" l))
558 ((== c #\27) (tmtex-text-sub "{}" l))
559 ((== c #\33) (tmtex-text-sub "ff" l))
560 ((== c #\34) (tmtex-text-sub '(textbackslash) l))
561 ((== c #\35) (tmtex-text-sub "fl" l))
562 ((== c #\36) (tmtex-text-sub "ffi" l))
563 ((== c #\37) (tmtex-text-sub "ffl" l))
564 ((== c #\174) (tmtex-text-sub '(textbar) l))
565 (else
566 (append
567 (if (or tmtex-use-unicode? tmtex-use-ascii?)
568 (string->list (string-convert (char->string c)
569 "Cork" "UTF-8"))
570 (list c))
571 (tmtex-text-list (cdr l))))))))
572
573 (define (tmtex-math-operator l)
574 (receive (p q) (list-break l (lambda (c) (not (char-alphabetic? c))))
575 (let* ((op (tmtex-textual (list->string p)))
576 (tail (tmtex-math-list q)))
577 (if (logic-in? (string->symbol op) latex-operator%)
578 (cons (list '!symbol (tex-apply (string->symbol op))) tail)
579 (cons (post-process-math-text (tex-apply 'tmop op)) tail)))))
580
581 (define (tmtex-math-list l)
582 (if (null? l) l
583 (let ((c (car l)))
584 (cond ((== c #\<) (tmtex-token l tmtex-math-list #f))
585 ((tmtex-special-char? c)
586 (cons (list (string->symbol (char->string c)))
587 (tmtex-math-list (cdr l))))
588 ((== c #\~) (tmtex-math-list (cdr l)))
589 ((== c #\^) (tmtex-math-list (cdr l)))
590 ((== c #\\)
591 (cons (list 'backslash) (tmtex-math-list (cdr l))))
592 ;; ((== c #\*) (cons '(*) (tmtex-math-list (cdr l))))
593 ((== c #\*) (tmtex-math-list (cdr l)))
594 ((== c #\') (append (list '(prime)) (tmtex-math-list (cdr l))))
595 ((== c #\`) (append (list '(backprime)) (tmtex-math-list (cdr l))))
596 ;; ((== c #\space) (tmtex-math-list (cdr l)))
597 ((and (char-alphabetic? c)
598 (nnull? (cdr l))
599 (char-alphabetic? (cadr l)))
600 (tmtex-math-operator l))
601 (else
602 (with c
603 (if (or tmtex-use-unicode? tmtex-use-ascii?)
604 (string->list (string-convert (char->string c)
605 "Cork" "UTF-8"))
606 (list c))
607 (append c (tmtex-math-list (cdr l)))))))))
608
609 (define (tmtex-verb-list l)
610 (if (null? l) l
611 (let ((c (car l)))
612 (if (== c #\<)
613 (let ((r (tmtex-token l tmtex-verb-list #t)))
614 (if (char? (car r)) r (cdr r)))
615 (cons c (tmtex-verb-list (cdr l)))))))
616
617 (define (tmtex-string-break? x start)
618 (or (not (char? x))
619 (and (tmtex-math-mode?)
620 (or (tmtex-break-char? x)
621 (and (char-alphabetic? x) (char-numeric? start))
622 (and (char-alphabetic? start) (char-numeric? x))))))
623
624 (define (tmtex-string-produce l)
625 (if (null? l) l
626 (if (not (tmtex-string-break? (car l) (car l)))
627 (receive (p q)
628 (list-break l (lambda (x) (tmtex-string-break? x (car l))))
629 (cons (list->string p) (tmtex-string-produce q)))
630 (if (equal? (car l) #\space)
631 (tmtex-string-produce (cdr l))
632 (cons (if (char? (car l)) (char->string (car l)) (car l))
633 (tmtex-string-produce (cdr l)))))))
634
635 (define (tmtex-string s)
636 (if (> (string-length s) 1000)
637 `(!concat ,@(map tmtex (tmstring-split s)))
638 (let* ((l (string->list s))
639 (t (if (tmtex-math-mode?)
640 (tmtex-math-list l)
641 (tmtex-text-list l)))
642 (r (tmtex-string-produce t)))
643 (tex-concat r))))
644
645 (define (string-convert* what from to)
646 (with c (string->list what)
647 (apply string-append
648 (map (lambda (x) (string-convert (char->string x) from to)) c))))
649
650 (define (tmtex-verb-string s)
651 (when (nstring? s)
652 (set! s (texmacs->verbatim (tm->tree s))))
653 (let* ((l (string->list s))
654 (t (tmtex-verb-list l))
655 (r (tmtex-string-produce t)))
656 (if (or tmtex-use-unicode? tmtex-use-ascii?)
657 (set! r (map (lambda (x) (string-convert* x "Cork" "UTF-8")) r))
658 (set! r (map unescape-angles r)))
659 (tex-concat r)))
660
661 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
662 ;; Entire files
663 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
664
665 (tm-define (tmtex-transform-style x)
666 (cond ((in? x '("generic" "exam"
667 "old-generic" "old-article"
668 "tmarticle" "tmdoc" "mmxdoc")) "article")
669 ((in? x '("book" "old-book" "tmbook" "tmmanual")) "book")
670 ((in? x '("letter" "old-letter")) "letter")
671 ((in? x '("beamer" "old-beamer")) "beamer")
672 ((in? x '("seminar" "old-seminar")) "slides")
673 ((not tmtex-replace-style?) x)
674 (else #f)))
675
676 (define (tmtex-filter-styles l)
677 (if (null? l) l
678 (let* ((next (tmtex-transform-style (car l)))
679 (tail (tmtex-filter-styles (cdr l))))
680 (if next (cons next tail) tail))))
681
682 (define (macro-definition? x)
683 (and (func? x 'assign 2)
684 (string? (cadr x))
685 (func? (caddr x) 'macro)))
686
687 (define (tmtex-filter-style-macro t)
688 (letrec ((ndef-style? (lambda (x env) (or (not (macro-definition? x))
689 (nin? (cadr x) env))))
690 (filter-style-macro
691 (lambda (t env)
692 (cond ((nlist? t) t)
693 (else (map (cut filter-style-macro <> env)
694 (filter (cut ndef-style? <> env) t)))))))
695 (with env (append (logic-first-list 'tmtex-methods%)
696 (logic-first-list 'tmtex-tmstyle%))
697 (filter-style-macro t env))))
698
699 (define (comment-preamble t)
700 (cond ((string? t) `(!comment ,t))
701 ((or (func? t 'para)
702 (func? t 'concat)
703 (func? t 'document)) (map comment-preamble t))
704 (else t)))
705
706 (define (tmtex-filter-preamble l)
707 (cond ((or (nlist? l) (null? l)) '())
708 ((macro-definition? l) (list l))
709 ((and (func? l 'hide-preamble 1)
710 (list>0? (cadr l))) (map comment-preamble (cdadr l)))
711 (else (append-map tmtex-filter-preamble (cdr l)))))
712
713 (define (tmtex-non-preamble-statement? l)
714 (cond ((or (nlist? l) (null? l)) #t)
715 ((== (car l) 'assign) #f)
716 ((== (car l) 'hide-preamble) #f)
717 ((func? l 'mtm 2) (tmtex-non-preamble-statement? (caddr l)))
718 (else #t)))
719
720 (define (tmtex-filter-body l)
721 (cond ((or (nlist? l) (null? l)) l)
722 ((== (car l) 'assign) "")
723 ((== (car l) 'hide-preamble) "")
724 ((in? (car l) '(concat document))
725 (with a (list-filter (cdr l) tmtex-non-preamble-statement?)
726 (if (null? a)
727 (if (== (car l) 'concat) "" '(document ""))
728 (cons (car l) (map tmtex-filter-body a)))))
729 (else (cons (car l) (map tmtex-filter-body (cdr l))))))
730
731 (define (tmtex-filter-duplicates* l t)
732 (cond ((null? l) l)
733 ((func? (car l) 'assign 2)
734 (let* ((var (cadr (car l)))
735 (r (tmtex-filter-duplicates* (cdr l) t))
736 (dup? (ahash-ref t var)))
737 (ahash-set! t var #t)
738 (if dup? r (cons (car l) r))))
739 ((or (func? (car l) 'concat)
740 (func? (car l) 'para)
741 (func? (car l) 'document))
742 (with r (tmtex-filter-duplicates* (cdr l) t)
743 (cons (cons (caar l) (tmtex-filter-duplicates* (cdar l) t)) r)))
744 (else (cons (car l) (tmtex-filter-duplicates* (cdr l) t)))))
745
746 (define (tmtex-filter-duplicates l)
747 (with t (make-ahash-table)
748 (tmtex-filter-duplicates* l t)))
749
750 (define (tmtex-apply-init body init)
751 ;;(display* "init= " init "\n")
752 (cond ((== (assoc-ref init "language") "verbatim")
753 (with init* (assoc-remove! init "language")
754 (tmtex-apply-init `(verbatim ,body) init*)))
755 (else body)))
756
757 (define (tmtex-clean-body b)
758 (when (and (func? b '!document)
759 (> (length b) 1)
760 (== (cadr b) `(!document "")))
761 (set! b (cons (car b) (cddr b))))
762 b)
763
764 (define (tmtex-file l)
765 (let* ((doc (car l))
766 (styles (cadr l))
767 (init* (cadddr l))
768 (init (or (and (!= init* "#f") init*) '(collection)))
769 (init-bis (if (list>1? init)
770 (map (lambda (x) (cons (cadr x) (caddr x))) (cdr init))
771 '()))
772 (att (or (cadddr (cdr l)) '()))
773 (doc-pre (tmtex-filter-preamble (tmtex-filter-style-macro doc)))
774 (doc-preamble (tmtex-filter-duplicates doc-pre))
775 (doc-body-pre (tmtex-filter-body doc))
776 (doc-body (tmtex-apply-init doc-body-pre init-bis)))
777 (init-mode-stats doc-body-pre)
778 (latex-set-texmacs-style (if (pair? styles) (car styles) "none"))
779 (latex-set-texmacs-packages (if (pair? styles) (cdr styles) (list)))
780 (if (== (get-preference "texmacs->latex:expand-user-macros") "on")
781 (set! doc-preamble '()))
782 (if (null? styles) (tmtex doc)
783 (let* ((styles* (tmtex-filter-styles styles))
784 (styles** (if (and (== styles* (list "article"))
785 (in? `(associate "par-columns" "2") init))
786 (list `("twocolumn" "article"))
787 styles*))
788 (preamble* (ahash-with tmtex-env :preamble #t
789 (map-in-order tmtex-pre doc-preamble)))
790 (body* (tmtex-postprocess-body (tmtex doc-body)))
791 (body** (tmtex-clean-body body*))
792 (needs (list tmtex-languages tmtex-colors tmtex-colormaps)))
793 (list '!file body** styles** needs init preamble*)))))
794
795 (define (convert-charset t)
796 (cond ((string? t) (unescape-angles (utf8->cork t)))
797 ((list>0? t) `(,(car t) ,@(map convert-charset (cdr t))))))
798
799 (define (tmtex-ilx l)
800 `(!invariant ,(car l)))
801
802 (define (tmtex-mtm l)
803 (cond ((null? l) "")
804 ((null? (cdr l)) (tmtex (car l)))
805 (else
806 (with lab (car l)
807 (when (func? lab 'mtm 1) (set! lab (cadr lab)))
808 `(!concat (!marker btm ,lab)
809 ,(tmtex (cadr l))
810 (!marker etm ,lab))))))
811
812 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
813 ;; Simple text
814 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
815
816 (define (tmtex-noop . l) "")
817 (define (tmtex-default s l) (cons (string->symbol s) (tmtex-list l)))
818 (define (tmtex-id l) (tmtex (car l)))
819 (define (tmtex-first l) (tmtex (car l)))
820 (define (tmtex-style-first s l) (tmtex (car l)))
821 (define (tmtex-second l) (tmtex (cadr l)))
822 (define (tmtex-style-second s l) (tmtex (cadr l)))
823 (define (tmtex-hide-part s l) "")
824 (define (tmtex-show-part s l) (tmtex (cadr l)))
825
826 (define (tmtex-error l)
827 (display* "TeXmacs] error in conversion: " l "\n")
828 (if tmtex-debug-mode? "(error)" ""))
829
830 (define (tmtex-line-note l)
831 `(tmlinenote ,(tmtex (car l))
832 ,(tmtex-decode-length (cadr l))
833 ,(tmtex-decode-length (caddr l))))
834
835 (define (tmtex-marginal-left-note l)
836 `(marginpar (!option ,(tmtex (cAr l))) ,(tmtex '())))
837
838 (define (tmtex-marginal-right-note l)
839 `(marginpar (!option "") ,(tmtex (cAr l))))
840
841 (define (tmtex-marginal-note l)
842 (cond ((== (car l) "left") (tmtex-marginal-left-note (cdr l)))
843 ((== (car l) "right") (tmtex-marginal-right-note (cdr l)))
844 (else `(marginpar ,(tmtex (cAr l))))))
845
846 (define (tmtex-document l)
847 (cons '!document (tmtex-list l)))
848
849 (define (tmtex-date l)
850 (tmtex-default "tmdate" l))
851
852 (define (tmtex-para l)
853 (cons '!paragraph (tmtex-list l)))
854
855 (define (tmtex-surround-sub l z)
856 (if (null? (cdr l))
857 (list (tex-concat (list (car l) z)))
858 (cons (car l) (tmtex-surround-sub (cdr l) z))))
859
860 (define (tmtex-surround l)
861 (let* ((ll (tmtex-list l))
862 (x (car ll))
863 (y (caddr ll))
864 (z (cadr ll)))
865 (if (func? y '!document)
866 (let* ((a (cadr y))
867 (b (cddr y)))
868 (cons '!document
869 (tmtex-surround-sub
870 (cons (tex-concat (list x a)) b) z)))
871 (tex-concat (list x y z)))))
872
873 (define (tmtex-no-space-before? x)
874 (or (func? x '!sub)
875 (func? x '!sup)
876 (and (string? x) (!= x "")
877 (in? (string-ref x 0) '(#\' #\, #\) #\])))
878 (and (func? x '!concat) (tmtex-no-space-before? (cadr x)))))
879
880 (define (tmtex-no-space-after? x)
881 (or (and (string? x) (!= x "")
882 (in? (string-ref x 0) '(#\( #\[)))
883 (and (func? x '!concat) (tmtex-no-space-after? (cAr x)))))
884
885 (define (tmtex-math-concat-spaces l)
886 (if (or (null? l) (null? (cdr l))) l
887 (let* ((head (car l))
888 (tail (tmtex-math-concat-spaces (cdr l))))
889 (if (or (tmtex-no-space-after? head)
890 (tmtex-no-space-before? (car tail)))
891 (cons head tail)
892 (cons* head " " tail)))))
893
894 (define (tmtex-rewrite-no-break l)
895 (cond ((null? l) l)
896 ((and (string? (car l)) (string-ends? (car l) " ")
897 (nnull? (cdr l)) (== (cadr l) '(no-break)))
898 (let* ((s (substring (car l) 0 (- (string-length (car l)) 1)))
899 (r (tmtex-rewrite-no-break (cddr l))))
900 (if (== s "") (cons '(!nbsp) r) (cons* s '(!nbsp) r))))
901 (else (cons (car l) (tmtex-rewrite-no-break (cdr l))))))
902
903 (define (check-double-script? l sub? sup?)
904 (cond ((or (null? l) (npair? (car l))) #f)
905 ((== (caar l) 'rsub)
906 (or sub? (check-double-script? (cdr l) #t sup?)))
907 ((in? (caar l) '(rsup rprime))
908 (or sup? (check-double-script? (cdr l) sub? #t)))
909 (else #f)))
910
911 (define (pre-scripts l)
912 (cond ((or (null? l) (null? (cdr l))) l)
913 ((check-double-script? (cdr l) #f #f)
914 (if (== (== (caadr l) 'rsub) (== (caaddr l) 'rsub))
915 (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l)))
916 (cddr l)))
917 (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l) ,(caddr l)))
918 (cdddr l)))))
919 (else
920 (cons (car l) (pre-scripts (cdr l))))))
921
922 (define (tmtex-concat l)
923 ;;(display* "l= " l "\n")
924 (if (> (length l) 50)
925 (with s (quotient (length l) 2)
926 (let ((h (list-head l s))
927 (t (list-tail l s)))
928 (tmtex-concat `((concat ,@h) (concat ,@t)))))
929 (if (tmtex-math-mode?)
930 (with l* (pre-scripts l)
931 ;;(when (!= l* l) (display* l " -> " l* "\n"))
932 ;;(display* "l1= " l* "\n")
933 ;;(display* "l2= " (pre-brackets-recurse l*) "\n")
934 ;;(display* "l3= " (tmtex-list (pre-brackets-recurse l*)) "\n")
935 (tex-concat (tmtex-math-concat-spaces
936 (tmtex-list (pre-brackets-recurse l*)))))
937 (tex-concat (tmtex-list (tmtex-rewrite-no-break l))))))
938
939 (define (tmtex-rigid l)
940 (tmtex-function '!group l))
941
942 (define (tmtex-no-first-indentation l) (tex-apply 'noindent))
943 (define (tmtex-line-break l) (tex-apply 'linebreak))
944 (define (tmtex-page-break l) (tex-apply 'pagebreak))
945 (define (tmtex-new-page l) (tex-apply 'newpage))
946 (define (tmtex-no-page-break l) (tex-apply 'nopagebreak))
947 (define (tmtex-next-line l) (list '!nextline))
948 (define (tmtex-no-break l) '(!group (nobreak)))
949 (define (tmtex-emdash l) "---")
950
951 (define (tmtex-new-line l)
952 (if (tmtex-math-mode?) (tmtex-next-line l) (tex-apply '!newline)))
953
954 (tm-define (tmtex-decode-length len)
955 ;; FIXME: should be completed
956 (with s (force-string len)
957 (cond ((string-ends? s "fn") (string-replace s "fn" "em"))
958 ((string-ends? s "tab") (string-replace s "tab" "em"))
959 ((string-ends? s "spc") (string-replace s "spc" "em"))
960 ((string-ends? s "sep") (string-replace s "sep" "ex"))
961 ((string-ends? s "par") (string-replace s "par" "\\columnwidth"))
962 ((string-ends? s "pag") (string-replace s "pag" "\\textheight"))
963 (else s))))
964
965 (define (tmtex-hrule s l) (list 'hrulefill))
966
967 (define (tmtex-hspace l)
968 (let ((s (if (= (length l) 1) (car l) (cadr l))))
969 (cond ((== s "0.5fn") (list 'enspace))
970 ((== s "1fn") (list 'quad))
971 ((== s "2fn") (list 'qquad))
972 ((== s "0.5em") (list 'enspace))
973 ((== s "1em") (list 'quad))
974 ((== s "2em") (list 'qquad))
975 ((== s "0.2spc") (list (string->symbol ",")))
976 ((not (tmtex-math-mode?))
977 (cond ((== s "0.4spc") (list (string->symbol ",")))
978 ((== s "0.6spc") (list (string->symbol ",")))
979 ((== s "0.16667em") (list (string->symbol ",")))
980 (else (tex-apply 'hspace (tmtex-decode-length s)))))
981 ((== s "0.4spc") (list (string->symbol ":")))
982 ((== s "0.6spc") (list (string->symbol ";")))
983 ((== s "-0.6spc") '(!concat (!) (!) (!)))
984 ((== s "-0.4spc") '(!concat (!) (!)))
985 ((== s "-0.2spc") '(!concat (!)))
986 (else (tex-apply 'hspace (tmtex-decode-length s))))))
987
988 (define (tmtex-hspace* s l)
989 (tmtex-hspace l))
990
991 (define (tmtex-vspace l)
992 (let ((s (if (= (length l) 1) (car l) (cadr l))))
993 (cond ((== s "0.5fn") (tex-apply 'smallskip))
994 ((== s "1fn") (tex-apply 'medskip))
995 ((== s "2fn") (tex-apply 'bigskip))
996 (else (tex-apply 'vspace (tmtex-decode-length s))))))
997
998 (define (tmtex-space l)
999 (tmtex-hspace (list (car l))))
1000
1001 (define (into-single-paragraph t)
1002 (set! t (tm-replace t (lambda (x) (tm-in? x '(equation equation*)))
1003 (lambda (x)
1004 (if (and (== (length x) 2)
1005 (tm-func? (cadr x) 'document 1))
1006 `(math ,(cadr (cadr x)))
1007 `(math ,@(cdr x))))))
1008 (set! t (tm-replace t (lambda (x) (tm-func? x 'document))
1009 (lambda (x) `(para ,@(cdr x)))))
1010 t)
1011
1012 (define (tmtex-float-make wide? size type position x capt)
1013 (let* ((pos (string-replace position "f" ""))
1014 (type* (if wide? (string-append type "*") type))
1015 (body (tmtex x))
1016 (caption (tmtex (into-single-paragraph capt)))
1017 (body* `(!paragraph ,body (caption ,caption))))
1018 (cond ((and (== size "big") (== type "figure"))
1019 (if (== pos "")
1020 `((!begin ,type) ,body*)
1021 `((!begin ,type* (!option ,pos)) ,body*)))
1022 ((and (== size "big") (== type "table"))
1023 (if (== pos "")
1024 `((!begin ,type) ,body*)
1025 `((!begin ,type* (!option ,pos)) ,body*)))
1026 (else (list 'tmfloat pos size type* body caption)))))
1027
1028 (define (tmtex-float-table? x)
1029 (or (func? x 'small-table 2) (func? x 'big-table 2)))
1030
1031 (define (tmtex-float-figure? x)
1032 (or (func? x 'small-figure 2) (func? x 'big-figure 2)))
1033
1034 (define (tmtex-float-size l)
1035 (if (list? l)
1036 (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big")
1037 "big"))
1038
1039 (define (tmtex-float-sub wide? position l)
1040 (with pos (string-replace position "f" "")
1041 (cond ((func? l 'document 1)
1042 (tmtex-float-sub wide? pos (cadr l)))
1043 ((tmtex-float-figure? l)
1044 (tmtex-float-make wide? (tmtex-float-size l) "figure"
1045 pos (cadr l) (caddr l)))
1046 ((tmtex-float-table? l)
1047 (tmtex-float-make wide? (tmtex-float-size l) "table"
1048 pos (cadr l) (caddr l)))
1049 (else
1050 (tmtex-float-make wide? "big" "figure"
1051 pos l "")))))
1052
1053 (define (tmtex-float l)
1054 (tmtex-float-sub #f (force-string (cadr l)) (caddr l)))
1055
1056 (define (tmtex-wide-float l)
1057 (tmtex-float-sub #t (force-string (cadr l)) (caddr l)))
1058
1059 (define (tmtex-htab l)
1060 (tex-apply 'hspace* (list 'fill)))
1061
1062 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1063 ;; Make brackets small when necessary
1064 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1065
1066 (define (disable-large? x level)
1067 (cond ((string? x) #t)
1068 ((func? x 'concat)
1069 (list-and (map (cut disable-large? <> level) (cdr x))))
1070 ((tm-in? x '(left mid right)) #t)
1071 ((tm-in? x '(lsub lsup rsub rsup))
1072 (and (> level 0) (disable-large? (cadr x) (- level 1))))
1073 ((tm-in? x '(lprime rprime)) #t)
1074 ((tm-in? x '(wide wide*))
1075 (disable-large? (cadr x) (- level 1)))
1076 ((tm-in? x '(with rigid locus))
1077 (disable-large? (cAr x) level))
1078 ((tm-in? x '(math-up math-ss math-tt math-bf math-it math-sl))
1079 (and (== (tm-arity x) 1) (disable-large? (cadr x) level)))
1080 (else #f)))
1081
1082 (define (make-small s)
1083 (cond ((nstring? s) "<nobracket>")
1084 ((== s ".") "<nobracket>")
1085 ((<= (string-length s) 1) s)
1086 ((and (string-starts? s "<") (string-ends? s ">")) s)
1087 (else (string-append "<" s ">"))))
1088
1089 (define (make-small-bracket x)
1090 (if (tm-in? x '(left mid right)) (make-small (cadr x)) x))
1091
1092 (define (find-right l)
1093 (cond ((null? l) #f)
1094 ((func? (car l) 'left) #f)
1095 ((func? (car l) 'right) 2)
1096 (else (with i (find-right (cdr l)) (and i (+ i 1))))))
1097
1098 (define (pre-brackets l)
1099 (cond ((null? l) l)
1100 ((func? (car l) 'left)
1101 (with n (find-right (cdr l))
1102 (if (not n) (cons (car l) (pre-brackets (cdr l)))
1103 (let* ((r (pre-brackets (sublist l n (length l))))
1104 (m (sublist l 0 n)))
1105 (if (disable-large? `(concat ,@m) 2)
1106 (begin
1107 ;;(display* "< " m "\n")
1108 ;;(display* "> " (map make-small-bracket m) "\n")
1109 (append (map make-small-bracket m) r))
1110 (append m r))))))
1111 (else (cons (car l) (pre-brackets (cdr l))))))
1112
1113 (define (pre-brackets-recurse l)
1114 (with r (pre-brackets l)
1115 (if (== r l) r
1116 (pre-brackets-recurse r))))
1117
1118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1119 ;; Mathematics
1120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1121
1122 (define (convert-around x)
1123 (with d (downgrade-brackets x)
1124 (tmtex-concat (if (pair? d) (cdr d) (list d)))))
1125
1126 (define (tmtex-around l)
1127 (convert-around (cons 'around l)))
1128
1129 (define (tmtex-around* l)
1130 (convert-around (cons 'around* l)))
1131
1132 (define (tmtex-big-around l)
1133 (convert-around (cons 'big-around l)))
1134
1135 (define (tmtex-large-decode s)
1136 (cond ((nstring? s) ".")
1137 ((in? s '("(" ")" "[" "]" "|" "/" ".")) s)
1138 ((== s "||") "\\|")
1139 ((== s "\\") "\\backslash")
1140 ((and (string-starts? s "<") (string-ends? s ">"))
1141 (string-append "\\" (substring s 1 (- (string-length s) 1))))
1142 (else (string-append "\\" s))))
1143
1144 (define (tmtex-large-decode-text s)
1145 (cond ((nstring? s) "")
1146 ((== s ".") "")
1147 ((in? s '("(" ")" "[" "]" "|" "/")) s)
1148 ((in? s '("{" "}")) (string-append "\\" s))
1149 (else
1150 (display* "TeXmacs] non converted bracket: " s "\n")
1151 "")))
1152
1153 (define (tmtex-left l)
1154 (if (tmtex-math-mode?)
1155 (let* ((s (tmtex-large-decode (car l)))
1156 (n (if (= (length l) 2) (string->number (cadr l)) 0))
1157 (b (cond ((not n) "left")
1158 ((= n 1) "bigl")
1159 ((= n 2) "Bigl")
1160 ((= n 3) "biggl")
1161 ((= n 4) "Biggl")
1162 (else "left"))))
1163 (list (string->symbol (string-append b s))))
1164 (tmtex-large-decode-text (car l))))
1165
1166 (define (tmtex-mid l)
1167 (display* "TeXmacs] downgraded large middle delimiter: " (car l) "\n")
1168 (if (tmtex-math-mode?)
1169 (with s (tmtex-large-decode (car l))
1170 (if (== s ".") "" s))
1171 (tmtex-large-decode-text (car l))))
1172
1173 (define (tmtex-right l)
1174 (if (tmtex-math-mode?)
1175 (let* ((s (tmtex-large-decode (car l)))
1176 (n (if (= (length l) 2) (string->number (cadr l)) 0))
1177 (b (cond ((not n) "right")
1178 ((= n 1) "bigr")
1179 ((= n 2) "Bigr")
1180 ((= n 3) "biggr")
1181 ((= n 4) "Biggr")
1182 (else "right"))))
1183 (list (string->symbol (string-append b s))))
1184 (tmtex-large-decode-text (car l))))
1185
1186 (define (tmtex-big-decode s)
1187 (cond ((nstring? s) "bignone")
1188 ((in? s '("sum" "prod" "int" "oint" "coprod")) s)
1189 ((in? s '("iint" "iiint" "iiiint" "idotsint")) s)
1190 ((in? s '("oiint" "oiiint")) s)
1191 ((== s "amalg") "coprod")
1192 ((== s "pluscup") "uplus")
1193 ((== s ".") "bignone")
1194 (else (string-append "big" s))))
1195
1196 (define (tmtex-big l)
1197 (list (string->symbol (tmtex-big-decode (car l)))))
1198
1199 (define (tmtex-decode-long-arrow s)
1200 (cond ((nstring? s) #f)
1201 ((and (string-starts? s "<rubber-") (string-ends? s ">"))
1202 (tmtex-decode-long-arrow (substring s 8 (- (string-length s) 1))))
1203 ((in? s '("minus" "leftarrow" "rightarrow" "leftrightarrow"
1204 "equal" "Leftarrow" "Rightarrow" "Leftrightarrow"
1205 "mapsto" "mapsfrom"))
1206 (string->symbol (string-append "x" s)))
1207 ((in? s '("leftrightarrows" "leftleftarrows"
1208 "threeleftarrows" "fourleftarrows"
1209 "rightleftarrows" "rightrightarrows"
1210 "threerightarrows" "fourrightarrows"))
1211 (string-append "<long" s ">"))
1212 ((== s "Lleftarrow") "<Llongleftarrow>")
1213 ((== s "Rrightarrow") "<Llongrightarrow>")
1214 ((== s "LRleftrightarrow") "<Llongleftrightarrow>")
1215 (else (string-append "<" s ">"))))
1216
1217 (define (tmtex-long-arrow l)
1218 (with cmd (tmtex-decode-long-arrow (car l))
1219 (cond ((and (symbol? cmd) (== (length l) 2))
1220 (list cmd (tmtex (cadr l))))
1221 ((symbol? cmd)
1222 (list cmd (list '!option (tmtex (caddr l))) (tmtex (cadr l))))
1223 ((== (length l) 2)
1224 (list 'overset (tmtex (cadr l)) (tmtex cmd)))
1225 ((== (cadr l) "")
1226 (list 'underset (tmtex (caddr l)) (tmtex cmd)))
1227 (else
1228 (list 'underset (tmtex (caddr l))
1229 (list 'overset (tmtex (cadr l)) (tmtex cmd)))))))
1230
1231 (define (tmtex-below l)
1232 (list 'underset (tmtex (cadr l)) (tmtex (car l))))
1233
1234 (define (tmtex-above l)
1235 (list 'overset (tmtex (cadr l)) (tmtex (car l))))
1236
1237 (define (tmtex-lsub l)
1238 (cond ((== (car l) "") "")
1239 ((tmtex-math-mode?) (tmtex `(concat (!group) (rsub ,(car l)))))
1240 (else (tmtex `(rsub ,(car l))))))
1241
1242 (define (tmtex-lsup l)
1243 (cond ((== (car l) "") "")
1244 ((tmtex-math-mode?) (tmtex `(concat (!group) (rsup ,(car l)))))
1245 (else (tmtex `(rsup ,(car l))))))
1246
1247 (define (tmtex-contains-table? x)
1248 (cond ((nlist? x) #f)
1249 ((and (>= (length x) 2) (== (car x) '!table)) #t)
1250 (else (list-or (map-in-order tmtex-contains-table? (cdr x))))))
1251
1252 (define (tmtex-script which script)
1253 (with r (tmtex script)
1254 (if (tmtex-contains-table? r)
1255 (list which (list 'tmscript r))
1256 (list which r))))
1257
1258 (define (tmtex-rsub l)
1259 (cond ((== (car l) "") "")
1260 ((tmtex-math-mode?) (tmtex-script '!sub (car l)))
1261 (else (list 'tmrsub (tmtex (car l))))))
1262
1263 (define (tmtex-rsup l)
1264 (cond ((== (car l) "") "")
1265 ((tmtex-math-mode?) (tmtex-script '!sup (car l)))
1266 (else (list 'tmrsup (tmtex (car l))))))
1267
1268 (define (tmtex-modulo l)
1269 (tmtex-script 'mod (car l)))
1270
1271 (define (tmtex-frac l)
1272 (tmtex-function 'frac l))
1273
1274 (define (tmtex-sqrt l)
1275 (if (= (length l) 1)
1276 (tmtex-function 'sqrt l)
1277 (list 'sqrt
1278 (list '!option (tmtex (cadr l)))
1279 (tmtex (car l)))))
1280
1281 (define (tmtex-token? s)
1282 (or (= (string-length s) 1)
1283 (and (!= s "")
1284 (== (string-ref s 0) #\<)
1285 (== (string-index s #\>) (- (string-length s) 1)))))
1286
1287 (define (tmtex-wide-star? x)
1288 (cond ((func? x 'wide* 1) (tmtex-wide-star? (cadr x)))
1289 ((nstring? x) #t)
1290 (else (not (tmtex-token? x)))))
1291
1292 (define (tmtex-wide-star l)
1293 (let ((wide? (tmtex-wide-star? (car l)))
1294 (arg (tmtex (car l)))
1295 (acc (cadr l))
1296 (text? (not (tmtex-math-mode?))))
1297 (if (and (string? acc) (string-starts? acc "<wide-"))
1298 (set! acc (string-append "<" (substring acc 6 (string-length acc)))))
1299 (cond ((nstring? acc) arg)
1300 ((in? acc '("<hat>" "^")) (list (if wide? 'uwidehat 'uhat) arg))
1301 ((in? acc '("<tilde>" "~")) (list (if wide? 'uwidetilde 'utilde) arg))
1302 ((== acc "<bar>") (list 'underline arg))
1303 ((== acc "<vect>") (list (if wide? 'underrightarrow 'uvec) arg))
1304 ((== acc "<breve>") (list 'ubreve arg))
1305 ((== acc "<invbreve>") (list 'uinvbreve arg))
1306 ((== acc "<check>") (list 'ucheck arg))
1307 ((== acc "<abovering>") (list 'uring arg))
1308 ((== acc "<acute>") (list 'uacute arg))
1309 ((== acc "<grave>") (list 'ugrave arg))
1310 ((== acc "<dot>") (list 'underdot arg))
1311 ((== acc "<ddot>") (list 'uddot arg))
1312 ((== acc "<dddot>") (list 'udddot arg))
1313 ((== acc "<ddddot>") (list 'uddddot arg))
1314 ((== acc "<rightarrow>") (list 'underrightarrow arg))
1315 ((== acc "<leftarrow>") (list 'underleftarrow arg))
1316 ((== acc "<leftrightarrow>") (list 'underleftrightarrow arg))
1317 ((== acc "<varrightarrow>") (list 'underrightarrow arg))
1318 ((== acc "<varleftarrow>") (list 'underleftarrow arg))
1319 ((== acc "<varleftrightarrow>") (list 'underleftrightarrow arg))
1320 ((in? acc '("<underbrace>" "<underbrace*>"))
1321 (list 'underbrace arg))
1322 ((in? acc '("<overbrace>" "<overbrace*>"))
1323 (tmtex-below `(,(car l) (text (downbracefill)))))
1324 ((in? acc '("<punderbrace>" "<punderbrace*>"))
1325 (list 'underbrace arg))
1326 ((in? acc '("<poverbrace>" "<poverbrace*>"))
1327 (tmtex-below `(,(car l) (text (downbracefill)))))
1328 ;; imperfect translations
1329 ((in? acc '("<squnderbrace>" "<squnderbrace*>"))
1330 (list 'underbrace arg))
1331 ((in? acc '("<sqoverbrace>" "<sqoverbrace*>"))
1332 (tmtex-below `(,(car l) (text (downbracefill)))))
1333 (else
1334 (display* "TeXmacs] non converted accent below: " acc "\n")
1335 arg))))
1336
1337 (define (tmtex-wide? x)
1338 (cond ((func? x 'wide 1) (tmtex-wide? (cadr x)))
1339 ((nstring? x) #t)
1340 (else (not (tmtex-token? x)))))
1341
1342 (define (tmtex-wide l)
1343 (let ((wide? (tmtex-wide? (car l)))
1344 (arg (tmtex (car l)))
1345 (acc (cadr l))
1346 (text? (not (tmtex-math-mode?))))
1347 (if (and (string? acc) (string-starts? acc "<wide-"))
1348 (set! acc (string-append "<" (substring acc 6 (string-length acc)))))
1349 (cond ((nstring? acc) arg)
1350 ((in? acc '("<hat>" "^"))
1351 (list (if text? '^ (if wide? 'widehat 'hat)) arg))
1352 ((in? acc '("<tilde>" "~"))
1353 (list (if text? '~ (if wide? 'widetilde 'tilde)) arg))
1354 ((== (cadr l) "<wide-bar>")
1355 (list (if text? '= 'overline) arg))
1356 ((== acc "<bar>")
1357 (list (if text? '= (if wide? 'overline 'bar)) arg))
1358 ((== acc "<vect>") (list (if wide? 'overrightarrow 'vec) arg))
1359 ((== acc "<breve>") (list (if text? 'u 'breve) arg))
1360 ((== acc "<invbreve>") (list 'invbreve arg))
1361 ((== acc "<check>") (list (if text? 'v 'check) arg))
1362 ((== acc "<abovering>") (list (if text? 'r 'ring) arg))
1363 ((== acc "<acute>")
1364 (list (if text? (string->symbol "'") 'acute) arg))
1365 ((== acc "<grave>")
1366 (list (if text? (string->symbol "`") 'grave) arg))
1367 ((== acc "<dot>")
1368 (list (if text? (string->symbol ".") 'dot) arg))
1369 ((== acc "<ddot>")
1370 (list (if text? (string->symbol "\"") 'ddot) arg))
1371 ((== acc "<dddot>") (list 'dddot arg))
1372 ((== acc "<ddddot>") (list 'ddddot arg))
1373 ((== acc "<rightarrow>") (list 'overrightarrow arg))
1374 ((== acc "<leftarrow>") (list 'overleftarrow arg))
1375 ((== acc "<leftrightarrow>") (list 'overleftrightarrow arg))
1376 ((== acc "<varrightarrow>") (list 'overrightarrow arg))
1377 ((== acc "<varleftarrow>") (list 'overleftarrow arg))
1378 ((== acc "<varleftrightarrow>") (list 'overleftrightarrow arg))
1379 ((in? acc '("<overbrace>" "<overbrace*>"))
1380 (list 'overbrace arg))
1381 ((in? acc '("<underbrace>" "<underbrace*>"))
1382 (tmtex-above `(,(car l) (text (upbracefill)))))
1383 ((in? acc '("<poverbrace>" "<poverbrace*>"))
1384 (list 'overbrace arg))
1385 ((in? acc '("<punderbrace>" "<punderbrace*>"))
1386 (tmtex-above `(,(car l) (text (upbracefill)))))
1387 ;; FIXME: imperfect translations
1388 ((in? acc '("<sqoverbrace>" "<sqoverbrace*>"))
1389 (list 'overbrace arg))
1390 ((in? acc '("<squnderbrace>" "<squnderbrace*>"))
1391 (tmtex-above `(,(car l) (text (upbracefill)))))
1392 (else
1393 (display* "TeXmacs] non converted accent: " acc "\n")
1394 arg))))
1395
1396 (define (tmtex-neg l)
1397 (tmtex-function 'not l))
1398
1399 (define (tmtex-tree l)
1400 (let* ((root (list '!begin "bundle" (tmtex (car l))))
1401 (children (map (lambda (x) (list 'chunk (tmtex x))) (cdr l))))
1402 (list root (tex-concat children))))
1403
1404 (define (tmtex-tree-eps l)
1405 (tmtex-eps (cons 'tree l)))
1406
1407 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1408 ;; Hacks for tables with multi-paragraph cells
1409 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1410
1411 (define (map-or l1 l2)
1412 (if (or (null? l1) (null? l2)) (list)
1413 (cons (or (car l1) (car l2)) (map-or (cdr l1) (cdr l2)))))
1414
1415 (define (tmtex-block-columns t)
1416 (cond ((tm-func? t 'tformat) (tmtex-block-columns (cAr t)))
1417 ((tm-func? t 'table 1) (tmtex-block-columns (cAr t)))
1418 ((tm-func? t 'table)
1419 (let* ((b1 (tmtex-block-columns `(table ,(cadr t))))
1420 (b2 (tmtex-block-columns `(table ,@(cddr t)))))
1421 (map-or b1 b2)))
1422 ((tm-func? t 'row) (map tmtex-block-columns (cdr t)))
1423 ((tm-func? t 'cell) (tmtex-block-columns (cAr t)))
1424 (else (tm-func? t 'document))))
1425
1426 (define (column-numbers l i)
1427 (cond ((null? l) (list))
1428 ((car l) (cons i (column-numbers (cdr l) (+ i 1))))
1429 (else (column-numbers (cdr l) (+ i 1)))))
1430
1431 (define (block-align nr out-of)
1432 (let* ((c (number->string nr))
1433 (p (string-append "p{" (number->string (/ 12.0 out-of)) "cm}")))
1434 `(cwith "1" "-1" ,c ,c "cell-halign" ,p)))
1435
1436 (define (tmtex-block-adjust t)
1437 (cond ((tm-func? t 'tformat)
1438 (append (cDr t) (list (tmtex-block-adjust (cAr t)))))
1439 ((tm-func? t 'table)
1440 (let* ((b (tmtex-block-columns t))
1441 (n (column-numbers b 1)))
1442 (if (null? n) t
1443 `(tformat ,@(map (cut block-align <> (length n)) n) ,t))))
1444 (else t)))
1445
1446 (define (tm-big-figure? t)
1447 (tm-in? t '(big-figure big-table)))
1448
1449 (define (tm-replace-figure t)
1450 (cond ((tm-func? t 'big-figure)
1451 (list 'tmfloat "h" "big" "figure" (cadr t) (caddr t)))
1452 ((tm-func? t 'big-table)
1453 (list 'tmfloat "h" "big" "table" (cadr t) (caddr t)))
1454 (else t)))
1455
1456 (define (tmtex-figure-adjust t)
1457 (tm-replace t tm-big-figure? tm-replace-figure))
1458
1459 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1460 ;; Tables
1461 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1462
1463 (define (tmtex-table-rows-assemble tb bb rows)
1464 (cond ((null? rows)
1465 (if (null? bb) '() (if (car bb) (list (list 'hline)) '())))
1466 (else (append (if (or (car tb) (car bb)) (list (list 'hline)) '())
1467 (cons (cons '!row (map tmtex (car rows)))
1468 (tmtex-table-rows-assemble
1469 (cdr tb) (cdr bb) (cdr rows)))))))
1470
1471 (define (tmtex-table-make p)
1472 (let ((tb (p 'rows 'tborder))
1473 (bb (p 'rows 'bborder))
1474 (l (p 'rows 'content)))
1475 (cons '!table (tmtex-table-rows-assemble tb (cons (car tb) bb) l))))
1476
1477 (define (tmtex-table-args-assemble lb rb ha)
1478 (cond
1479 ((null? ha) (if (null? rb) '() (list (if (car rb) "|" ""))))
1480 (else (cons (if (or (car lb) (car rb)) "|" "")
1481 (cons (car ha) (tmtex-table-args-assemble
1482 (cdr lb) (cdr rb) (cdr ha)))))))
1483
1484 (define (tmtex-table-args p)
1485 (let ((lb (p 'cols 'lborder))
1486 (rb (p 'cols 'rborder))
1487 (l (p 'cols 'halign)))
1488 (apply string-append
1489 (tmtex-table-args-assemble lb (cons (car lb) rb) l))))
1490
1491 (define (tmtex-table-apply key args x)
1492 (let* ((props (logic-ref tmtex-table-props% key))
1493 (wide? (and props (string-contains? (cadr props) "X"))))
1494 (when (== key 'rcl-table)
1495 (latex-add-extra "tabls"))
1496 (when (and (not (tmtex-math-mode?)) (not wide?))
1497 (set! x (tmtex-block-adjust x))
1498 (set! x (tmtex-figure-adjust x)))
1499 (if props
1500 (let* ((env (if (tmtex-math-mode?) "array" "tabular"))
1501 (env* (if wide? (list "tabularx" "1.0\\textwidth") (list env)))
1502 (before (car props))
1503 (after (caddr props))
1504 (defaults (append (tmtable-cell-halign (cadr props))
1505 (tmtable-block-borders (cadddr props))))
1506 (p (tmtable-parser `(tformat ,@defaults ,x)))
1507 (e `(!begin ,@env* ,(tmtex-table-args p)))
1508 (r (tmtex-table-make p)))
1509 (tex-concat (list before (list e r) after)))
1510 (begin
1511 (list `(!begin ,(symbol->string key) ,@args)
1512 (tmtex-table-make (tmtable-parser x)))))))
1513
1514 (define (tmtex-tformat l)
1515 (tmtex-table-apply 'tabular '() (cons 'tformat l)))
1516
1517 (define (tmtex-table l)
1518 (tmtex-table-apply 'tabular '() (cons 'table l)))
1519
1520 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1521 ;; Local and global environment changes
1522 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1523
1524 (define (tmtex-get-with-cmd var val)
1525 (if (tmtex-math-mode?)
1526 (or (logic-ref tex-with-cmd-math% (list var val))
1527 (logic-ref tex-with-cmd% (list var val)))
1528 (logic-ref tex-with-cmd% (list var val))))
1529
1530 (define (tmtex-get-assign-cmd var val)
1531 (if (== var "font-size")
1532 (let ((x (* (string->number val) 10)))
1533 (cond ((< x 1) #f)
1534 ((< x 5.5) 'tiny)
1535 ((< x 6.5) 'scriptsize)
1536 ((< x 7.5) 'footnotesize)
1537 ((< x 9.5) 'small)
1538 ((< x 11.5) 'normalsize)
1539 ((< x 13.5) 'large)
1540 ((< x 15.5) 'Large)
1541 ((< x 18.5) 'LARGE)
1542 ((< x 22.5) 'huge)
1543 ((< x 50) 'Huge)
1544 (else #f)))
1545 (logic-ref tex-assign-cmd% (list var val))))
1546
1547 (define (tmlength->texlength len)
1548 ;; TODO: rewrite (quote x) -> x and (tmlen ...) -> ...pt
1549 (with tmlen (string->tmlength (force-string len))
1550 (if (tmlength-null? tmlen) "0pt"
1551 (let* ((val (tmlength-value tmlen))
1552 (unit (symbol->string (tmlength-unit tmlen)))
1553 (val-string (number->string val)))
1554 (cond ((== unit "fn") (string-append val-string "em"))
1555 (else len))))))
1556
1557 (define (tmtex-make-parmod x y z arg flag?)
1558 (set! x (tmlength->texlength x))
1559 (set! y (tmlength->texlength y))
1560 (set! z (tmlength->texlength z))
1561 (if (and (tmlength-zero? (string->tmlength x))
1562 (tmlength-zero? (string->tmlength y))
1563 (tmlength-zero? (string->tmlength z))
1564 flag?)
1565 arg
1566 (list (list '!begin "tmparmod" x y z) arg)))
1567
1568 (define (tmtex-make-parsep x arg)
1569 (set! x (tmlength->texlength x))
1570 (list (list '!begin "tmparsep" x) arg))
1571
1572 (define (tmtex-make-lang val arg)
1573 (if (== val "verbatim")
1574 `(tt ,arg)
1575 (begin
1576 (if (nin? val tmtex-languages)
1577 (set! tmtex-languages (append (list val) tmtex-languages)))
1578 (if (texout-multiline? arg)
1579 `((!begin "otherlanguage" ,val) ,arg)
1580 `(foreignlanguage ,val ,arg)))))
1581
1582 (define (tmtex-decode-color s . force-html)
1583 (with cm (if (string-starts? s "#") "HTML" (named-color->xcolormap s))
1584 (cond ((and (== cm "none") (nnull? force-html))
1585 (tmtex-decode-color (get-hex-color s) force-html))
1586 ((and (== cm "HTML") (nnull? force-html))
1587 `((!option "HTML") ,(html-color->latex-xcolor s)))
1588 ((== cm "texmacs")
1589 (when (nin? s tmtex-colors)
1590 (set! tmtex-colors (append (list s) tmtex-colors)))
1591 (string-replace s " " ""))
1592 ((in? cm (list "x11names"))
1593 (tmtex-decode-color (get-hex-color s) #t))
1594 (else
1595 (when (and (nin? cm tmtex-colormaps)
1596 (!= cm "xcolor") (!= cm "none"))
1597 (set! tmtex-colormaps (append (list cm) tmtex-colormaps)))
1598 (string-replace s " " "")))))
1599
1600 (define (tmtex-make-color val arg)
1601 (with ltxcolor (tmtex-decode-color val #t)
1602 (if (list? ltxcolor)
1603 `(!group (!append (color ,@ltxcolor) ,arg))
1604 `(tmcolor ,ltxcolor ,arg))))
1605
1606 (define (post-process-math-text t)
1607 (cond ((or (nlist? t) (!= (length t) 2)) t)
1608 ((nin? (car t) '(mathrm mathbf mathsf mathit mathsl mathtt tmop)) t)
1609 ((and (string? (cadr t)) (string-alpha? (cadr t))) t)
1610 ((func? t 'mathrm 1) `(textrm ,(cadr t)))
1611 ((func? t 'mathbf 1) `(textbf ,(cadr t)))
1612 ((func? t 'mathsf 1) `(textsf ,(cadr t)))
1613 ((func? t 'mathit 1) `(textit ,(cadr t)))
1614 ((func? t 'mathsl 1) `(textsl ,(cadr t)))
1615 ((func? t 'mathtt 1) `(texttt ,(cadr t)))
1616 ((func? t 'tmop 1) `(textrm ,(cadr t)))
1617 (else t)))
1618
1619 (define (tmtex-with-one var val arg)
1620 (if (== var "mode")
1621 (let ((old (tmtex-env-get-previous "mode")))
1622 (cond ((and (== val "text") (!= old "text"))
1623 (list 'text arg))
1624 ((and (== val "math") (!= old "math")
1625 (ahash-ref tmtex-env :preamble))
1626 (list 'ensuremath arg))
1627 ((and (== val "math") (!= old "math"))
1628 (list '!math arg))
1629 ((and (== val "prog") (== old "text"))
1630 `(tt ,arg))
1631 ((and (== val "prog") (== old "math"))
1632 `(text (tt ,arg)))
1633 (else arg)))
1634 (let ((w (tmtex-get-with-cmd var val))
1635 (a (tmtex-get-assign-cmd var val)))
1636 (cond ((and w (tm-func? arg w 1)) arg)
1637 ((in? w '(mathrm mathbf mathsf mathit mathtt mathsl))
1638 (post-process-math-text (list w arg)))
1639 (w (list w arg))
1640 (a (list '!group (tex-concat (list (list a) " " arg))))
1641 ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg #t))
1642 ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg #t))
1643 ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg #f))
1644 ((== "par-par-sep" var) (tmtex-make-parsep val arg))
1645 ((== var "language") (tmtex-make-lang val arg))
1646 ((== var "color") (tmtex-make-color val arg))
1647 (else arg)))))
1648
1649 (define (tmtex-with l)
1650 (cond ((null? l) "")
1651 ((null? (cdr l)) (tmtex (car l)))
1652 ((func? (cAr l) 'graphics) (tmtex-eps (cons 'with l)))
1653 (else (let ((var (force-string (car l)))
1654 (val (force-string (cadr l)))
1655 (next (cddr l)))
1656 (tmtex-env-set var val)
1657 (let ((r (tmtex-with-one var val (tmtex-with next))))
1658 (tmtex-env-reset var)
1659 r)))))
1660
1661 (define (tmtex-with-wrapped l)
1662 (if (and (== (length l) 3)
1663 (== (car l) "par-columns")
1664 (== (cadr l) "1")
1665 (tm-in? (caddr l) '(small-figure big-figure
1666 small-table big-table)))
1667 (tmtex-float-sub #t "h" (caddr l))
1668 (tmtex-with l)))
1669
1670 (define (tmtex-var-name-sub l)
1671 (if (null? l) l
1672 (let ((c (car l)) (r (tmtex-var-name-sub (cdr l))))
1673 (cond ((char-alphabetic? c) (cons c r))
1674 ((char-numeric? c)
1675 (cond ((char=? c #\0) (cons* #\z #\e #\r #\o r))
1676 ((char=? c #\1) (cons* #\o #\n #\e r))
1677 ((char=? c #\2) (cons* #\t #\w #\o r))
1678 ((char=? c #\3) (cons* #\t #\h #\r #\e #\e r))
1679 ((char=? c #\4) (cons* #\f #\o #\u #\r r))
1680 ((char=? c #\5) (cons* #\f #\i #\v #\e r))
1681 ((char=? c #\6) (cons* #\s #\i #\x r))
1682 ((char=? c #\7) (cons* #\s #\e #\v #\e #\n r))
1683 ((char=? c #\8) (cons* #\e #\i #\g #\h #\t r))
1684 ((char=? c #\9) (cons* #\n #\i #\n #\e r))
1685 (else r)))
1686 ((and (char=? c #\*) (null? (cdr l))) (list c))
1687 (else r)))))
1688
1689 (define (tmtex-var-name var)
1690 (cond ((nstring? var) "")
1691 ((logic-in? (string->symbol var) tmtex-protected%)
1692 (string-append "tm" var))
1693 ((<= (string-length var) 1) var)
1694 (else
1695 (with r (list->string (tmtex-var-name-sub (string->list var)))
1696 (if (and (string-occurs? "*" r)
1697 (== (latex-type r) "undefined"))
1698 (string-replace r "*" "star")
1699 r)))))
1700
1701 (define (tmtex-tex-arg l)
1702 (cons '!arg l))
1703
1704 (define (tmtex-args-search x args)
1705 (cond ((null? args) #f)
1706 ((== x (car args)) 1)
1707 (else
1708 (let ((n (tmtex-args-search x (cdr args))))
1709 (if n (+ 1 n) #f)))))
1710
1711 (define (tmtex-args-sub l args)
1712 (if (null? l) l
1713 (cons (tmtex-args (car l) args)
1714 (tmtex-args-sub (cdr l) args))))
1715
1716 (define (tmtex-args x args)
1717 (cond ((nlist? x) x)
1718 ((or (func? x 'arg) (func? x 'value))
1719 (let ((n (tmtex-args-search (cadr x) args)))
1720 (if n (list '!arg (number->string n)) (tmtex-args-sub x args))))
1721 (else (tmtex-args-sub x args))))
1722
1723 (define (tmtex-assign l)
1724 (let* ((var (tmtex-var-name (car l)))
1725 (bsvar (string-append "\\" var))
1726 (type (latex-type var))
1727 (def (if (== type "undefined") 'newcommand 'providecommand))
1728 (val (cadr l)))
1729 (while (func? val 'quote 1) (set! val (cadr val)))
1730 (if (!= var "")
1731 (begin
1732 (tmtex-env-assign var val)
1733 (cond ((string? val)
1734 (let ((a (tmtex-get-assign-cmd var val)))
1735 (if a (list a) (list def bsvar (tmtex val)))))
1736 ((or (func? val 'macro) (func? val 'func))
1737 (if (null? (cddr val))
1738 (list def bsvar (tmtex (cAr val)))
1739 (list def bsvar
1740 (list '!option (number->string (- (length val) 2)))
1741 (tmtex (tmtex-args (cAr val) (cDdr val))))))
1742 (else (list def bsvar (tmtex val)))))
1743 "")))
1744
1745 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1746 ;; Other primitives
1747 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1748
1749 (define (tmtex-quote l)
1750 (tmtex (car l)))
1751
1752 (define (tmtex-hidden-binding l)
1753 (if (and (== (length l) 2) (string->number (force-string (cAr l))))
1754 (list 'custombinding (force-string (cAr l)))
1755 ""))
1756
1757 (define (tmtex-label l)
1758 (list 'label (force-string (car l))))
1759
1760 (define (tmtex-reference l)
1761 (list 'ref (force-string (car l))))
1762
1763 (define (tmtex-pageref l)
1764 (list 'pageref (force-string (car l))))
1765
1766 (define (tmtex-eqref s l)
1767 (list 'eqref (force-string (car l))))
1768
1769 (define (tmtex-smart-ref s l)
1770 (let* ((ss (map force-string l))
1771 (key (string-recompose ss ",")))
1772 (list 'Cref key)))
1773
1774 (define (tmtex-specific l)
1775 (cond ((== (car l) "latex") (tmtex-tt (cadr l)))
1776 ((== (car l) "image") (tmtex-eps (cadr l)))
1777 ((== (car l) "printer") (tmtex (cadr l)))
1778 ((== (car l) "odd") `(ifthispageodd ,(tmtex (cadr l)) ""))
1779 ((== (car l) "even") `(ifthispageodd "" ,(tmtex (cadr l))))
1780 (else "")))
1781
1782 (define (tmtex-eps-names)
1783 (set! tmtex-serial (+ tmtex-serial 1))
1784 (let* ((suffix (if (get-boolean-preference "native pdf") ".pdf" ".eps"))
1785 (postfix (string-append "-" (number->string tmtex-serial) suffix))
1786 (name-url (url-glue tmtex-image-root-url postfix))
1787 (name-string (string-append tmtex-image-root-string postfix)))
1788 (values name-url name-string)))
1789
1790 (define (tmtex-eps x)
1791 (if (tmtex-math-mode?) (set! x `(with "mode" "math" ,x)))
1792 (receive (name-url name-string) (tmtex-eps-names)
1793 (let* ((extents (print-snippet name-url x #t))
1794 (unit (* (/ 1.0 60984.0) (/ 600.0 (tenth extents))))
1795 (x3 (* unit (first extents)))
1796 (y3 (* unit (second extents)))
1797 (x4 (* unit (third extents)))
1798 (y4 (* unit (fourth extents)))
1799 (x1 (* unit (fifth extents)))
1800 (y1 (* unit (sixth extents)))
1801 (x2 (* unit (seventh extents)))
1802 (y2 (* unit (eighth extents)))
1803 (lm (string-append (number->string (- x3 x1)) "cm"))
1804 (rm (string-append (number->string (- x2 x4)) "cm"))
1805 (ww (string-append (number->string (- x4 x3)) "cm"))
1806 (hh (string-append (number->string (- y4 y3)) "cm"))
1807 (opt `(!option ,(string-append "width=" ww ",height=" hh)))
1808 (rat (/ y3 (- y4 y3)))
1809 (dy `(!concat ,(number->string rat) (height)))
1810 (rb `(raisebox ,dy (includegraphics ,opt ,name-string))))
1811 ;; TODO: top and bottom margins
1812 ;;(display* name-url ": " x1 ", " y1 "; " x2 ", " y2 "\n")
1813 ;;(display* name-url ": " x3 ", " y3 "; " x4 ", " y4 "\n")
1814 (if (and (< (abs (- x3 x1)) 0.01) (< (abs (- x2 x4)) 0.01)) rb
1815 `(!concat (hspace ,lm) ,rb (hspace ,rm))))))
1816
1817 (define (tmtex-make-eps s l)
1818 (tmtex-eps (cons (string->symbol s) l)))
1819
1820 (define (tmtex-graphics l)
1821 (tmtex-eps (cons 'graphics l)))
1822
1823 (define (tmtex-as-eps name)
1824 (let* ((u (url-relative current-save-target (unix->url name)))
1825 (suffix (url-suffix u))
1826 (fm (string-append (format-from-suffix suffix) "-file")))
1827 (if (and (url-exists? u) (in? suffix (list "eps" "pdf" "png" "jpg")))
1828 (with p (url->string "$TEXMACS_PATH")
1829 (set! name (string-replace name "$TEXMACS_PATH" p))
1830 (set! name (string-replace name "file://" ""))
1831 (list 'includegraphics name))
1832 (receive (name-url name-string) (tmtex-eps-names)
1833 (when (string-starts? name "..")
1834 (set! u (url-relative current-save-source (unix->url name))))
1835 (with nfm (if (== (url-suffix name-url) "pdf") "pdf-file"
1836 "postscript-file")
1837 (convert-to-file u fm nfm name-url))
1838 (list 'includegraphics name-string)))))
1839
1840 (define (tmtex-image-length len)
1841 (let* ((s (force-string len))
1842 (unit (and (tm-length? s) (tm-length-unit len))))
1843 (cond ((== s "") "!")
1844 ((string-ends? s "%") "!")
1845 ((in? unit '("w" "h")) "!")
1846 (else (tmtex-decode-length len)))))
1847
1848 (define (tmtex-image-mag len)
1849 (let* ((s (force-string len))
1850 (val (and (tm-length? s) (tm-length-value len)))
1851 (unit (and (tm-length? s) (tm-length-unit len))))
1852 (cond ((== s "") 0.0)
1853 ((string-ends? s "%")
1854 (with x (string->number (string-drop-right s 1))
1855 (if x (/ x 100.0) 0)))
1856 ((in? unit '("w" "h")) (or val 0))
1857 (else #f))))
1858
1859 (define (tmtex-image l)
1860 (if (nstring? (car l))
1861 (tmtex-eps (cons 'image l))
1862 (let* ((fig (tmtex-as-eps (force-string (car l))))
1863 (hor (tmtex-image-length (cadr l)))
1864 (ver (tmtex-image-length (caddr l)))
1865 (mhor (tmtex-image-mag (cadr l)))
1866 (mver (tmtex-image-mag (caddr l))))
1867 (cond ((or (not mhor) (not mver)) (list 'resizebox hor ver fig))
1868 ((and (== mhor 0.0) (== mver 0.0)) fig)
1869 ((or (== mhor 1.0) (== mver 1.0)) fig)
1870 ((== mhor 0.0) (list 'scalebox (number->string mver) fig))
1871 (else (list 'scalebox (number->string mhor) fig))))))
1872
1873 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1874 ;; Metadata for documents
1875 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1876
1877 (define (tmtex-make-inline t)
1878 (tm-replace t '(new-line) '(next-line)))
1879
1880 (tm-define (tmtex-inline t)
1881 (tmtex (tmtex-make-inline t)))
1882
1883 (tm-define (tmtex-doc-title t)
1884 `(title ,(tmtex-inline (cadr t))))
1885
1886 (tm-define (tmtex-doc-running-title t)
1887 `(tmrunningtitle ,(tmtex-inline (cadr t))))
1888
1889 (tm-define (tmtex-doc-subtitle t)
1890 (set! t (tmtex-remove-line-feeds t))
1891 `(tmsubtitle ,(tmtex-inline (cadr t))))
1892
1893 (tm-define (tmtex-doc-note t)
1894 (set! t (tmtex-remove-line-feeds t))
1895 `(tmnote ,(tmtex (cadr t))))
1896
1897 (tm-define (tmtex-doc-misc t)
1898 (set! t (tmtex-remove-line-feeds t))
1899 `(tmmisc ,(tmtex (cadr t))))
1900
1901 (tm-define (tmtex-doc-date t)
1902 `(date ,(tmtex-inline (cadr t))))
1903
1904 (tm-define (tmtex-doc-running-author t)
1905 `(tmrunningauthor ,(tmtex-inline (cadr t))))
1906
1907 (tm-define (tmtex-author-name t)
1908 `(author ,(tmtex-inline (cadr t))))
1909
1910 (tm-define (tmtex-author-affiliation t)
1911 ;;(set! t (tmtex-remove-line-feeds t))
1912 `(tmaffiliation ,(tmtex (cadr t))))
1913
1914 (tm-define (tmtex-author-email t)
1915 (set! t (tmtex-remove-line-feeds t))
1916 `(tmemail ,(tmtex-inline (cadr t))))
1917
1918 (tm-define (tmtex-author-homepage t)
1919 (set! t (tmtex-remove-line-feeds t))
1920 `(tmhomepage ,(tmtex-inline (cadr t))))
1921
1922 (tm-define (tmtex-author-note t)
1923 (set! t (tmtex-remove-line-feeds t))
1924 `(tmnote ,(tmtex (cadr t))))
1925
1926 (tm-define (tmtex-author-misc t)
1927 (set! t (tmtex-remove-line-feeds t))
1928 `(tmmisc ,(tmtex (cadr t))))
1929
1930 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1931 ;; Useful macros for metadata presentation
1932 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1933
1934 (tm-define (tmtex-select-args-by-func n l)
1935 (filter (lambda (x) (func? x n)) l))
1936
1937 (define (tmtex-get-transform l tag)
1938 (let ((transform (symbol-append 'tmtex- tag))
1939 (l* (tmtex-select-args-by-func tag l)))
1940 (map tmtex l*)))
1941
1942 (tm-define (tmtex-remove-line-feeds t)
1943 (if (npair? t) t
1944 (with (r s) (list (car t) (map tmtex-remove-line-feeds (cdr t)))
1945 (if (== r 'next-line) '(!concat (tmSep) (!linefeed)) `(,r ,@s)))))
1946
1947 (tm-define (tmtex-replace-documents t)
1948 (if (npair? t) t
1949 (with (r s) (list (car t) (map tmtex-replace-documents (cdr t)))
1950 (if (!= r 'document) `(,r ,@s)
1951 `(concat ,@(list-intersperse s '(next-line)))))))
1952
1953 (tm-define (contains-tags? t l)
1954 (cond ((or (nlist? t) (null? t)) #f)
1955 ((in? (car t) l) #t)
1956 (else
1957 (with found? #f
1958 (for-each (lambda (x)
1959 (set! found? (or found? (contains-tags? x l))))
1960 t)
1961 found?))))
1962
1963 (tm-define (contains-stree? t u)
1964 (cond ((== t u) #t)
1965 ((or (null? t) (nlist? t)) #f)
1966 (else
1967 (with found? #f
1968 (for-each (lambda (x)
1969 (set! found? (or found? (contains-stree? x u))))
1970 t)
1971 found?))))
1972
1973 ;; Metadata clustering
1974
1975 (define (stree-replace l what by)
1976 (cond ((or (null? l) (nlist? l)) l)
1977 ((== l what) by)
1978 (else
1979 (map (lambda (x) (stree-replace x what by)) l))))
1980
1981 (define (next-stree-occurence l tag)
1982 (cond ((or (null? l) (nlist? l)) #f)
1983 ((== (car l) tag) l)
1984 (else
1985 (with found? #f
1986 (map-in-order
1987 (lambda (x)
1988 (if (not found?)
1989 (set! found? (next-stree-occurence x tag)))) l)
1990 found?))))
1991
1992 (define (add-refs l n tag tr tl global-counter?)
1993 (with streetag (next-stree-occurence (car l) tag)
1994 (if (not streetag)
1995 (begin
1996 (if global-counter? (set! tmtex-ref-cnt n))
1997 l)
1998 (let* ((n* (number->string n))
1999 (tagref (list tr n*))
2000 (authors (stree-replace (car l) streetag tagref))
2001 (taglist (if (null? (cdr l)) '() (cadr l)))
2002 (taglist `(,@taglist (,tl ,n* ,(cadr streetag))))
2003 (l* (list authors taglist)))
2004 (add-refs l* (1+ n) tag tr tl global-counter?)))))
2005
2006 (tm-define (make-references l tag author? global-counter?)
2007 (let* ((tag-ref (symbol-append tag '- 'ref))
2008 (tag-label (symbol-append tag '- 'label))
2009 (cnt (if global-counter? tmtex-ref-cnt 1))
2010 (tmp (add-refs `(,l) cnt tag tag-ref tag-label
2011 global-counter?))
2012 (data-refs (car tmp))
2013 (data-labels (if (null? (cdr tmp)) '() (cadr tmp))))
2014 (if author?
2015 (set! data-labels `((doc-author (author-data ,@data-labels)))))
2016 `(,@data-refs ,@data-labels)))
2017
2018 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2019 ;; Author metadata presentation
2020 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2021
2022 (tm-define (tmtex-prepare-author-data l) l)
2023
2024 (tm-define (tmtex-make-author names affiliations emails urls miscs notes
2025 affs* emails* urls* miscs* notes*)
2026 (let* ((names (tmtex-concat-Sep (map cadr names)))
2027 (result `(,@names ,@notes ,@miscs ,@affiliations ,@emails ,@urls)))
2028 (if (null? result) '()
2029 `(author (!paragraph ,@result)))))
2030
2031 (tm-define (tmtex-doc-author t)
2032 (if (or (npair? t) (npair? (cdr t)) (not (func? (cadr t) 'author-data))) '()
2033 (let* ((l (tmtex-prepare-author-data (cdadr t)))
2034 (names (tmtex-get-transform l 'author-name))
2035 (emails (tmtex-get-transform l 'author-email))
2036 (urls (tmtex-get-transform l 'author-homepage))
2037 (affs (tmtex-get-transform l 'author-affiliation))
2038 (miscs (tmtex-get-transform l 'author-misc))
2039 (notes (tmtex-get-transform l 'author-note))
2040 (emails* (tmtex-get-transform l 'author-email-ref))
2041 (urls* (tmtex-get-transform l 'author-homepage-ref))
2042 (affs* (tmtex-get-transform l 'author-affiliation-ref))
2043 (miscs* (tmtex-get-transform l 'author-misc-ref))
2044 (notes* (tmtex-get-transform l 'author-note-ref))
2045 (affs (append affs (tmtex-get-transform
2046 l 'author-affiliation-label)))
2047 (urls (append urls (tmtex-get-transform
2048 l 'author-homepage-label)))
2049 (miscs (append miscs (tmtex-get-transform
2050 l 'author-misc-label)))
2051 (notes (append notes (tmtex-get-transform
2052 l 'author-note-label)))
2053 (emails (append emails (tmtex-get-transform
2054 l 'author-email-label))))
2055 (tmtex-make-author names affs emails urls miscs notes
2056 affs* emails* urls* miscs* notes*))))
2057
2058 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2059 ;; Document metadata presentation
2060 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2061
2062 (tm-define (tmtex-prepare-doc-data l)
2063 (set! l (map tmtex-replace-documents l))
2064 l)
2065
2066 (define (tmtex-make-title titles subtitles notes miscs tr)
2067 (let* ((titles (tmtex-concat-Sep (map cadr titles)))
2068 (content `(,@titles ,@subtitles ,@notes ,@miscs)))
2069 (if (null? content) '()
2070 `((title (!indent (!paragraph ,@content)))))))
2071
2072 (tm-define (tmtex-append-authors l)
2073 (set! l (filter nnull? l))
2074 (cond ((null? l) '())
2075 ((== (length l) 1) `((author (!indent (!concat ,@(cdar l))))))
2076 (else
2077 (with lf '(!concat (!linefeed) (and) (!linefeed))
2078 `((author
2079 (!indent (!concat ,@(list-intersperse (map cadr l) lf)))))))))
2080
2081 (tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes
2082 subtits-l dates-l miscs-l notes-l tr ar)
2083 `(!document
2084 ,@(tmtex-make-title titles subtitles notes miscs tr)
2085 ,@(tmtex-append-authors authors)
2086 ,@dates
2087 (maketitle)))
2088
2089 (tm-define (tmtex-get-title-option l)
2090 (apply append (map cdr (tmtex-select-args-by-func 'doc-title-options l))))
2091
2092 (tm-define (tmtex-doc-data s l)
2093 (set! l (tmtex-prepare-doc-data l))
2094 (let* ((titles (tmtex-get-transform l 'doc-title))
2095 (tr (tmtex-get-transform l 'doc-running-title))
2096 (subtits (tmtex-get-transform l 'doc-subtitle))
2097 (authors (tmtex-get-transform l 'doc-author))
2098 (ar (tmtex-get-transform l 'doc-running-author))
2099 (dates (tmtex-get-transform l 'doc-date))
2100 (miscs (tmtex-get-transform l 'doc-misc))
2101 (notes (tmtex-get-transform l 'doc-note))
2102 (subtits-l (tmtex-get-transform l 'doc-subtitle-label))
2103 (dates-l (tmtex-get-transform l 'doc-date-label))
2104 (miscs-l (tmtex-get-transform l 'doc-misc-label))
2105 (notes-l (tmtex-get-transform l 'doc-note-label))
2106 (subtits (append subtits (tmtex-get-transform l 'doc-subtitle-ref)))
2107 (dates (append dates (tmtex-get-transform l 'doc-date-ref)))
2108 (miscs (append miscs (tmtex-get-transform l 'doc-misc-ref)))
2109 (notes (append notes (tmtex-get-transform l 'doc-note-ref))))
2110 (tmtex-make-doc-data titles subtits authors dates miscs notes
2111 subtits-l dates-l miscs-l notes-l tr ar)))
2112
2113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2114 ;; Abstract metadata presentation
2115 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2116
2117 (tm-define (tmtex-abstract t)
2118 (tmtex-std-env "abstract" (cdr t)))
2119
2120 (tm-define (tmtex-abstract-keywords t)
2121 (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
2122 `(!concat (tmkeywords) ,@(map (lambda (x) `(!group ,x)) args))))
2123
2124 (tm-define (tmtex-abstract-acm t)
2125 (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
2126 `(!concat (tmacm) ,@(map (lambda (x) `(!group ,x)) args))))
2127
2128 (tm-define (tmtex-abstract-arxiv t)
2129 (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
2130 `(!concat (tmarxiv) ,@(map (lambda (x) `(!group ,x)) args))))
2131
2132 (tm-define (tmtex-abstract-msc t)
2133 (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
2134 `(!concat (tmmsc) ,@(map (lambda (x) `(!group ,x)) args))))
2135
2136 (tm-define (tmtex-abstract-pacs t)
2137 (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
2138 `(!concat (tmpacs) ,@(map (lambda (x) `(!group ,x)) args))))
2139
2140 (tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract)
2141 (with result `(,@abstract ,@acm ,@arxiv ,@msc ,@pacs ,@keywords)
2142 (if (null? result) "" `(!document ,@result))))
2143
2144 (tm-define (tmtex-abstract-data s l)
2145 (let* ((acm (map tmtex-abstract-acm
2146 (tmtex-select-args-by-func 'abstract-acm l)))
2147 (arxiv (map tmtex-abstract-arxiv
2148 (tmtex-select-args-by-func 'abstract-arxiv l)))
2149 (msc (map tmtex-abstract-msc
2150 (tmtex-select-args-by-func 'abstract-msc l)))
2151 (pacs (map tmtex-abstract-pacs
2152 (tmtex-select-args-by-func 'abstract-pacs l)))
2153 (keywords (map tmtex-abstract-keywords
2154 (tmtex-select-args-by-func 'abstract-keywords l)))
2155 (abstract (map tmtex-abstract
2156 (tmtex-select-args-by-func 'abstract l))))
2157 (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract)))
2158
2159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2160 ;; TeXmacs style primitives
2161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2162
2163 (define (tmtex-std-env s l)
2164 (if (== s "quote-env") (set! s "quote"))
2165 (list (list '!begin s) (tmtex (car l))))
2166
2167 (define (tmtex-footnote s l)
2168 `(footnote ,(tmtex (car l))))
2169
2170 (define (tmtex-footnotemark s l)
2171 `(footnotemark (!option ,(tmtex (car l)))))
2172
2173 (define (filter-enunciation-due-to l)
2174 (cond ((func? l 'dueto) (list l))
2175 ((nlist>0? l) '())
2176 (else (append-map filter-enunciation-due-to l))))
2177
2178 (define (filter-enunciation-body l)
2179 (cond ((func? l 'dueto) '())
2180 ((nlist>0? l) l)
2181 (else (filter nnull? (map filter-enunciation-body l)))))
2182
2183 (define (tmtex-enunciation s l)
2184 (let* ((t (car l))
2185 (option (filter-enunciation-due-to t))
2186 (option* (map (lambda (x) `(!option ,(tmtex (cadr x)))) option))
2187 (body (filter-enunciation-body t)))
2188 `((!begin ,s ,@option*) ,(tmtex body))))
2189
2190 (define (find-label x)
2191 (cond ((npair? x) #f)
2192 ((func? x 'label) x)
2193 (else (or (find-label (car x)) (find-label (cdr x))))))
2194
2195 (define (remove-labels x)
2196 (cond ((npair? x) x)
2197 ((func? x 'label) "")
2198 (else (cons (remove-labels (car x)) (remove-labels (cdr x))))))
2199
2200 (define (tmtex-sectional s l)
2201 (let* ((lab (find-label (car l)))
2202 (tit (if lab (remove-labels (car l)) (car l)))
2203 (sec (list (string->symbol s) (tmtex tit))))
2204 (if lab (list '!concat sec lab) sec)))
2205
2206 (define (tmtex-appendix s l)
2207 (with app (list (if (latex-book-style?) 'chapter 'section) (tmtex (car l)))
2208 (if tmtex-appendices? app
2209 (begin
2210 (set! tmtex-appendices? #t)
2211 (list '!concat '(appendix) app)))))
2212
2213 (define (tmtex-appendix* s l)
2214 (with app (list (if (latex-book-style?) 'chapter* 'section*) (tmtex (car l)))
2215 (if tmtex-appendices? app
2216 (begin
2217 (set! tmtex-appendices? #t)
2218 (list '!concat '(appendix) app)))))
2219
2220 (define (tmtex-tt-document l)
2221 (cond ((null? l) "")
2222 ((null? (cdr l)) (tmtex-tt (car l)))
2223 (else (string-append (tmtex-tt (car l)) "\n"
2224 (tmtex-tt-document (cdr l))))))
2225
2226 (define (tmtex-tt x)
2227 (cond ((string? x) (tmtex-verb-string x))
2228 ((== x '(next-line)) "\n")
2229 ((func? x 'document) (tmtex-tt-document (cdr x)))
2230 ((func? x 'para) (tmtex-tt-document (cdr x)))
2231 ((func? x 'concat)
2232 (apply string-append (map-in-order tmtex-tt (cdr x))))
2233 ((func? x 'mtm 2) (tmtex-tt (cAr x)))
2234 ((func? x 'surround 3)
2235 (string-append (tmtex-tt (cadr x))
2236 (tmtex-tt (cadddr x))
2237 (tmtex-tt (caddr x))))
2238 ((or (func? x 'hgroup 1) (func? x 'vgroup 1))
2239 (tmtex-tt (cadr x)))
2240 ((func? x 'with)
2241 (begin
2242 (display* "TeXmacs] lost <with> in verbatim content: " (cDr x) "\n")
2243 (tmtex-tt (cAr x))))
2244 ((func? x 'math)
2245 (begin
2246 (display* "TeXmacs] lost <math> in verbatim content: " (cDr x) "\n")
2247 (tmtex-tt (cAr x))))
2248 (else
2249 (begin
2250 (display* "TeXmacs] non converted verbatim content: " x "\n")
2251 ""))))
2252
2253 (define (unescape-angles l)
2254 (cond ((string? l)
2255 (string-replace (string-replace l "<less>" "<") "<gtr>" ">"))
2256 ((symbol? l) l)
2257 (else (map unescape-angles l))))
2258
2259 (define (escape-braces l)
2260 (cond ((string? l) (string-replace (string-replace l "{" "\\{") "}" "\\}"))
2261 ((symbol? l) l)
2262 (else (map escape-braces l))))
2263
2264 (define (escape-backslashes l)
2265 (cond ((string? l) (string-replace l "\\" "\\textbackslash "))
2266 ((symbol? l) l)
2267 (else (map escape-backslashes l))))
2268
2269 (define (tmtex-new-theorem s l)
2270 (with var (tmtex-var-name (car l))
2271 (ahash-set! tmtex-dynamic (string->symbol (car l)) 'environment)
2272 (ahash-set! tmtex-dynamic (string->symbol var) 'environment)
2273 (if (and (logic-in? var latex-texmacs-theorem-environment%)) ""
2274 `(newtheorem ,var (,@(cdr l))))))
2275
2276 (define (tmtex-verbatim s l)
2277 (if (func? (car l) 'document)
2278 (list '!verbatim (tmtex-tt (escape-braces (escape-backslashes (car l)))))
2279 (list 'tmverbatim (tmtex (car l)))))
2280
2281 (define (sharp-fix t)
2282 (cond ((and (func? t '!document) (nnull? (cdr t)))
2283 `(!document ,(sharp-fix (cadr t)) ,@(cddr t)))
2284 ((and (func? t '!concat) (nnull? (cdr t)))
2285 `(!concat ,(sharp-fix (cadr t)) ,@(cddr t)))
2286 ((and (string? t) (string-starts? t "#"))
2287 (string-append "\\" t))
2288 (else t)))
2289
2290 (define (tmtex-verbatim* s l)
2291 (if (func? (car l) 'document)
2292 (list '!verbatim* (sharp-fix (tmtex-tt (car l))))
2293 (list 'tmverbatim (tmtex (car l)))))
2294
2295 (define (tmtex-code-inline s l)
2296 (with lang `((!option ,s))
2297 `(tmcodeinline ,@lang ,(tmtex (car l)))))
2298
2299 (define (tmtex-code-block s l)
2300 (set! l (escape-backslashes l))
2301 (set! l (escape-braces l))
2302 (set! s (car (string-decompose s "-")))
2303 (with lang (if (or (== s "verbatim") (== s "code")) '() `((!option ,s)))
2304 `((!begin* "tmcode" ,@lang) ,(tmtex-verbatim* "" l))))
2305
2306 (define (tmtex-add-preview-packages x)
2307 (cond ((list? x) (for-each tmtex-add-preview-packages x))
2308 ((nstring? x) (noop))
2309 ((string-occurs? "tikzpicture" x) (latex-add-extra "tikz"))))
2310
2311 (define (tmtex-mixed s l)
2312 (if (func? (cadr l) 'text) (set! l `("" ,(cadadr l))))
2313 ;; (set! l (unescape-angles l))
2314 ;; NOTE: instead, we now unescape in tmtex-verb-string
2315 (tmtex-env-set "mode" "text")
2316 (with src (list '!verbatim* (tmtex-tt (cadr l)))
2317 (tmtex-add-preview-packages src)
2318 (tmtex-env-reset "mode")
2319 (list '!unindent src)))
2320
2321 (define (tmtex-listing s l)
2322 (list (list '!begin "tmlisting") (tmtex (car l))))
2323 ;;(list (list '!begin "linenumbers") (tmtex (car l))))
2324
2325 (define (tmtex-minipage s l)
2326 (let*
2327 ((pos (car l))
2328 (opt (if (== pos "f") '() `((!option ,pos))))
2329 (size (cadr l))
2330 (body (caddr l)))
2331 `((!begin "minipage" ,@opt ,(tmtex-decode-length size)) ,(tmtex body))))
2332
2333 (define (tmtex-number-renderer l)
2334 (let ((r (cond ((string? l) l)
2335 ((list? l) (tmtex-number-renderer (car l)))
2336 (else ""))))
2337 (cond
2338 ((== r "alpha") "alph")
2339 ((== r "Alpha") "Alph")
2340 (else r))))
2341
2342 (define (tmtex-number-counter l)
2343 (cond ((func? l 'value) (tmtex-number-counter (cdr l)))
2344 ((and (list? l) (== 1 (length l))) (tmtex-number-counter (car l)))
2345 ((symbol? l) (tmtex-number-counter (symbol->string l)))
2346 ((string? l) (if (string-ends? l "-nr") (string-drop-right l 3) l))
2347 (else "")))
2348
2349 (define (tmtex-number l)
2350 (tmtex-default
2351 (tmtex-number-renderer (cdr l))
2352 (list (tmtex-number-counter (car l)))))
2353
2354 (define (tmtex-change-case l)
2355 (cond
2356 ((== (cadr l) "UPCASE") (tex-apply 'MakeUppercase (tmtex (car l))))
2357 ((== (cadr l) "locase") (tex-apply 'MakeLowercase (tmtex (car l))))
2358 (else (tmtex (car l)))))
2359
2360 (define (tmtex-frame s l)
2361 `(fbox ,(car l)))
2362
2363 (define (tmtex-colored-frame s l)
2364 `(colorbox ,(tmtex-decode-color (car l)) ,(tmtex (cadr l))))
2365
2366 (define (tmtex-fcolorbox s l)
2367 `(fcolorbox ,@(map tmtex-decode-color (cDr l)) ,(tmtex (cAr l))))
2368
2369 (define (tmtex-rotate s l)
2370 (let* ((body (tmtex (cadr l)))
2371 (body* (if (tmtex-math-mode?) `(ensuremath ,body) body)))
2372 `(rotatebox (!option "origin=c") ,(tmtex (car l)) ,body*)))
2373
2374 (define (tmtex-translate s l)
2375 (let ((from (cadr l))
2376 (to (caddr l))
2377 (body (car l)))
2378 (tmtex (translate-from-to body from to))))
2379
2380 (define (tmtex-localize s l)
2381 (with lan (if (list>0? tmtex-languages) (cAr tmtex-languages) "english")
2382 (tmtex `(translate ,(car l) "english" ,lan))))
2383
2384 (define (tmtex-render-key s l)
2385 (with body (tmtex (car l))
2386 (if (func? body '!concat)
2387 (set! body `(!append ,@(cdr body))))
2388 `(key ,body)))
2389
2390 (define (tmtex-key s l)
2391 (tmtex (tm->stree (tmdoc-key (car l)))))
2392
2393 (define (tmtex-key* s l)
2394 (tmtex (tm->stree (tmdoc-key* (car l)))))
2395
2396 (define (tmtex-padded-center s l)
2397 (list (list '!begin "center") (tmtex (car l))))
2398
2399 (define (tmtex-padded-left-aligned s l)
2400 (list (list '!begin "flushleft") (tmtex (car l))))
2401
2402 (define (tmtex-padded-right-aligned s l)
2403 (list (list '!begin "flushright") (tmtex (car l))))
2404
2405 (define (tmtex-compact s l)
2406 (list (list '!begin "tmcompact") (tmtex (car l))))
2407
2408 (define (tmtex-compressed s l)
2409 (list (list '!begin "tmcompressed") (tmtex (car l))))
2410
2411 (define (tmtex-amplified s l)
2412 (list (list '!begin "tmamplified") (tmtex (car l))))
2413
2414 (define (tmtex-indent s l)
2415 (list (list '!begin "tmindent") (tmtex (car l))))
2416
2417 (define (tmtex-jump-in s l)
2418 (list (list '!begin "tmjumpin") (tmtex (car l))))
2419
2420 (define (tmtex-script-inout s l)
2421 (let ((name (string->symbol (string-append "tm" (string-replace s "-" ""))))
2422 (lang (car l))
2423 (lang* (session-name (car l)))
2424 (in (tmtex (caddr l)))
2425 (out (tmtex (cadddr l))))
2426 `(,name ,lang ,lang* ,in ,out)))
2427
2428 (define (tmtex-converter s l)
2429 (let ((name (string->symbol (string-append "tm" (string-replace s "-" ""))))
2430 (lang (car l))
2431 (lang* (format-get-name (car l)))
2432 (in (tmtex (cadr l)))
2433 (out (tmtex (caddr l))))
2434 `(,name ,lang ,lang* ,in ,out)))
2435
2436 (define (tmtex-list-env s l)
2437 (let* ((r (string-replace s "-" ""))
2438 (t (cond ((== r "enumerateRoman") "enumerateromancap")
2439 ((== r "enumerateAlpha") "enumeratealphacap")
2440 (else r))))
2441 (list (list '!begin t) (tmtex (car l)))))
2442
2443 (define (tmtex-tiny s l)
2444 (tex-apply 'tiny (tmtex (car l))))
2445
2446 (define (tmtex-scriptsize s l)
2447 (tex-apply 'scriptsize (tmtex (car l))))
2448
2449 (define (tmtex-footnotesize s l)
2450 (tex-apply 'footnotesize (tmtex (car l))))
2451
2452 (define (tmtex-small s l)
2453 (tex-apply 'small (tmtex (car l))))
2454
2455 (define (tmtex-normalsize s l)
2456 (tex-apply 'normalsize (tmtex (car l))))
2457
2458 (define (tmtex-large s l)
2459 (tex-apply 'large (tmtex (car l))))
2460
2461 (define (tmtex-Large s l)
2462 (tex-apply 'Large (tmtex (car l))))
2463
2464 (define (tmtex-LARGE s l)
2465 (tex-apply 'LARGE (tmtex (car l))))
2466
2467 (define (tmtex-Huge s l)
2468 (list 'Huge (tmtex (car l))))
2469
2470 (define (tmtex-specific-language s l)
2471 (tmtex `(with "language" ,s ,(car l))))
2472
2473 (tm-define (tmtex-equation s l)
2474 (tmtex-env-set "mode" "math")
2475 (let ((r (tmtex (car l))))
2476 (tmtex-env-reset "mode")
2477 (if (== s "equation")
2478 (list (list '!begin s) r)
2479 (list '!eqn r))))
2480
2481 (define (tmtex-eqnarray s l)
2482 (tmtex-env-set "mode" "math")
2483 (let ((r (tmtex-table-apply (string->symbol s) '() (car l))))
2484 (tmtex-env-reset "mode")
2485 r))
2486
2487 (define (tmtex-math s l)
2488 (cond ((tm-in? (car l) '(equation equation* eqnarray eqnarray*))
2489 (tmtex (car l)))
2490 ((not (tm-func? (car l) 'document))
2491 (tmtex `(with "mode" "math" ,(car l))))
2492 ((tm-func? (car l) 'document 1)
2493 (tmtex `(math ,(cadr (car l)))))
2494 (else
2495 (with ps (map (lambda (x) `(math ,x)) (cdar l))
2496 (tmtex `(document ,@ps))))))
2497
2498 (define (tmtex-textual x)
2499 (tmtex-env-set "mode" "text")
2500 (with r (tmtex x)
2501 (tmtex-env-reset "mode")
2502 r))
2503
2504 (define (tmtex-text s l)
2505 (list 'text (tmtex-textual (car l))))
2506
2507 (define (tmtex-math-up s l)
2508 (post-process-math-text (list 'mathrm (tmtex-textual (car l)))))
2509
2510 (define (tmtex-math-ss s l)
2511 (post-process-math-text (list 'mathsf (tmtex-textual (car l)))))
2512
2513 (define (tmtex-math-tt s l)
2514 (post-process-math-text (list 'mathtt (tmtex-textual (car l)))))
2515
2516 (define (tmtex-math-bf s l)
2517 (post-process-math-text (list 'mathbf (tmtex-textual (car l)))))
2518
2519 (define (tmtex-math-sl s l)
2520 (post-process-math-text (list 'mathsl (tmtex-textual (car l)))))
2521
2522 (define (tmtex-math-it s l)
2523 (post-process-math-text (list 'mathit (tmtex-textual (car l)))))
2524
2525 (define (tmtex-mathord s l)
2526 (list 'mathord (tmtex (car l))))
2527
2528 (define (tmtex-mathbin s l)
2529 (list 'mathbin (tmtex (car l))))
2530
2531 (define (tmtex-mathrel s l)
2532 (list 'mathrel (tmtex (car l))))
2533
2534 (define (tmtex-mathopen s l)
2535 (list 'mathopen (tmtex (car l))))
2536
2537 (define (tmtex-mathclose s l)
2538 (list 'mathclose (tmtex (car l))))
2539
2540 (define (tmtex-mathpunct s l)
2541 (list 'mathpunct (tmtex (car l))))
2542
2543 (define (tmtex-mathop s l)
2544 (list 'mathop (tmtex (car l))))
2545
2546 (define (tmtex-syntax l)
2547 (tmtex (car l)))
2548
2549 (define (tmtex-theindex s l)
2550 (list 'printindex))
2551
2552 (define (tmtex-toc s l)
2553 (tex-apply 'tableofcontents))
2554
2555 (define (tmtex-bib-sub doc)
2556 (cond ((nlist? doc) doc)
2557 ((match? doc '(concat (bibitem* :%1) (label :string?) :*))
2558 (let* ((l (cadr (caddr doc)))
2559 (s (if (string-starts? l "bib-") (string-drop l 4) l)))
2560 (cons* 'concat (list 'bibitem* (cadadr doc) s) (cdddr doc))))
2561 ((func? doc 'bib-list 2) (tmtex-bib-sub (cAr doc)))
2562 (else (map tmtex-bib-sub doc))))
2563
2564 (define (tmtex-bib-max l)
2565 (cond ((npair? l) "")
2566 ((match? l '(bibitem* :string? :%1)) (cadr l))
2567 (else (let* ((s1 (tmtex-bib-max (car l)))
2568 (s2 (tmtex-bib-max (cdr l))))
2569 (if (< (string-length s1) (string-length s2)) s2 s1)))))
2570
2571 (tm-define (tmtex-biblio s l titled?)
2572 (if tmtex-indirect-bib?
2573 (tex-concat (list (list 'bibliographystyle (force-string (cadr l)))
2574 (list 'bibliography (force-string (caddr l)))))
2575 (let* ((doc (tmtex-bib-sub (cadddr l)))
2576 (max (tmtex-textual (tmtex-bib-max doc)))
2577 (tls tmtex-languages)
2578 (lan (or (and (pair? tls) (car tls)) "english"))
2579 (txt (translate-from-to "References" "english" lan))
2580 (bib (tmtex (list 'thebibliography max doc))))
2581 (if titled?
2582 `(!document (section* ,(tmtex txt)) ,bib)
2583 bib))))
2584
2585 (tm-define (tmtex-bib t)
2586 (tmtex-biblio (car t) (cdr t) #f))
2587
2588 (define (tmtex-thebibliography s l)
2589 (list (list '!begin s (car l)) (tmtex (cadr l))))
2590
2591 (define (tmtex-bibitem*-std s l)
2592 (cond ((= (length l) 1)
2593 `(bibitem ,(car l)))
2594 ((= (length l) 2)
2595 `(bibitem (!option ,(tmtex (car l))) ,(cadr l)))
2596 (else
2597 (begin
2598 (display* "TeXmacs] non converted bibitem content: "
2599 (list s l) "\n")
2600 ""))))
2601
2602 (tm-define (tmtex-bibitem* s l)
2603 (tmtex-bibitem*-std s l))
2604
2605 (define (split-year s pos)
2606 (if (and (> pos 0)
2607 (string>=? (substring s (- pos 1) pos) "0")
2608 (string<=? (substring s (- pos 1) pos) "9"))
2609 (split-year s (- pos 1))
2610 pos))
2611
2612 (define (natbibify s)
2613 (let* ((pos (split-year s (string-length s)))
2614 (auth (substring s 0 pos))
2615 (year (substring s pos (string-length s))))
2616 (when (== (string-length year) 2)
2617 (set! year (string-append (if (string>=? year "30") "19" "20") year)))
2618 (string-append auth "(" year ")")))
2619
2620 (tm-define (tmtex-bibitem* s l)
2621 (:mode natbib-package?)
2622 (if (and (== (length l) 2)
2623 (string? (cadr l))
2624 (not (string-occurs? "(" (cadr l))))
2625 (tmtex-bibitem*-std s (list (natbibify (cadr l)) (cadr l)))
2626 (tmtex-bibitem*-std s l)))
2627
2628 (define (tmtex-figure s l)
2629 (tmtex-float-sub #f "h" (cons (string->symbol s) l)))
2630
2631 (define (tmtex-item s l)
2632 (tex-concat (list (list 'item) " ")))
2633
2634 (define (tmtex-item-arg s l)
2635 (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " ")))
2636
2637 (define (tmtex-render-proof s l)
2638 (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l))))
2639
2640 (define (tmtex-nbsp s l)
2641 '(!nbsp))
2642
2643 (define (tmtex-nbhyph s l)
2644 '(!nbhyph))
2645
2646 (define (tmtex-frac* s l)
2647 (tex-concat (list (tmtex (car l)) "/" (tmtex (cadr l)))))
2648
2649 (define (tmtex-ornament-shape s)
2650 (if (== s "rounded") "1.7ex" "0pt"))
2651
2652 (define (assign-ornament-env l)
2653 (let* ((keys* (car l))
2654 (val (cadr l))
2655 (keys (cDr keys*))
2656 (fun (cAr keys*)))
2657 (apply string-append
2658 (list-intersperse
2659 (map (lambda (key)
2660 (with arg (fun val)
2661 (if (nstring? arg) ""
2662 (string-append key "=" arg)))) keys) ","))))
2663
2664 (define (get-ornament-env)
2665 (let* ((l1 (ahash-set->list tmtex-env))
2666 (l21 (map (cut logic-ref tex-ornament-opts% <>) l1))
2667 (l22 (map (cut tmtex-env-get <>) l1))
2668 (l3 (map (lambda (x y) (if (and x y) (list x y) '())) l21 l22))
2669 (l4 (filter nnull? l3))
2670 (l5 (map assign-ornament-env l4)))
2671 (apply string-append (list-intersperse l5 ","))))
2672
2673 (define (tmtex-ornamented s l)
2674 (let* ((env (string-append "tm" s))
2675 (option (get-ornament-env))
2676 (option* (if (!= option "") `((!option ,option)) '())))
2677 `((!begin ,env ,@option*) ,(tmtex (car l)))))
2678
2679 (logic-table tex-ornament-opts%
2680 ("padding-above" ("skipabove" ,tmtex-decode-length))
2681 ("padding-below" ("skipbelow" ,tmtex-decode-length))
2682 ("overlined-sep" ("innertopmargin" ,tmtex-decode-length))
2683 ("underlined-sep" ("innerbottommargin" ,tmtex-decode-length))
2684 ("framed-hsep" ("innerleftmargin" "innerrightmargin"
2685 ,tmtex-decode-length))
2686 ("framed-vsep" ("innertopmargin" "innerbottommargin"
2687 ,tmtex-decode-length))
2688 ("ornament-vpadding" ("innertopmargin" "innerbottommargin"
2689 ,tmtex-decode-length))
2690 ("ornament-hpadding" ("innerleftmargin" "innerrightmargin"
2691 ,tmtex-decode-length))
2692 ("ornament-color" ("backgroundcolor" ,tmtex-decode-color))
2693 ("ornament-shape" ("roundcorner" ,tmtex-ornament-shape)))
2694
2695 (define (tmtex-tm s l)
2696 (with tag (string->symbol (string-append "tm" (string-replace s "-" "")))
2697 `(,tag ,@(map tmtex l))))
2698
2699 (define (tmtex-input-math s l)
2700 (let ((tag (string->symbol (string-append "tm" (string-replace s "-" ""))))
2701 (a1 (tmtex (car l)))
2702 (a2 (with r (begin
2703 (tmtex-env-set "mode" "math")
2704 (tmtex (cadr l)))
2705 (tmtex-env-reset "mode") r)))
2706 (list tag a1 a2)))
2707
2708 (define (tmtex-fold-io-math s l)
2709 (let ((tag (string->symbol (string-append "tm" (string-replace s "-" ""))))
2710 (a1 (tmtex (car l)))
2711 (a2 (with r (begin
2712 (tmtex-env-set "mode" "math")
2713 (tmtex (cadr l)))
2714 (tmtex-env-reset "mode") r))
2715 (a3 (tmtex (caddr l))))
2716 (list tag a1 a2 a3)))
2717
2718 (define (tmtex-session s l)
2719 (let* ((tag (string->symbol (string-append "tm" (string-replace s "-" ""))))
2720 (arg (tmtex (car l)))
2721 (lan (tmtex (cadr l)))
2722 (lst (tmtex (caddr l))))
2723 (if (func? lst '!document)
2724 (set! lst `(!indent (!paragraph ,@(cdr lst)))))
2725 `(!document (,tag ,arg ,lan ,lst))))
2726
2727 (define (escape-hyperref-url l)
2728 (cond ((string? l)
2729 (let* ((r1 (string-replace l "\\" "\\\\"))
2730 (r2 (string-replace r1 "#" "\\#"))
2731 (r3 (string-replace r2 "_" "\\_")))
2732 r3))
2733 ((symbol? l) l)
2734 (else (map escape-hyperref-url l))))
2735
2736 (define (tmtex-hyperref u)
2737 (tmtex-tt (escape-hyperref-url u)))
2738
2739 (define (tmtex-hlink s l)
2740 (let* ((h (cadr l))
2741 (d (tmtex (car l))))
2742 (if (and (string? h) (string-starts? h "#"))
2743 (list 'hyperref `(!option ,(string-drop h 1)) d)
2744 (list 'href (tmtex-hyperref h) d))))
2745
2746 (define (tmtex-href s l)
2747 (list 'url (tmtex-verb-string (car l))))
2748
2749 (define (tmtex-action s l)
2750 (list 'tmaction (tmtex (car l)) (tmtex (cadr l))))
2751
2752 (define (tmtex-choose s l)
2753 (list 'binom (tmtex (car l)) (tmtex (cadr l))))
2754
2755 (define (tmtex-text-tt s l)
2756 (if (tmtex-math-mode?)
2757 (tmtex-math-tt s l)
2758 (tmtex-modifier s l)))
2759
2760 (define (tmtex-modifier s l)
2761 (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l))))
2762
2763 (define (tmtex-render-line-number s l)
2764 (list 'tmlinenumber (tmtex (car l)) (tmtex-decode-length (tmtex (cadr l)))))
2765
2766 (define (tmtex-menu-one x)
2767 (tmtex (list 'samp x)))
2768
2769 (define (tmtex-menu-list l)
2770 (if (null? l) l
2771 (cons* (list '!math (list 'rightarrow))
2772 (tmtex-menu-one (car l))
2773 (tmtex-menu-list (cdr l)))))
2774
2775 (define (tmtex-menu s l)
2776 (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l)))))
2777
2778 (define ((tmtex-rename into) s l)
2779 (tmtex-apply into (tmtex-list l)))
2780
2781 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2782 ;; Citations
2783 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2784
2785 (define (tmtex-cite-list l)
2786 (cond ((null? l) "")
2787 ((nstring? (car l))
2788 (display* "TeXmacs] non converted citation: " (car l) "\n")
2789 (tmtex-cite-list (cdr l)))
2790 ((null? (cdr l)) (car l))
2791 (else (string-append (car l) "," (tmtex-cite-list (cdr l))))))
2792
2793 (tm-define (tmtex-cite s l)
2794 (tex-apply 'cite (tmtex-cite-list l)))
2795
2796 (tm-define (tmtex-cite s l)
2797 (:mode natbib-package?)
2798 (tex-apply 'citep (tmtex-cite-list l)))
2799
2800 (define (tmtex-nocite s l)
2801 (tex-apply 'nocite (tmtex-cite-list l)))
2802
2803 (define (tmtex-cite-TeXmacs s l)
2804 (tex-apply 'citetexmacs (tmtex-cite-list l)))
2805
2806 (tm-define (tmtex-cite-detail s l)
2807 (with c (tmtex-cite-list (list (car l)))
2808 (tex-apply 'cite `(!option ,(tmtex (cadr l))) c)))
2809
2810 (tm-define (tmtex-cite-detail s l)
2811 (:mode natbib-package?)
2812 (with c (tmtex-cite-list (list (car l)))
2813 (tex-apply 'citetext `(!concat (citealp ,c) ", " ,(tmtex (cadr l))))))
2814
2815 (tm-define (tmtex-cite-detail-poor s l)
2816 (with c (tmtex-cite-list (list (car l)))
2817 `(!concat ,(tex-apply 'cite c) " (" ,(tmtex (cadr l)) ")")))
2818
2819 (define (tmtex-cite-detail-hook s l)
2820 (tmtex-cite-detail s l))
2821
2822 (define (tmtex-cite-raw s l)
2823 (tex-apply 'citealp (tmtex-cite-list l)))
2824
2825 (define (tmtex-cite-raw* s l)
2826 (tex-apply 'citealp* (tmtex-cite-list l)))
2827
2828 (define (tmtex-cite-textual s l)
2829 (tex-apply 'citet (tmtex-cite-list l)))
2830
2831 (define (tmtex-cite-textual* s l)
2832 (tex-apply 'citet* (tmtex-cite-list l)))
2833
2834 (define (tmtex-cite-parenthesized s l)
2835 (tex-apply 'citep (tmtex-cite-list l)))
2836
2837 (define (tmtex-cite-parenthesized* s l)
2838 (tex-apply 'citep* (tmtex-cite-list l)))
2839
2840 (define (tmtex-render-cite s l)
2841 (tex-apply 'citetext (tmtex (car l))))
2842
2843 (define (tmtex-cite-author s l)
2844 (tex-apply 'citeauthor (tmtex (car l))))
2845
2846 (define (tmtex-cite-author* s l)
2847 (tex-apply 'citeauthor* (tmtex (car l))))
2848
2849 (define (tmtex-cite-year s l)
2850 (tex-apply 'citeyear (tmtex (car l))))
2851
2852 (define (tmtex-natbib-triple s l)
2853 `(protect (citeauthoryear ,@(map tmtex l))))
2854
2855 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2856 ;; Glossaries
2857 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2858
2859 (define (tmtex-glossary s l)
2860 (with nr (+ tmtex-auto-produce 1)
2861 (set! tmtex-auto-produce nr)
2862 `(label ,(string-append "autolab" (number->string nr)))))
2863
2864 (define (tmtex-glossary-entry s l)
2865 (with nr (+ tmtex-auto-consume 1)
2866 (with lab (string-append "autolab" (number->string nr))
2867 (set! tmtex-auto-consume nr)
2868 `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab)))))
2869
2870 (define (tmtex-glossary-line t)
2871 (with r (tmtex t)
2872 (if (func? r 'glossaryentry) r
2873 `(listpart ,r))))
2874
2875 (define (tmtex-glossary-body b)
2876 (if (not (tm-func? b 'document))
2877 (tmtex b)
2878 (cons '!document (map-in-order tmtex-glossary-line (cdr b)))))
2879
2880 (define (tmtex-the-glossary s l)
2881 `(!document
2882 (,(if (latex-book-style?) 'chapter* 'section*) "Glossary")
2883 ((!begin "theglossary" ,(car l)) ,(tmtex-glossary-body (cadr l)))))
2884
2885 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2886 ;; The main conversion routines
2887 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2888
2889 (define (tmtex-apply key args)
2890 (let ((n (length args))
2891 (r (or (ahash-ref tmtex-dynamic key) (logic-ref tmtex-methods% key))))
2892 (if (in? key '(quote quasiquote unquote)) (set! r tmtex-noop))
2893 (cond ((== r 'environment)
2894 (tmtex-std-env (symbol->string key) args))
2895 (r (r args))
2896 (else
2897 (let ((p (logic-ref tmtex-tmstyle% key)))
2898 (cond ((and p (or (= (cadr p) -1) (= (cadr p) n)))
2899 ((car p) (symbol->string key) args))
2900 ((and p (= (cadr p) -2)) ((car p) `(,key ,@args)))
2901 ((and (= n 1)
2902 (or (func? (car args) 'tformat)
2903 (func? (car args) 'table)))
2904 (tmtex-table-apply key '() (car args)))
2905 ((and (= n 2)
2906 (or (func? (cAr args) 'tformat)
2907 (func? (cAr args) 'table)))
2908 (tmtex-table-apply key (cDr args) (cAr args)))
2909 (else (tmtex-function key args))))))))
2910
2911 (define (tmtex-function f l)
2912 (if (== (string-ref (symbol->string f) 0) #\!)
2913 (cons f (map-in-order tmtex l))
2914 (let ((v (tmtex-var-name (symbol->string f))))
2915 (if (== v "") ""
2916 (apply tex-apply
2917 (cons (string->symbol v)
2918 (map-in-order tmtex l)))))))
2919
2920 (define (tmtex-compound l)
2921 (if (string? (car l))
2922 (tmtex-apply (string->symbol (car l)) (cdr l))
2923 ""))
2924
2925 (define (tmtex-list l)
2926 (map-in-order tmtex l))
2927
2928 (tm-define (tmtex x)
2929 (cond ((string? x) (tmtex-string x))
2930 ((list>0? x) (tmtex-apply (car x) (cdr x)))
2931 (else "")))
2932
2933 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2934 ;; Dispatching
2935 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2936
2937 (logic-dispatcher tmtex-primitives%
2938 ((:or unknown uninit error raw-data) tmtex-error)
2939 (document tmtex-document)
2940 (para tmtex-para)
2941 (surround tmtex-surround)
2942 (concat tmtex-concat)
2943 (rigid tmtex-rigid)
2944 (hgroup tmtex-rigid)
2945 (vgroup tmtex-id)
2946 (hidden tmtex-noop)
2947 (hspace tmtex-hspace)
2948 (vspace* tmtex-noop)
2949 (vspace tmtex-vspace)
2950 (space tmtex-space)
2951 (htab tmtex-htab)
2952 (move tmtex-first)
2953 (shift tmtex-first)
2954 (resize tmtex-first)
2955 (clipped tmtex-first)
2956 (repeat tmtex-noop)
2957 (float tmtex-float)
2958 (datoms tmtex-second)
2959 ((:or dlines dpages dbox) tmtex-noop)
2960 (line-note tmtex-line-note)
2961
2962 (with-limits tmtex-noop)
2963 (line-break tmtex-line-break)
2964 (new-line tmtex-new-line)
2965 (next-line tmtex-next-line)
2966 (emdash tmtex-emdash)
2967 (no-break tmtex-no-break)
2968 (no-indent tmtex-no-first-indentation)
2969 (yes-indent tmtex-noop)
2970 (no-indent* tmtex-noop)
2971 (yes-indent* tmtex-noop)
2972 (page-break* tmtex-noop)
2973 (page-break tmtex-page-break)
2974 (no-page-break* tmtex-noop)
2975 (no-page-break tmtex-no-page-break)
2976 (no-break-here* tmtex-noop)
2977 (no-break-here tmtex-no-page-break)
2978 (no-break-start tmtex-no-page-break)
2979 (no-break-end tmtex-noop)
2980 (new-page* tmtex-noop)
2981 (new-page tmtex-new-page)
2982 (new-dpage* tmtex-noop)
2983 (new-dpage tmtex-noop)
2984
2985 (around tmtex-around)
2986 (around* tmtex-around*)
2987 (big-around tmtex-big-around)
2988 (left tmtex-left)
2989 (mid tmtex-mid)
2990 (right tmtex-right)
2991 (big tmtex-big)
2992 (long-arrow tmtex-long-arrow)
2993 (lprime tmtex-lsup)
2994 (rprime tmtex-rsup)
2995 (below tmtex-below)
2996 (above tmtex-above)
2997 (lsub tmtex-lsub)
2998 (lsup tmtex-lsup)
2999 (rsub tmtex-rsub)
3000 (rsup tmtex-rsup)
3001 (modulo tmtex-modulo)
3002 (frac tmtex-frac)
3003 (sqrt tmtex-sqrt)
3004 (wide tmtex-wide)
3005 (neg tmtex-neg)
3006 (wide* tmtex-wide-star)
3007 ;;(tree tmtex-tree)
3008 (tree tmtex-tree-eps)
3009
3010 (tformat tmtex-tformat)
3011 ((:or twith cwith tmarker) tmtex-noop)
3012 (table tmtex-table)
3013 ((:or row cell subtable) tmtex-noop)
3014
3015 (assign tmtex-assign)
3016 (with tmtex-with-wrapped)
3017 (provides tmtex-noop)
3018 (value tmtex-compound)
3019 (quote-value tmtex-noop)
3020 ((:or quote-value drd-props arg quote-arg) tmtex-noop)
3021 (compound tmtex-compound)
3022 ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop)
3023 ;; quote missing
3024 (quasi tmtex-noop)
3025 ;; quasiquote missing
3026 ;; unquote missing
3027 ((:or unquote* copy
3028 if if* case while for-each
3029 extern include use-package) tmtex-noop)
3030 (syntax tmtex-syntax)
3031
3032 ((:or or xor and not plus minus times over div mod
3033 merge length range find-file
3034 is-tuple look-up
3035 equal unequal less lesseq greater greatereq) tmtex-noop)
3036
3037 (number tmtex-number)
3038 (change-case tmtex-change-case)
3039 (date tmtex-date)
3040
3041 ((:or cm-length mm-length in-length pt-length
3042 bp-length dd-length pc-length cc-length
3043 fs-length fbs-length em-length
3044 ln-length sep-length yfrac-length ex-length
3045 fn-length fns-length bls-length
3046 spc-length xspc-length par-length pag-length
3047 gm-length gh-length) tmtex-noop)
3048
3049 ((:or style-with style-with* style-only style-only*
3050 active active* inactive inactive*
3051 rewrite-inactive inline-tag open-tag middle-tag close-tag
3052 symbol latex hybrid) tmtex-noop)
3053
3054 ((:or tuple attr tmlen collection associate backup) tmtex-noop)
3055 (set-binding tmtex-noop)
3056 (get-binding tmtex-noop)
3057 (hidden-binding tmtex-hidden-binding)
3058 (label tmtex-label)
3059 (reference tmtex-reference)
3060 (pageref tmtex-pageref)
3061 (write tmtex-noop)
3062 (specific tmtex-specific)
3063 ((:or tag meaning flag) tmtex-noop)
3064
3065 ((:or anim-compose anim-repeat anim-constant
3066 anim-translate anim-progressive video sound) tmtex-noop)
3067
3068 (graphics tmtex-graphics)
3069 (superpose tmtex-noop)
3070 ((:or gr-group gr-transform
3071 text-at cline arc carc spline spine* cspline fill) tmtex-noop)
3072 (image tmtex-image)
3073 ((:or box-info frame-direct frame-inverse) tmtex-noop)
3074
3075 ((:or format line-sep split delay hold release
3076 old-matrix old-table old-mosaic old-mosaic-item
3077 set reset expand expand* hide-expand display-baloon
3078 apply begin end func env) tmtex-noop)
3079
3080 (shown tmtex-id)
3081 (mtm tmtex-mtm)
3082 (!file tmtex-file)
3083 (!arg tmtex-tex-arg))
3084
3085 (logic-dispatcher tmtex-extra-methods%
3086 (wide-float tmtex-wide-float)
3087 (phantom-float tmtex-noop)
3088 ((:or marginal-note marginal-normal-note) tmtex-marginal-note)
3089 ((:or marginal-left-note marginal-even-left-note) tmtex-marginal-left-note)
3090 ((:or marginal-right-note marginal-even-right-note)tmtex-marginal-right-note)
3091 (!ilx tmtex-ilx))
3092
3093 (logic-rules
3094 ((tmtex-methods% 'x 'y) (tmtex-primitives% 'x 'y))
3095 ((tmtex-methods% 'x 'y) (tmtex-extra-methods% 'x 'y)))
3096
3097 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3098 ;; Expansion of all macros which are not recognized by LaTeX
3099 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3100
3101 (logic-table tmtex-tmstyle%
3102 ((:or section subsection subsubsection paragraph subparagraph part chapter)
3103 (,tmtex-sectional 1))
3104 ((:or hide-preamble show-preamble) (,tmtex-default -1))
3105 (hide-part (,tmtex-hide-part -1))
3106 (show-part (,tmtex-show-part -1))
3107 ((:or doc-title-options author-data) (,tmtex-default -1))
3108 (appendix (,tmtex-appendix 1))
3109 (appendix* (,tmtex-appendix* 1))
3110 ((:or theorem proposition lemma corollary proof axiom definition
3111 notation conjecture remark note example convention warning
3112 acknowledgments
3113 exercise problem question solution answer
3114 quote-env quotation verse
3115 theorem* proposition* lemma* corollary* axiom* definition*
3116 notation* conjecture* remark* note* example* convention* warning*
3117 acknowledgments*
3118 exercise* problem* question* solution* answer*)
3119 (,tmtex-enunciation 1))
3120 (new-theorem (,tmtex-new-theorem 2))
3121 (new-remark (,tmtex-new-theorem 2))
3122 (new-exercise (,tmtex-new-theorem 2))
3123 (verbatim (,tmtex-verbatim 1))
3124 (padded-center (,tmtex-padded-center 1))
3125 (padded-left-aligned (,tmtex-padded-left-aligned 1))
3126 (padded-right-aligned (,tmtex-padded-right-aligned 1))
3127 (compact (,tmtex-compact 1))
3128 (compressed (,tmtex-compressed 1))
3129 (amplified (,tmtex-amplified 1))
3130 (indent (,tmtex-indent 1))
3131 (jump-in (,tmtex-jump-in 1))
3132 (algorithm-indent (,tmtex-indent 1))
3133 ((:or footnote wide-footnote) (,tmtex-footnote 1))
3134 (footnotemark (,tmtex-default 0))
3135 (footnotemark* (,tmtex-footnotemark 1))
3136 ((:or description description-compact description-aligned
3137 description-dash description-long description-paragraphs
3138 itemize itemize-minus itemize-dot itemize-arrow
3139 enumerate enumerate-numeric enumerate-roman enumerate-Roman
3140 enumerate-alpha enumerate-Alpha)
3141 (,tmtex-list-env 1))
3142 ((:or folded unfolded folded-plain unfolded-plain folded-std unfolded-std
3143 folded-explain unfolded-explain folded-env unfolded-env
3144 folded-documentation unfolded-documentation folded-grouped
3145 unfolded-grouped summarized detailed summarized-plain summarized-std
3146 summarized-env summarized-documentation summarized-grouped
3147 summarized-raw summarized-tiny detailed-plain detailed-std detailed-env
3148 detailed-documentation detailed-grouped detailed-raw detailed-tiny
3149 unfolded-subsession folded-subsession folded-io unfolded-io
3150 input output errput timing)
3151 (,tmtex-tm -1))
3152 ((:or padded underlined overlined bothlined framed ornamented)
3153 (,tmtex-ornamented 1))
3154 ((:or folded-io-math unfolded-io-math) (,tmtex-fold-io-math 3))
3155 (input-math (,tmtex-input-math 2))
3156 (session (,tmtex-session 3))
3157 ((:or converter-input converter-output) (,tmtex-converter 3))
3158 ((:or script-input script-output) (,tmtex-script-inout 4))
3159 (really-tiny (,tmtex-tiny 1))
3160 (very-tiny (,tmtex-tiny 1))
3161 (tiny (,tmtex-tiny 1))
3162 (really-small (,tmtex-scriptsize 1))
3163 (very-small (,tmtex-scriptsize 1))
3164 (smaller (,tmtex-footnotesize 1))
3165 (small (,tmtex-small 1))
3166 (flat-size (,tmtex-small 1))
3167 (normal-size (,tmtex-normalsize 1))
3168 (sharp-size (,tmtex-large 1))
3169 (large (,tmtex-large 1))
3170 (larger (,tmtex-Large 1))
3171 (very-large (,tmtex-LARGE 1))
3172 (really-large (,tmtex-LARGE 1))
3173 (really-huge (,tmtex-Huge 1))
3174 ((:or british bulgarian chinese croatian czech danish dutch english
3175 esperanto finnish french german greek hungarian italian japanese
3176 korean polish portuguese romanian russian slovak slovene spanish
3177 swedish taiwanese ukrainian)
3178 (,tmtex-specific-language 1))
3179
3180 (math (,tmtex-math 1))
3181 (text (,tmtex-text 1))
3182 (math-up (,tmtex-math-up 1))
3183 (math-ss (,tmtex-math-ss 1))
3184 (math-tt (,tmtex-math-tt 1))
3185 (math-bf (,tmtex-math-bf 1))
3186 (math-sl (,tmtex-math-sl 1))
3187 (math-it (,tmtex-math-it 1))
3188 (math-separator (,tmtex-mathpunct 1))
3189 (math-quantifier (,tmtex-mathord 1))
3190 (math-imply (,tmtex-mathbin 1))
3191 (math-or (,tmtex-mathbin 1))
3192 (math-and (,tmtex-mathbin 1))
3193 (math-not (,tmtex-mathord 1))
3194 (math-relation (,tmtex-mathrel 1))
3195 (math-union (,tmtex-mathbin 1))
3196 (math-intersection (,tmtex-mathbin 1))
3197 (math-exclude (,tmtex-mathbin 1))
3198 (math-plus (,tmtex-mathbin 1))
3199 (math-minus (,tmtex-mathbin 1))
3200 (math-times (,tmtex-mathbin 1))
3201 (math-over (,tmtex-mathbin 1))
3202 (math-big (,tmtex-mathop 1))
3203 (math-prefix (,tmtex-mathord 1))
3204 (math-postfix (,tmtex-mathord 1))
3205 (math-open (,tmtex-mathopen 1))
3206 (math-close (,tmtex-mathclose 1))
3207 (math-ordinary (,tmtex-mathord 1))
3208 (math-ignore (,tmtex-mathord 1))
3209 ((:or eqnarray eqnarray* leqnarray*
3210 gather multline gather* multline* align
3211 flalign alignat align* flalign* alignat*) (,tmtex-eqnarray 1))
3212
3213 (eq-number (,tmtex-default -1))
3214 (separating-space (,tmtex-hspace* 1))
3215 (application-space (,tmtex-hspace* 1))
3216
3217 ((:or code cpp-code mmx-code scm-code shell-code scilab-code verbatim-code)
3218 (,tmtex-code-block 1))
3219 ((:or mmx cpp scm shell scilab) (,tmtex-code-inline 1))
3220
3221 (frame (,tmtex-frame 1))
3222 (colored-frame (,tmtex-colored-frame 2))
3223 (fcolorbox (,tmtex-fcolorbox 3))
3224 (rotate (,tmtex-rotate 2))
3225 (condensed (,tmtex-style-first 1))
3226 (translate (,tmtex-translate 3))
3227 (localize (,tmtex-localize 1))
3228 (render-key (,tmtex-render-key 1))
3229 (key (,tmtex-key 1))
3230 (key* (,tmtex-key* 1))
3231 (minipage (,tmtex-minipage 3))
3232 (latex_preview (,tmtex-mixed 2))
3233 (picture-mixed (,tmtex-mixed 2))
3234 (source-mixed (,tmtex-mixed 2))
3235 (listing (,tmtex-listing 1))
3236 (draw-over (,tmtex-make-eps 3))
3237 (draw-under (,tmtex-make-eps 3))
3238 (version-old (,tmtex-style-first 2))
3239 (version-both (,tmtex-style-second 2))
3240 (version-new (,tmtex-style-second 2))
3241 (the-index (,tmtex-theindex -1))
3242 (glossary (,tmtex-glossary 1))
3243 (glossary-explain (,tmtex-glossary 2))
3244 (glossary-2 (,tmtex-glossary-entry 3))
3245 (the-glossary (,tmtex-the-glossary 2))
3246 ((:or table-of-contents) (,tmtex-toc 2))
3247 (thebibliography (,tmtex-thebibliography 2))
3248 (bib-list (,tmtex-style-second 2))
3249 (bibitem* (,tmtex-bibitem* -1))
3250 ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2))
3251 (item (,tmtex-item 0))
3252 (item* (,tmtex-item-arg 1))
3253 (render-proof (,tmtex-render-proof 2))
3254 (nbsp (,tmtex-nbsp 0))
3255 (nbhyph (,tmtex-nbhyph 0))
3256 (hrule (,tmtex-hrule 0))
3257 (frac* (,tmtex-frac* 2))
3258 (hlink (,tmtex-hlink 2))
3259 (action (,tmtex-action -1))
3260 (href (,tmtex-href 1))
3261 (slink (,tmtex-href 1))
3262 (eqref (,tmtex-eqref 1))
3263 (smart-ref (,tmtex-smart-ref -1))
3264 (choose (,tmtex-choose 2))
3265 (tt (,tmtex-text-tt 1))
3266 ((:or strong em name samp abbr dfn kbd var acronym person)
3267 (,tmtex-modifier 1))
3268 (render-line-number (,tmtex-render-line-number 2))
3269 (menu (,tmtex-menu -1))
3270 (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0))
3271 (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0))
3272 (cite-website (,(tmtex-rename 'citewebsite) 0))
3273 (tm-made (,(tmtex-rename 'tmmade) 0))
3274 (cite (,tmtex-cite -1))
3275 (nocite (,tmtex-nocite -1))
3276 (cite-TeXmacs (,tmtex-cite-TeXmacs -1))
3277 (cite-detail (,tmtex-cite-detail-hook 2))
3278 (cite-raw (,tmtex-cite-raw -1))
3279 (cite-raw* (,tmtex-cite-raw* -1))
3280 (cite-textual (,tmtex-cite-textual -1))
3281 (cite-textual* (,tmtex-cite-textual* -1))
3282 (cite-parenthesized (,tmtex-cite-parenthesized -1))
3283 (cite-parenthesized* (,tmtex-cite-parenthesized* -1))
3284 (citet (,tmtex-cite-textual -1))
3285 (citet* (,tmtex-cite-textual* -1))
3286 (citep (,tmtex-cite-parenthesized -1))
3287 (citep* (,tmtex-cite-parenthesized* -1))
3288 (render-cite (,tmtex-render-cite 1))
3289 ((:or cite-author cite-author-link) (,tmtex-cite-author 1))
3290 ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1))
3291 ((:or cite-year cite-year-link) (,tmtex-cite-year 1))
3292 (natbib-triple (,tmtex-natbib-triple 3))
3293 (natexlab (,tmtex-noop -1))
3294
3295 ;; FIXME: we should do something more useful with this information
3296 (set-header (,tmtex-noop -1))
3297 (set-footer (,tmtex-noop -1))
3298 (set-this-page-header (,tmtex-noop -1))
3299 (set-this-page-footer (,tmtex-noop -1)))
3300
3301 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3302 ;; Tags which are customized in particular style files
3303 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3304
3305 (tm-define (style-dependent-declare x)
3306 (with (tag fun narg) x
3307 (with fun+bis (symbol-append fun '+bis)
3308 (if (== narg 2)
3309 `(begin
3310 (when (not (defined? ',fun))
3311 (tm-define (,fun s l) (tmtex-function (string->symbol s) l)))
3312 (when (not (defined? ',fun+bis))
3313 (tm-define (,fun+bis s l) (,fun s l))))
3314 `(begin
3315 (when (not (defined? ',fun))
3316 (tm-define (,fun t)
3317 (tmtex-function (string->symbol (car t)) (cdr t))))
3318 (when (not (defined? ',fun+bis))
3319 (tm-define (,fun+bis s l)
3320 (,fun (append (list (string->symbol s)) l)))))))))
3321
3322 (tm-define (style-dependent-transform x)
3323 (with (tag fun narg) x
3324 (with fun+bis (symbol-append fun '+bis)
3325 `(,tag (,(list 'unquote fun+bis) -1)))))
3326
3327 (define-macro (tmtex-style-dependent . l)
3328 `(begin
3329 ,@(map style-dependent-declare l)
3330 (logic-table tmtex-tmstyle% ,@(map style-dependent-transform l))))
3331
3332 (tmtex-style-dependent
3333 ;; to be removed
3334 (doc-data tmtex-doc-data 2)
3335 (abstract-data tmtex-abstract-data 2)
3336 ;; abstract markup
3337 (abstract tmtex-abstract 1)
3338 (abstract-acm tmtex-abstract-acm 1)
3339 (abstract-arxiv tmtex-abstract-arxiv 1)
3340 (abstract-msc tmtex-abstract-msc 1)
3341 (abstract-pacs tmtex-abstract-pacs 1)
3342 (abstract-keywords tmtex-abstract-keywords 1)
3343 ;; metadata markup
3344 (doc-title tmtex-doc-title 1)
3345 (doc-running-title tmtex-doc-running-title 1)
3346 (doc-subtitle tmtex-doc-subtitle 1)
3347 (doc-note tmtex-doc-note 1)
3348 (doc-misc tmtex-doc-misc 1)
3349 (doc-date tmtex-doc-date 1)
3350 (doc-running-author tmtex-doc-running-author 1)
3351 (doc-author tmtex-doc-author 1)
3352 (author-name tmtex-author-name 1)
3353 (author-affiliation tmtex-author-affiliation 1)
3354 (author-misc tmtex-author-misc 1)
3355 (author-note tmtex-author-note 1)
3356 (author-email tmtex-author-email 1)
3357 (author-homepage tmtex-author-homepage 1)
3358 ;; references
3359 (doc-subtitle-ref tmtex-doc-subtitle-ref 2)
3360 (doc-date-ref tmtex-doc-date-ref 2)
3361 (doc-note-ref tmtex-doc-note-ref 2)
3362 (doc-misc-ref tmtex-doc-misc-ref 2)
3363 (author-affiliation-ref tmtex-author-affiliation-ref 2)
3364 (author-email-ref tmtex-author-email-ref 2)
3365 (author-homepage-ref tmtex-author-homepage-ref 2)
3366 (author-note-ref tmtex-author-note-ref 2)
3367 (author-misc-ref tmtex-author-misc-ref 2)
3368 ;; labels
3369 (doc-subtitle-label tmtex-doc-subtitle-label 2)
3370 (doc-date-label tmtex-doc-date-label 2)
3371 (doc-note-label tmtex-doc-note-label 2)
3372 (doc-misc-label tmtex-doc-misc-label 2)
3373 (author-affiliation-label tmtex-author-affiliation-label 2)
3374 (author-email-label tmtex-author-email-label 2)
3375 (author-homepage-label tmtex-author-homepage-label 2)
3376 (author-note-label tmtex-author-note-label 2)
3377 (author-misc-label tmtex-author-misc-label 2)
3378 ;; misc
3379 ((:or equation equation*) tmtex-equation 2)
3380 (bibliography tmtex-bib 4)
3381 (elsevier-frontmatter tmtex-elsevier-frontmatter 2)
3382 (conferenceinfo tmtex-acm-conferenceinfo 2)
3383 (CopyrightYear tmtex-acm-copyright-year 2)
3384 (slide tmtex-beamer-slide 2)
3385 (tit tmtex-beamer-tit 2)
3386 (crdata tmtex-acm-crdata 2))
3387
3388 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3389 ;; Protected tags
3390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3391
3392 (logic-group tmtex-protected%
3393 a b c d i j k l o r t u v H L O P S
3394 aa ae bf cr dh dj dp em fi ge gg ht if in it le lg ll lu lq mp mu
3395 ne ng ni nu oe or pi pm rm rq sb sc sf sl sp ss th to tt wd wp wr xi
3396 AA AE DH DJ Im NG OE Pi Pr Re SS TH Xi)
3397
3398 (logic-group tmtex-protected-symbol%
3399 space)
3400
3401 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3402 ;; Expansion of all macros which are not recognized by LaTeX
3403 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3404
3405 (define tmtex-user-defs-table (make-ahash-table))
3406
3407 (define (user-definition? x)
3408 (or (and (func? x 'new-theorem 2) (string? (cadr x)))
3409 (and (func? x 'assign 2) (string? (cadr x)))))
3410
3411 (define (collect-user-defs-sub t)
3412 (cond ((npair? t) (noop))
3413 ((user-definition? t)
3414 (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t))
3415 (else (for-each collect-user-defs-sub (cdr t)))))
3416
3417 (define (collect-user-defs t)
3418 (set! tmtex-user-defs-table (make-ahash-table))
3419 (collect-user-defs-sub (cons 'document (tmtex-filter-preamble t)))
3420 (ahash-set->list tmtex-user-defs-table))
3421
3422 (define (as-string sym)
3423 (with s (symbol->string sym)
3424 (if (string-starts? s "begin-")
3425 (substring s 6 (string-length s))
3426 s)))
3427
3428 (define (logic-first-list name)
3429 (let* ((l1 (query (cons name '('first 'second))))
3430 (l2 (map (cut assoc-ref <> 'first) l1)))
3431 (map as-string l2)))
3432
3433 (define (collect-user-macros-in t h)
3434 (when (tm-compound? t)
3435 (when (tree-label-extension? (tm-label t))
3436 (ahash-set! h (symbol->string (tm-label t)) #t))
3437 (for-each (cut collect-user-macros-in <> h) (tm-children t))))
3438
3439 (define (collect-user-macros t)
3440 (with h (make-ahash-table)
3441 (collect-user-macros-in t h)
3442 (ahash-set->list h)))
3443
3444 (define (tmtex-env-macro name)
3445 `(associate ,name (xmacro "x" (eval-args "x"))))
3446
3447 (define tmtex-always-expand
3448 ;; FIXME: find a cleaner way to handle these environments
3449 (list "render-theorem" "render-remark" "render-exercise" "render-proof"
3450 "algorithm" "algorithm*" "named-algorithm" "named-algorithm-old"
3451 "specified-algorithm" "specified-algorithm*"
3452 "named-specified-algorithm" "algorithm-body" "numbered"
3453
3454 "short-item" "short-question"
3455 "question-arabic" "question-alpha" "question-Alpha"
3456 "question-roman" "question-Roman" "question-item"
3457 "answer-arabic" "answer-alpha" "answer-Alpha"
3458 "answer-roman" "answer-Roman" "answer-item"
3459
3460 "gap" "gap-dots" "gap-underlined" "gap-box"
3461 "gap-wide" "gap-dots-wide" "gap-underlined-wide" "gap-box-wide"
3462 "gap-long" "gap-dots-long" "gap-underlined-long" "gap-box-long"
3463
3464 "with-button-box" "with-button-box*"
3465 "with-button-circle" "with-button-circle*"
3466 "with-button-arabic" "with-button-alpha" "with-button-Alpha"
3467 "with-button-roman" "with-button-Roman"
3468 "mc-field" "mc-wide-field" "show-reply" "hide-reply"
3469 "mc" "mc-monospaced" "mc-horizontal" "mc-vertical"
3470
3471 "textual-table" "numeric-dot-table"
3472 "calc-table" "calc-inert" "calc-input" "calc-output" "calc-ref"
3473 "cell-inert" "cell-input" "cell-output" "cell-ref"
3474 "cell-range" "cell-sum" "cell-plusses" "cell-commas"
3475
3476 "tmdoc-title" "icon" "shortcut" "key" "prefix"
3477 "menu" "render-menu" "submenu" "subsubmenu" "subsubsubmenu"
3478 "markup" "tmstyle" "tmpackage" "tmdtd" "def-index"
3479 "src-arg" "src-var" "scm-arg" "scm-args"
3480 "descriptive-table" "tm-fragment" "framed-fragment"
3481 "explain" "explain-synopsis" "explain-macro"
3482 "small-envbox" "big-envbox" "small-focus" "big-focus"
3483 "cursor" "math-cursor" "TeXmacs-version" "c++" "BibTeX"))
3484
3485 (tm-define (tmtex-env-patch t l0)
3486 (let* ((st (tree->stree t))
3487 (l0 (logic-first-list 'tmtex-primitives%))
3488 (l1 (logic-first-list 'tmtex-extra-methods%))
3489 (l2 (logic-first-list 'tmtex-tmstyle%))
3490 (l3 (map as-string (logic-apply-list '(latex-tag%))))
3491 (l4 (map as-string (logic-apply-list '(latex-symbol%))))
3492 (l5 (list-difference l3 (list-union l4 tmtex-always-expand)))
3493 (l6 (map as-string (collect-user-defs st)))
3494 (l7 (if (preference-on? "texmacs->latex:expand-user-macros") '() l6))
3495 (l8 (list-difference (collect-user-macros st)
3496 (list-union l0 l6 tmtex-always-expand)))
3497 (l9 (list-difference (list-union l1 l2 l5 l7 l8) l0))
3498 (l10 (list-filter l0 (lambda (s) (and (string? s)
3499 (<= (string-length s) 2)))))
3500 (l11 (list-difference l10 (list "tt" "em" "op")))
3501 (l12 (list-difference l9 l11)))
3502 `(collection ,@(map tmtex-env-macro l12))))
3503
3504 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3505 ;; Interface
3506 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3507
3508 (define (tmtex-get-style sty)
3509 (cond ((not sty) (set! sty (list "article")))
3510 ((string? sty) (set! sty (list sty)))
3511 ((func? sty 'tuple) (set! sty (cdr sty)))
3512 ((null? sty) (set! sty '("article"))))
3513 sty)
3514
3515 (tm-define (tmtex-postprocess x) x)
3516 (tm-define (tmtex-postprocess-body x) x)
3517
3518 (tm-define (texmacs->latex x opts)
3519 ;;(display* "texmacs->latex [" opts "], " x "\n")
3520 (if (tmfile? x)
3521 (let* ((body (tmfile-extract x 'body))
3522 (style (tmtex-get-style (tmfile-extract x 'style)))
3523 (main-style (or (tmtex-transform-style (car style)) "article"))
3524 (lan (tmfile-language x))
3525 (init (tmfile-extract x 'initial))
3526 (att (tmfile-extract x 'attachments))
3527 (doc (list '!file body style lan init att
3528 (url->string (get-texmacs-path)))))
3529 (set! tmtex-cjk-document?
3530 (in? lan '("chinese" "taiwanese" "japanese" "korean")))
3531 (latex-set-style main-style)
3532 (latex-set-packages '())
3533 (latex-set-extra '())
3534 (set! tmtex-style (car style))
3535 (set! tmtex-packages (cdr style))
3536 (set! tmtex-languages (list lan))
3537 (set! tmtex-colors '())
3538 (set! tmtex-colormaps '())
3539 (import-tmtex-styles)
3540 (tmtex-style-init body)
3541 (set! doc (tmtex-style-preprocess doc))
3542 (with result (tmtex-postprocess (texmacs->latex doc opts))
3543 (set! tmtex-style "generic")
3544 (set! tmtex-packages '())
3545 result))
3546 (let* ((x2 (tree->stree (tmtm-eqnumber->nonumber (stree->tree x))))
3547 (x3 (tmtm-match-brackets x2)))
3548 (tmtex-initialize opts)
3549 (with r (tmtex (tmpre-produce x3))
3550 (if tmtex-mathjax?
3551 (set! r (latex-mathjax-pre r)))
3552 (if (not tmtex-use-macros?)
3553 (set! r (latex-expand-macros r)))
3554 (if tmtex-mathjax?
3555 (set! r (latex-mathjax r)))
3556 r))))