| blob | 67a1be164d376896813ecfd2bd9bed6c039343f5 |
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 (texmacs-module (convert latex tmtex)
15 (:use (convert tools tmpre)
16 (convert tools old-tmtable)
17 (convert tools tmlength)
18 (convert rewrite tmtm-eqns)
19 (convert rewrite tmtm-brackets)
20 (convert latex texout)
21 (convert latex latex-tools)))
23 (use-modules (ice-9 format))
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;; Global variables
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 (define-public tmtex-style "generic")
30 (define-public tmtex-packages '())
31 (define tmtex-env (make-ahash-table))
32 (define tmtex-serial 0)
33 (define tmtex-auto-produce 0)
34 (define tmtex-auto-consume 0)
35 (define tmtex-image-root-url (string->url "image"))
36 (define tmtex-image-root-string "image")
37 (define tmtex-appendices? #f)
38 (define tmtex-replace-style? #t)
39 (define tmtex-indirect-bib? #f)
40 (define tmtex-oriental? #f)
41 (define tmtex-chinese? #f)
42 (define tmtex-japanese? #f)
43 (define tmtex-korean? #f)
44 (define tmtex-taiwanese? #f)
46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 ;; Style
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50 (texmacs-modes
51 (elsevier-style% (in? tmtex-style '("elsart" "jsc")))
52 (jsc-style% (in? tmtex-style '("jsc")) elsevier-style%)
53 (natbib-package% (in? "cite-author-year" tmtex-packages)))
55 (tm-define (tmtex-style-init body)
56 (noop))
58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
59 ;; Language
60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62 (define (tmtex-set-language lan)
63 (set! tmtex-chinese? (== lan "chinese"))
64 (set! tmtex-japanese? (== lan "japanese"))
65 (set! tmtex-korean? (== lan "korean"))
66 (set! tmtex-taiwanese? (== lan "taiwanese"))
67 (set! tmtex-oriental? (or tmtex-chinese? tmtex-japanese?
68 tmtex-korean? tmtex-taiwanese?)))
70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71 ;; Initialization from options
72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
74 (define (tmtex-initialize opts)
75 (set! tmtex-env (make-ahash-table))
76 (set! tmtex-serial 0)
77 (set! tmtex-auto-produce 0)
78 (set! tmtex-auto-consume 0)
79 (if (== (url-suffix current-save-target) "tex")
80 (begin
81 (set! tmtex-image-root-url (url-unglue current-save-target 4))
82 (set! tmtex-image-root-string
83 (url->string (url-tail tmtex-image-root-url))))
84 (begin
85 (set! tmtex-image-root-url (string->url "image"))
86 (set! tmtex-image-root-string "image")))
87 (set! tmtex-appendices? #f)
88 (set! tmtex-replace-style?
89 (== (assoc-ref opts "texmacs->latex:replace-style") "on"))
90 (set! tmtex-indirect-bib?
91 (== (assoc-ref opts "texmacs->latex:indirect-bib") "on"))
92 (set! tmtex-use-catcodes?
93 (== (assoc-ref opts "texmacs->latex:use-catcodes") "on"))
94 (set! tmtex-use-macros?
95 (== (assoc-ref opts "texmacs->latex:use-macros") "on")))
97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
98 ;; Data
99 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
101 (drd-table tmtex-table-props%
102 (block ("" "l" "" #t))
103 (block* ("" "c" "" #t))
104 (tabular ("" "l" "" #f))
105 (tabular* ("" "c" "" #f))
106 (matrix ((,(string->symbol "left(")) "c" (,(string->symbol "right)")) #f))
107 (det ((left|) "c" (right|) #f))
108 (choice ((left\{) "l" (right.) #f)))
110 (drd-table tex-with-cmd%
111 (("font-family" "rm") tmtextrm)
112 (("font-family" "ss") tmtextsf)
113 (("font-family" "tt") tmtexttt)
114 (("font-series" "medium") tmtextmd)
115 (("font-series" "bold") tmtextbf)
116 (("font-shape" "right") tmtextup)
117 (("font-shape" "slanted") tmtextsl)
118 (("font-shape" "italic") tmtextit)
119 (("font-shape" "small-caps") tmtextsc)
120 (("math-font" "cal") mathcal)
121 (("math-font" "cal*") mathscr)
122 (("math-font" "cal**") EuScript)
123 (("math-font" "Euler") mathfrak)
124 (("math-font" "Bbb") mathbb)
125 (("math-font" "Bbb*") mathbbm)
126 (("math-font" "Bbb**") mathbbmss)
127 (("math-font" "Bbb***") mathbb)
128 (("math-font" "Bbb****") mathds)
129 (("math-font-family" "mr") mathrm)
130 (("math-font-family" "ms") mathsf)
131 (("math-font-family" "mt") mathtt)
132 (("math-font-family" "normal") mathnormal)
133 (("math-font-family" "rm") mathrm)
134 (("math-font-family" "ss") mathsf)
135 (("math-font-family" "tt") mathtt)
136 (("math-font-family" "bf") mathbf)
137 (("math-font-family" "it") mathit)
138 (("math-font-series" "bold") tmmathbf)
139 (("par-columns" "2") (!begin "multicols" "2"))
140 (("par-columns" "3") (!begin "multicols" "3"))
141 (("par-mode" "center") (!begin "center"))
142 (("par-mode" "left") (!begin "flushleft"))
143 (("par-mode" "right") (!begin "flushright")))
145 (drd-table tex-assign-cmd%
146 (("font-family" "rm") rmfamily)
147 (("font-family" "ss") ssfamily)
148 (("font-family" "tt") ttfamily)
149 (("font-series" "medium") mdseries)
150 (("font-series" "bold") bfseries)
151 (("font-shape" "right") upshape)
152 (("font-shape" "slanted") slshape)
153 (("font-shape" "italic") itshape)
154 (("font-shape" "small-caps") scshape))
156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
157 ;; Manipulation of the environment
158 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
160 (define (tmtex-env-list var)
161 (let ((r (ahash-ref tmtex-env var)))
162 (if r r '())))
164 (define (tmtex-env-get var)
165 (let ((val (tmtex-env-list var)))
166 (if (null? val) #f
167 (car val))))
169 (define (tmtex-env-get-previous var)
170 (let ((val (tmtex-env-list var)))
171 (if (or (null? val) (null? (cdr val))) #f
172 (cadr val))))
174 (define (tmtex-math-mode?)
175 (== (tmtex-env-get "mode") "math"))
177 (tm-define (tmtex-env-set var val)
178 (ahash-set! tmtex-env var (cons val (tmtex-env-list var))))
180 (tm-define (tmtex-env-reset var)
181 (let ((val (tmtex-env-list var)))
182 (if (nnull? val)
183 (ahash-set! tmtex-env var (cdr val)))))
185 (tm-define (tmtex-env-assign var val)
186 (tmtex-env-reset var)
187 (tmtex-env-set var val))
189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
190 ;; Frequently used TeX construction subroutines
191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
193 (define (tex-concat-similar l)
194 (if (or (null? l) (null? (cdr l))) l
195 (let ((r (tex-concat-similar (cdr l))))
196 (cond ((and (func? (car l) '!sub) (func? (car r) '!sub))
197 (cons (list '!sub (tex-concat (list (cadar l) (cadar r))))
198 (cdr r)))
199 ((and (func? (car l) '!sup) (func? (car r) '!sup))
200 (cons (list '!sup (tex-concat (list (cadar l) (cadar r))))
201 (cdr r)))
202 (else (cons (car l) r))))))
204 (define (tex-concat-list l)
205 (cond ((null? l) l)
206 ((== (car l) "") (tex-concat-list (cdr l)))
207 ((func? (car l) '!concat) (append (cdar l) (tex-concat-list (cdr l))))
208 (else (cons (car l) (tex-concat-list (cdr l))))))
210 (tm-define (tex-concat l)
211 (:synopsis "Horizontal concatenation of list of LaTeX expressions")
212 (let ((r (tex-concat-similar (tex-concat-list l))))
213 (if (null? r) ""
214 (if (null? (cdr r)) (car r)
215 (cons '!concat r)))))
217 (define (tex-concat-strings l)
218 (cond ((< (length l) 2) l)
219 ((and (string? (car l)) (string? (cadr l)))
220 (tex-concat-strings (cons (string-append (car l) (cadr l)) (cddr l))))
221 (else (cons (car l) (tex-concat-strings (cdr l))))))
223 (tm-define (tex-concat* l)
224 (:synopsis "Variant of tex-concat which concatenates adjacent strings")
225 (tex-concat (tex-concat-strings l)))
227 (define tex-apply
228 (lambda l
229 (if (or (tmtex-math-mode?) (drd-in? (car l) tmpre-sectional%)) l
230 (list '!group l))))
232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
233 ;; Strings
234 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
236 (define (string-starts? s r)
237 (and (>= (string-length s) (string-length r))
238 (== (substring s 0 (string-length r)) r)))
240 (define (tmtex-modified-token op s i)
241 (tex-apply op
242 (if (= (string-length s) (+ i 1))
243 (substring s i (string-length s))
244 (tex-apply (string->symbol (substring s i (string-length s)))))))
246 (define (tmtex-token-sub s group?)
247 (cond ((== s "less") #\<)
248 ((== s "gtr") #\>)
249 ((== s "box") (list 'Box))
250 ((== s "||") (list '|))
251 ((string-starts? s "cal-") (tmtex-modified-token 'mathcal s 4))
252 ((string-starts? s "frak-") (tmtex-modified-token 'mathfrak s 5))
253 ((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4))
254 ((string-starts? s "b-cal-")
255 (tex-apply 'tmmathbf (tmtex-modified-token 'mathcal s 6)))
256 ((string-starts? s "b-") (tmtex-modified-token 'tmmathbf s 2))
257 ((and (string-starts? s "#") tmtex-oriental?)
258 (cond (tmtex-japanese?
259 (let* ((qs (string-append "<" s ">"))
260 (cv (string-convert qs "Cork" "ISO-2022-JP"))
261 (ex (list->string (list #\33 #\50 #\102))))
262 (set! cv (string-append cv ex))
263 (list '!widechar (string->symbol cv))))
264 (tmtex-korean?
265 (let* ((qs (string-append "<" s ">"))
266 (cv (string-convert qs "Cork" "UTF-8")))
267 (list '!widechar (string->symbol cv))))
268 ((or tmtex-chinese? tmtex-taiwanese?)
269 (let* ((qs (string-append "<" s ">"))
270 ;;(cv (string-convert qs "Cork" "cp936")) ; Chinese?
271 ;;(cv (string-convert qs "Cork" "cp950")) ; Taiwanese ?
272 (cv (string-convert qs "Cork" "UTF-8")))
273 (list '!widechar (string->symbol cv))))))
274 (else (let ((ss (list (string->symbol s))))
275 (cond ((not (drd-in? (car ss) latex-symbol%))
276 (display* "TeXmacs] non converted symbol: " s "\n")
277 "")
278 (group? (list '!group ss))
279 (else (list '!symbol ss)))))))
281 (define (tmtex-token l routine group?)
282 (receive (p1 p2) (list-break (cdr l) (lambda (x) (== x #\>)))
283 (let* ((s (list->string p1))
284 (q (if (null? p2) '() (cdr p2)))
285 (r (routine q)))
286 (cons (tmtex-token-sub s group?) r))))
288 (define (tmtex-text-sub head l)
289 (append (string->list head) (tmtex-text-list (cdr l))))
291 (define (tmtex-special-char? c)
292 (string-index "#$%&_{}" c))
294 (define (tmtex-break-char? c)
295 (string-index "+ -:=,?;()[]{}<>/" c))
297 (define (tmtex-text-list-space l)
298 (cond ((null? l) l)
299 ((== (car l) #\space)
300 (cons (list (string->symbol " ")) (tmtex-text-list-space (cdr l))))
301 (else (tmtex-text-list l))))
303 (define (tmtex-text-list l)
304 (if (null? l) l
305 (let ((c (car l)))
306 (cond ((== c #\<) (tmtex-token l tmtex-text-list #t))
307 ((== c #\space) (cons c (tmtex-text-list-space (cdr l))))
308 ((tmtex-special-char? c)
309 (cons (list (string->symbol (char->string c)))
310 (tmtex-text-list (cdr l))))
311 ((== c #\~) (cons (list '~ " ") (tmtex-text-list (cdr l))))
312 ((== c #\^) (cons (list '^ " ") (tmtex-text-list (cdr l))))
313 ((== c #\\) (cons (list 'tmbsl) (tmtex-text-list (cdr l))))
314 ((== c #\21) (tmtex-text-sub "''" l))
315 ((== c #\22) (tmtex-text-sub ",," l))
316 ((== c #\25) (tmtex-text-sub "--" l))
317 ((== c #\26) (tmtex-text-sub "---" l))
318 (else (cons c (tmtex-text-list (cdr l))))))))
320 (define (tmtex-math-operator l)
321 (receive (p q) (list-break l (lambda (c) (not (char-alphabetic? c))))
322 (let* ((op (list->string p))
323 (tail (tmtex-math-list q)))
324 (if (drd-in? (string->symbol op) latex-operator%)
325 (cons (list '!symbol (tex-apply (string->symbol op))) tail)
326 (cons (tex-apply 'tmop op) tail)))))
328 (define (tmtex-math-list l)
329 (if (null? l) l
330 (let ((c (car l)))
331 (cond ((== c #\<) (tmtex-token l tmtex-math-list #f))
332 ((tmtex-special-char? c)
333 (cons (list (string->symbol (char->string c)))
334 (tmtex-math-list (cdr l))))
335 ((== c #\~) (tmtex-math-list (cdr l)))
336 ((== c #\^) (tmtex-math-list (cdr l)))
337 ((== c #\\)
338 (cons (list 'backslash) (tmtex-math-list (cdr l))))
339 ;; ((== c #\*) (cons '(*) (tmtex-math-list (cdr l))))
340 ((== c #\*) (tmtex-math-list (cdr l)))
341 ;; ((== c #\space) (tmtex-math-list (cdr l)))
342 ((and (char-alphabetic? c)
343 (nnull? (cdr l))
344 (char-alphabetic? (cadr l)))
345 (tmtex-math-operator l))
346 (else (cons c (tmtex-math-list (cdr l))))))))
348 (define (tmtex-verb-list l)
349 (if (null? l) l
350 (let ((c (car l)))
351 (if (== c #\<)
352 (let ((r (tmtex-token l tmtex-verb-list #t)))
353 (if (char? (car r)) r (cdr r)))
354 (cons c (tmtex-verb-list (cdr l)))))))
356 (define (tmtex-string-break? x start)
357 (or (not (char? x))
358 (and (tmtex-math-mode?)
359 (or (tmtex-break-char? x)
360 (and (char-alphabetic? x) (char-numeric? start))
361 (and (char-alphabetic? start) (char-numeric? x))))))
363 (define (tmtex-string-produce l)
364 (if (null? l) l
365 (if (not (tmtex-string-break? (car l) (car l)))
366 (receive (p q)
367 (list-break l (lambda (x) (tmtex-string-break? x (car l))))
368 (cons (list->string p) (tmtex-string-produce q)))
369 (if (equal? (car l) #\space)
370 (tmtex-string-produce (cdr l))
371 (cons (if (char? (car l)) (char->string (car l)) (car l))
372 (tmtex-string-produce (cdr l)))))))
374 (define (tmtex-string s)
375 (let* ((l (string->list s))
376 (t (if (tmtex-math-mode?)
377 (tmtex-math-list l)
378 (tmtex-text-list l)))
379 (r (tmtex-string-produce t)))
380 (tex-concat r)))
382 (define (tmtex-verb-string s)
383 (let* ((l (string->list s))
384 (t (tmtex-verb-list l))
385 (r (tmtex-string-produce t)))
386 (tex-concat r)))
388 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
389 ;; Entire files
390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
392 (define (tmtex-transform-style x)
393 (cond ((in? x '("article" "book" "letter")) x)
394 ((in? x '("generic" "exam")) "letter")
395 ((== x "seminar") "slides")
396 ((in? x '("tmarticle" "tmdoc" "mmxdoc")) "article")
397 ((in? x '("tmbook" "tmmanual")) "book")
398 ;;((in? x '("acmconf" "amsart" "svjour")) x)
399 ((in? x '("elsart" "jsc")) "elsart")
400 ((in? x '("acmconf" "amsart")) x)
401 ((in? x '("svjour" "elsart" "jsc")) "article")
402 ((not tmtex-replace-style?) x)
403 (else #f)))
405 (define (tmtex-filter-styles l)
406 (if (null? l) l
407 (let* ((next (tmtex-transform-style (car l)))
408 (tail (tmtex-filter-styles (cdr l))))
409 (if next (cons next tail) tail))))
411 (define (macro-definition? x)
412 (and (func? x 'assign 2)
413 (string? (cadr x))
414 (func? (caddr x) 'macro)))
416 (define (tmtex-filter-preamble l)
417 (cond ((or (nlist? l) (null? l)) '())
418 ((macro-definition? l) (list l))
419 ((== (car l) 'hide-preamble) (cdadr l))
420 (else (append-map tmtex-filter-preamble (cdr l)))))
422 (define (tmtex-filter-body l)
423 (cond ((or (nlist? l) (null? l)) l)
424 ((== (car l) 'assign) "")
425 ((== (car l) 'hide-preamble) "")
426 (else (cons (car l) (map tmtex-filter-body (cdr l))))))
428 (define (tmtex-file l)
429 (let* ((doc (car l))
430 (styles (cadr l))
431 (lang (caddr l))
432 (init (cadddr l))
433 (doc-preamble (tmtex-filter-preamble doc))
434 (doc-body (tmtex-filter-body doc)))
435 (if (== (get-preference "texmacs->latex:expand-user-macros") "on")
436 (set! doc-preamble '()))
437 (if (null? styles) (tmtex doc)
438 (let* ((body* (tmtex doc-body))
439 (styles* (tmtex-filter-styles styles))
440 (preamble* (ahash-with tmtex-env :preamble #t
441 (map-in-order tmtex doc-preamble))))
442 (list '!file body* styles* lang init preamble*)))))
444 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
445 ;; Simple text
446 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
448 (define (tmtex-noop l) "")
449 (define (tmtex-default s l) (cons (string->symbol s) (tmtex-list l)))
450 (define (tmtex-id l) (tmtex (car l)))
451 (define (tmtex-second l) (tmtex (cadr l)))
452 (define (tmtex-hide-part s l) "")
453 (define (tmtex-show-part s l) (tmtex (cadr l)))
455 (define (tmtex-document l)
456 (cons '!document (tmtex-list l)))
458 (define (tmtex-para l)
459 (cons '!paragraph (tmtex-list l)))
461 (define (tmtex-surround-sub l z)
462 (if (null? (cdr l))
463 (list (tex-concat (list (car l) z)))
464 (cons (car l) (tmtex-surround-sub (cdr l) z))))
466 (define (tmtex-surround l)
467 (let* ((ll (tmtex-list l))
468 (x (car ll))
469 (y (caddr ll))
470 (z (cadr ll)))
471 (if (func? y '!document)
472 (let* ((a (cadr y))
473 (b (cddr y)))
474 (cons '!document
475 (tmtex-surround-sub
476 (cons (tex-concat (list x a)) b) z)))
477 (tex-concat (list x y z)))))
479 (define (tmtex-script? x)
480 (or (func? x '!sub)
481 (func? x '!sup)
482 (and (string? x) (!= x "") (in? (string-ref x 0) '(#\' #\, #\) #\])))
483 (and (func? x '!concat) (tmtex-script? (cadr x)))))
485 (define (tmtex-math-concat-spaces l)
486 (if (or (null? l) (null? (cdr l))) l
487 (let* ((head (car l))
488 (tail (tmtex-math-concat-spaces (cdr l))))
489 (if (tmtex-script? (car tail))
490 (cons head tail)
491 (cons* head " " tail)))))
493 (define (tmtex-rewrite-no-break l)
494 (cond ((null? l) l)
495 ((and (string? (car l)) (string-ends? (car l) " ")
496 (nnull? (cdr l)) (== (cadr l) '(no-break)))
497 (let* ((s (substring (car l) 0 (- (string-length (car l)) 1)))
498 (r (tmtex-rewrite-no-break (cddr l))))
499 (if (== s "") (cons '(!nbsp) r) (cons* s '(!nbsp) r))))
500 (else (cons (car l) (tmtex-rewrite-no-break (cdr l))))))
502 (define (tmtex-concat l)
503 (if (tmtex-math-mode?)
504 (tex-concat (tmtex-math-concat-spaces (tmtex-list l)))
505 (tex-concat (tmtex-list (tmtex-rewrite-no-break l)))))
507 (define (tmtex-group l)
508 (tmtex-function '!group l))
510 (define (tmtex-no-first-indentation l) (tex-apply 'noindent))
511 (define (tmtex-line-break l) (tex-apply 'linebreak))
512 (define (tmtex-page-break l) (tex-apply 'pagebreak))
513 (define (tmtex-new-page l) (tex-apply 'newpage))
514 (define (tmtex-new-line l) (tex-apply '!newline))
515 (define (tmtex-next-line l) (list '!nextline))
516 (define (tmtex-no-break l) '(!group (nobreak)))
518 (define (tmtex-decode-length s)
519 ;; FIXME: should be completed
520 (cond ((string-ends? s "fn") (string-replace s "fn" "em"))
521 ((string-ends? s "spc") (string-replace s "spc" "em"))
522 ((string-ends? s "par") (string-replace s "par" "\\columnwidth"))
523 (else s)))
525 (define (tmtex-hspace l)
526 (let ((s (if (= (length l) 1) (car l) (cadr l))))
527 (cond ((== s "1fn") (list 'quad))
528 ((== s "-0.6spc") '(!concat (!) (!) (!)))
529 ((== s "-0.4spc") '(!concat (!) (!)))
530 ((== s "-0.2spc") '(!concat (!)))
531 ((== s "0.2spc") (list (string->symbol ",")))
532 ((== s "0.4spc") (list (string->symbol ":")))
533 ((== s "0.6spc") (list (string->symbol ";")))
534 (else (tex-apply 'hspace (tmtex-decode-length s))))))
536 (define (tmtex-vspace l)
537 (let ((s (if (= (length l) 1) (car l) (cadr l))))
538 (cond ((== s "0.5fn") (tex-apply 'smallskip))
539 ((== s "1fn") (tex-apply 'medskip))
540 ((== s "2fn") (tex-apply 'bigskip))
541 (else (tex-apply 'vspace (tmtex-decode-length s))))))
543 (define (tmtex-space l)
544 (tmtex-hspace (list (car l))))
546 (define (tmtex-float-make size type position x capt)
547 (let* ((body (tmtex x))
548 (caption (tmtex capt))
549 (body* `(!paragraph ,body (caption ,caption))))
550 (cond ((and (== size "big") (== type "figure"))
551 `((!begin "figure" (!option ,position)) ,body*))
552 ((and (== size "big") (== type "table"))
553 `((!begin "table" (!option ,position)) ,body*))
554 (else (list 'tmfloat position size type body caption)))))
556 (define (tmtex-float-table? x)
557 (or (func? x 'small-table 2) (func? x 'big-table 2)))
559 (define (tmtex-float-figure? x)
560 (or (func? x 'small-figure 2) (func? x 'big-figure 2)))
562 (define (tmtex-float-size l)
563 (if (list? l)
564 (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big")
565 "big"))
567 (define (tmtex-float-sub position l)
568 (cond ((func? l 'document 1) (tmtex-float-sub position (cadr l)))
569 ((tmtex-float-figure? l)
570 (tmtex-float-make (tmtex-float-size l) "figure" position (cadr l)
571 (caddr l)))
572 ((tmtex-float-table? l)
573 (tmtex-float-make (tmtex-float-size l) "table" position (cadr l)
574 (caddr l)))
575 (else (tmtex-float-make "big" "figure" position l ""))))
577 (define (tmtex-float l)
578 (tmtex-float-sub (force-string (cadr l)) (caddr l)))
580 (define (tmtex-htab l)
581 (tex-apply 'hspace* (list 'fill)))
583 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
584 ;; Mathematics
585 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
587 (define (tmtex-large-decode s)
588 (cond ((nstring? s) ".")
589 ((in? s '("(" ")" "[" "]" "|" "/" ".")) s)
590 ((== s "||") "\\|")
591 ((== s "\\") "\\backslash")
592 (else (string-append "\\" s))))
594 (define (tmtex-left l)
595 (let* ((s (tmtex-large-decode (car l)))
596 (n (if (> (length l) 1) (string->number (cadr l)) 0))
597 (b (cond ((= n 1) "bigl")
598 ((= n 2) "Bigl")
599 ((= n 3) "biggl")
600 ((= n 4) "Biggl")
601 (else "left"))))
602 (list (string->symbol (string-append b s)))))
604 (define (tmtex-mid l)
605 (let ((s (tmtex-large-decode (car l))))
606 (if (== (string-ref s 0) #\\)
607 (list (string->symbol (substring s 1 (string-length s))))
608 s)))
610 (define (tmtex-right l)
611 (let* ((s (tmtex-large-decode (car l)))
612 (n (if (> (length l) 1) (string->number (cadr l)) 0))
613 (b (cond ((= n 1) "bigr")
614 ((= n 2) "Bigr")
615 ((= n 3) "biggr")
616 ((= n 4) "Biggr")
617 (else "right"))))
618 (list (string->symbol (string-append b s)))))
620 (define (tmtex-big-decode s)
621 (cond ((nstring? s) "bignone")
622 ((in? s '("sum" "prod" "int" "oint" "coprod")) s)
623 ((== s "amalg") "coprod")
624 ((== s "pluscup") "uplus")
625 ((== s ".") "bignone")
626 (else (string-append "big" s))))
628 (define (tmtex-big l)
629 (list (string->symbol (tmtex-big-decode (car l)))))
631 (define (tmtex-prime-list l)
632 (if (null? l) l
633 (cond ((== (car l) #\<)
634 (receive (p q) (list-break (cdr l) (lambda (c) (== c #\>)))
635 (let ((next (if (null? q) '() (cdr q))))
636 (cons (list '!sup (list (string->symbol (list->string p))))
637 (tmtex-prime-list next)))))
638 ((== (car l) #\') (cons "'" (tmtex-prime-list (cdr l))))
639 ((== (car l) #\`)
640 (cons (list '!sup (list 'backprime))
641 (tmtex-prime-list (cdr l))))
642 (else (cons (list '!sup (char->string (car l)))
643 (tmtex-prime-list (cdr l)))))))
645 (define (tmtex-lprime l)
646 (tmtex (list 'concat (list 'text "") (list 'rprime (car l)))))
648 (define (tmtex-rprime l)
649 (tex-concat (tmtex-prime-list (string->list (car l)))))
651 (define (tmtex-below l)
652 (list 'underset (tmtex (cadr l)) (tmtex (car l))))
654 (define (tmtex-above l)
655 (list 'overset (tmtex (cadr l)) (tmtex (car l))))
657 (define (tmtex-lsub l)
658 (tmtex (list 'concat (list 'text "") (list 'rsub (car l)))))
660 (define (tmtex-lsup l)
661 (tmtex (list 'concat (list 'text "") (list 'rsup (car l)))))
663 (define (tmtex-contains-table? x)
664 (cond ((nlist? x) #f)
665 ((and (>= (length x) 2) (== (car x) '!table)) #t)
666 (else (list-or (map-in-order tmtex-contains-table? (cdr x))))))
668 (define (tmtex-script which script)
669 (with r (tmtex script)
670 (if (tmtex-contains-table? r)
671 (list which (list 'tmscript r))
672 (list which r))))
674 (define (tmtex-rsub l)
675 (tmtex-script '!sub (car l)))
677 (define (tmtex-rsup l)
678 (tmtex-script '!sup (car l)))
680 (define (tmtex-frac l)
681 (tmtex-function 'frac l))
683 (define (tmtex-sqrt l)
684 (if (= (length l) 1)
685 (tmtex-function 'sqrt l)
686 (list 'sqrt
687 (list '!option (tmtex (cadr l)))
688 (tmtex (car l)))))
690 (define (tmtex-token? s)
691 (or (= (string-length s) 1)
692 (and (!= s "")
693 (== (string-ref s 0) #\<)
694 (== (string-index s #\>) (- (string-length s) 1)))))
696 (define (tmtex-wide-star? x)
697 (cond ((func? x 'wide* 1) (tmtex-wide-star? (cadr x)))
698 ((nstring? x) #t)
699 (else (not (tmtex-token? x)))))
701 (define (tmtex-wide-star l)
702 (let ((wide (tmtex-wide-star? (car l)))
703 (arg (tmtex (car l)))
704 (acc (cadr l)))
705 (if (and (string? acc) (string-starts? acc "<wide-"))
706 (set! acc (string-append "<" (substring acc 6 (string-length acc)))))
707 (cond ((nstring? acc) arg)
708 ((== acc "~")
709 (tmtex-below (list (car l) (list 'mbox (list 'textasciitilde)))))
710 ((== acc "<bar>") (list 'underline arg))
711 ((in? acc '("<underbrace>" "<underbrace*>"))
712 (list 'underbrace arg))
713 ((in? acc '("<overbrace>" "<overbrace*>"))
714 (tmtex-below `(,(car l) (text (downbracefill)))))
715 ;; imperfect translations
716 ((in? acc '("<squnderbrace>" "<squnderbrace*>"))
717 (list 'underbrace arg))
718 ((in? acc '("<sqoverbrace>" "<sqoverbrace*>"))
719 (tmtex-below `(,(car l) (text (downbracefill)))))
720 (else
721 (display* "TeXmacs] non converted accent below: " acc "\n")
722 arg))))
724 (define (tmtex-wide? x)
725 (cond ((func? x 'wide 1) (tmtex-wide? (cadr x)))
726 ((nstring? x) #t)
727 (else (not (tmtex-token? x)))))
729 (define (tmtex-wide l)
730 (let ((wide (tmtex-wide? (car l)))
731 (arg (tmtex (car l)))
732 (acc (cadr l)))
733 (if (and (string? acc) (string-starts? acc "<wide-"))
734 (set! acc (string-append "<" (substring acc 6 (string-length acc)))))
735 (cond ((nstring? acc) arg)
736 ((in? acc '("<hat>" "^")) (list (if wide 'widehat 'hat) arg))
737 ((in? acc '("<tilde>" "~")) (list (if wide 'widetilde 'tilde) arg))
738 ((== (cadr l) "<wide-bar>") (list 'overline arg))
739 ((== acc "<bar>") (list (if wide 'overline 'bar) arg))
740 ((== acc "<vect>") (list (if wide 'overrightarrow 'vec) arg))
741 ((== acc "<breve>") (list 'breve arg))
742 ((== acc "<check>") (list 'check arg))
743 ((== acc "<acute>") (list 'acute arg))
744 ((== acc "<grave>") (list 'grave arg))
745 ((== acc "<dot>") (list 'dot arg))
746 ((== acc "<ddot>") (list 'ddot arg))
747 ((== acc "<dddot>") (list 'dddot arg))
748 ((== acc "<ddddot>") (list 'ddddot arg))
749 ((in? acc '("<overbrace>" "<overbrace*>"))
750 (list 'overbrace arg))
751 ((in? acc '("<underbrace>" "<underbrace*>"))
752 (tmtex-above `(,(car l) (text (upbracefill)))))
753 ;; FIXME: imperfect translations
754 ((== acc "<abovering>") (list 'dot arg))
755 ((in? acc '("<sqoverbrace>" "<sqoverbrace*>"))
756 (list 'overbrace arg))
757 ((in? acc '("<squnderbrace>" "<squnderbrace*>"))
758 (tmtex-above `(,(car l) (text (upbracefill)))))
759 (else
760 (display* "TeXmacs] non converted accent: " acc "\n")
761 arg))))
763 (define (tmtex-neg l)
764 (tmtex-function 'not l))
766 (define (tmtex-tree l)
767 (let* ((root (list '!begin "bundle" (tmtex (car l))))
768 (children (map (lambda (x) (list 'chunk (tmtex x))) (cdr l))))
769 (list root (tex-concat children))))
771 (define (tmtex-tree-eps l)
772 (tmtex-eps (cons 'tree l)))
774 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
775 ;; Tables
776 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
778 (define (tmtex-table-rows-assemble tb bb rows)
779 (cond ((null? rows)
780 (if (null? bb) '() (if (car bb) (list (list 'hline)) '())))
781 (else (append (if (or (car tb) (car bb)) (list (list 'hline)) '())
782 (cons (cons '!row (map tmtex (car rows)))
783 (tmtex-table-rows-assemble
784 (cdr tb) (cdr bb) (cdr rows)))))))
786 (define (tmtex-table-make p)
787 (let ((tb (p 'rows 'tborder))
788 (bb (p 'rows 'bborder))
789 (l (p 'rows 'content)))
790 (cons '!table (tmtex-table-rows-assemble tb (cons (car tb) bb) l))))
792 (define (tmtex-table-args-assemble lb rb ha)
793 (cond
794 ((null? ha) (if (null? rb) '() (list (if (car rb) "|" ""))))
795 (else (cons (if (or (car lb) (car rb)) "|" "")
796 (cons (car ha) (tmtex-table-args-assemble
797 (cdr lb) (cdr rb) (cdr ha)))))))
799 (define (tmtex-table-args p)
800 (let ((lb (p 'cols 'lborder))
801 (rb (p 'cols 'rborder))
802 (l (p 'cols 'halign)))
803 (apply string-append
804 (tmtex-table-args-assemble lb (cons (car lb) rb) l))))
806 (define (tmtex-table-apply key x)
807 (let* ((props (drd-ref tmtex-table-props% key)))
808 (if props
809 (let* ((env (if (tmtex-math-mode?) 'array 'tabular))
810 (before (car props))
811 (after (caddr props))
812 (defaults (append (tmtable-cell-halign (cadr props))
813 (tmtable-block-borders (cadddr props))))
814 (p (tmtable-parser `(tformat ,@defaults ,x)))
815 (e (list '!begin (symbol->string env) (tmtex-table-args p)))
816 (r (tmtex-table-make p)))
817 (tex-concat (list before (list e r) after)))
818 (list (list '!begin (symbol->string key))
819 (tmtex-table-make (tmtable-parser x))))))
821 (define (tmtex-tformat l)
822 (tmtex-table-apply 'tabular (cons 'tformat l)))
824 (define (tmtex-table l)
825 (tmtex-table-apply 'tabular (cons 'table l)))
827 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
828 ;; Local and global environment changes
829 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
831 (define (tmtex-get-with-cmd var val)
832 (drd-ref tex-with-cmd% (list var val)))
834 (define (tmtex-get-assign-cmd var val)
835 (if (== var "font-size")
836 (let ((x (* (string->number val) 10)))
837 (cond ((< x 1) #f)
838 ((< x 5.5) 'tiny)
839 ((< x 6.5) 'scriptsize)
840 ((< x 7.5) 'footnotesize)
841 ((< x 9.5) 'small)
842 ((< x 11.5) 'normalsize)
843 ((< x 13.5) 'large)
844 ((< x 15.5) 'Large)
845 ((< x 18.5) 'LARGE)
846 ((< x 22.5) 'huge)
847 ((< x 50) 'Huge)
848 (else #f)))
849 (drd-ref tex-assign-cmd% (list var val))))
851 (define (tmlength->texlength len)
852 ;; TODO: rewrite (quote x) -> x and (tmlen ...) -> ...pt
853 (with tmlen (string->tmlength (force-string len))
854 (if (tmlength-null? tmlen) "0pt"
855 (let* ((val (tmlength-value tmlen))
856 (unit (symbol->string (tmlength-unit tmlen)))
857 (val-string (number->string val)))
858 (cond ((== unit "fn") (string-append val-string "em"))
859 (else len))))))
861 (define (tmtex-make-parmod x y z arg)
862 (set! x (tmlength->texlength x))
863 (set! y (tmlength->texlength y))
864 (set! z (tmlength->texlength z))
865 (if (and (tmlength-zero? (string->tmlength x))
866 (tmlength-zero? (string->tmlength y))
867 (tmlength-zero? (string->tmlength z)))
868 arg
869 (list (list '!begin "tmparmod" x y z) arg)))
871 (define (tmtex-make-parsep x arg)
872 (set! x (tmlength->texlength x))
873 (list (list '!begin "tmparsep" x) arg))
875 (define (tmtex-with-one var val arg)
876 (if (== var "mode")
877 (let ((old (tmtex-env-get-previous "mode")))
878 (cond ((and (== val "text") (!= old "text"))
879 (list 'text arg))
880 ((and (== val "math") (!= old "math")
881 (ahash-ref tmtex-env :preamble))
882 (list 'ensuremath arg))
883 ((and (== val "math") (!= old "math"))
884 (list '!math arg))
885 (else arg)))
886 (let ((w (tmtex-get-with-cmd var val))
887 (a (tmtex-get-assign-cmd var val)))
888 (cond (w (list w arg))
889 (a (list '!group (tex-concat (list (list a) " " arg))))
890 ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg))
891 ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg))
892 ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg))
893 ((== "par-par-sep" var) (tmtex-make-parsep val arg))
894 ((== var "color")
895 (if (and (= (string-length val) 7) (char=? (string-ref val 0) #\#))
896 (let* ((r (quotient (* (string->number (substring val 1 3) 16) 1000) 255))
897 (g (quotient (* (string->number (substring val 3 5) 16) 1000) 255))
898 (b (quotient (* (string->number (substring val 5 7) 16) 1000) 255))
899 (rgb (format #f "~,,-3f,~,,-3f,~,,-3f" r g b)))
900 (list '!group (tex-concat (list (list 'color (list '!option "rgb") rgb) " " arg))))
901 (list '!group (tex-concat (list (list 'color val) " " arg)))))
902 (else arg)))))
904 (define (tmtex-with l)
905 (cond ((null? l) "")
906 ((null? (cdr l)) (tmtex (car l)))
907 ((func? (cAr l) 'graphics) (tmtex-eps (cons 'with l)))
908 (else (let ((var (force-string (car l)))
909 (val (force-string (cadr l)))
910 (next (cddr l)))
911 (tmtex-env-set var val)
912 (let ((r (tmtex-with-one var val (tmtex-with next))))
913 (tmtex-env-reset var)
914 r)))))
916 (define (tmtex-var-name-sub l)
917 (if (null? l) l
918 (let ((c (car l)) (r (tmtex-var-name-sub (cdr l))))
919 (cond ((char-alphabetic? c) (cons c r))
920 ((char=? c #\0) (cons* #\z #\e #\r #\o r))
921 ((char=? c #\1) (cons* #\o #\n #\e r))
922 ((char=? c #\2) (cons* #\t #\w #\o r))
923 ((and (char=? c #\*) (null? (cdr l))) (list c))
924 (else r)))))
926 (define (tmtex-var-name var)
927 (cond ((nstring? var) "")
928 ((drd-in? (string->symbol var) tmtex-protected%)
929 (string-append "tm" var))
930 ((<= (string-length var) 1) var)
931 (else (list->string (tmtex-var-name-sub (string->list var))))))
933 (define (tmtex-tex-arg l)
934 (cons '!arg l))
936 (define (tmtex-args-search x args)
937 (cond ((null? args) #f)
938 ((== x (car args)) 1)
939 (else
940 (let ((n (tmtex-args-search x (cdr args))))
941 (if n (+ 1 n) #f)))))
943 (define (tmtex-args-sub l args)
944 (if (null? l) l
945 (cons (tmtex-args (car l) args)
946 (tmtex-args-sub (cdr l) args))))
948 (define (tmtex-args x args)
949 (cond ((nlist? x) x)
950 ((or (func? x 'arg) (func? x 'value))
951 (let ((n (tmtex-args-search (cadr x) args)))
952 (if n (list '!arg (number->string n)) (tmtex-args-sub x args))))
953 (else (tmtex-args-sub x args))))
955 (define (tmtex-assign l)
956 (let ((var (tmtex-var-name (car l)))
957 (val (cadr l)))
958 (while (func? val 'quote 1) (set! val (cadr val)))
959 (if (!= var "")
960 (begin
961 (tmtex-env-assign var val)
962 (cond ((string? val)
963 (let ((a (tmtex-get-assign-cmd var val)))
964 (if a (list a)
965 (list 'newcommand (string-append "\\" var)
966 (tmtex val)))))
967 ((or (func? val 'macro) (func? val 'func))
968 (if (null? (cddr val))
969 (list 'newcommand (string-append "\\" var)
970 (tmtex (cAr val)))
971 (list 'newcommand (string-append "\\" var)
972 (list '!option (number->string (- (length val) 2)))
973 (tmtex (tmtex-args (cAr val) (cDdr val))))))
974 (else (list 'newcommand (string-append "\\" var)
975 (tmtex val)))))
976 "")))
978 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
979 ;; Other primitives
980 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
982 (define (tmtex-quote l)
983 (tmtex (car l)))
985 (define (tmtex-label l)
986 (list 'label (force-string (car l))))
988 (define (tmtex-reference l)
989 (list 'ref (force-string (car l))))
991 (define (tmtex-pageref l)
992 (list 'pageref (force-string (car l))))
994 (define (tmtex-specific l)
995 (cond ((== (car l) "latex") (tmtex-tt (cadr l)))
996 ((== (car l) "image") (tmtex-eps (cadr l)))
997 (else "")))
999 (define (tmtex-eps-names)
1000 (set! tmtex-serial (+ tmtex-serial 1))
1001 (let* ((postfix (string-append "-" (number->string tmtex-serial) ".eps"))
1002 (name-url (url-glue tmtex-image-root-url postfix))
1003 (name-string (string-append tmtex-image-root-string postfix)))
1004 (values name-url name-string)))
1006 (define (tmtex-eps x)
1007 (if (tmtex-math-mode?) (set! x `(with "mode" "math" ,x)))
1008 (receive (name-url name-string) (tmtex-eps-names)
1009 (print-snippet name-url x)
1010 (list 'includegraphics name-string)))
1012 (define (tmtex-graphics l)
1013 (tmtex-eps (cons 'graphics l)))
1015 (define (tmtex-as-eps name)
1016 (with u (url-relative current-save-target (string->url name))
1017 (if (or (string-ends? name ".ps")
1018 (string-ends? name ".eps")
1019 (not (url-exists? u)))
1020 (list 'includegraphics name)
1021 (let* ((suffix (url-suffix u))
1022 (fm (string-append (format-from-suffix suffix) "-file")))
1023 (receive (name-url name-string) (tmtex-eps-names)
1024 (convert-to-file u fm "postscript-file" name-url)
1025 (list 'includegraphics name-string))))))
1027 (define (tmtex-postscript l)
1028 (let* ((fig (tmtex-as-eps (force-string (car l))))
1029 (hor (if (== (cadr l) "") "!" (tmtex-decode-length (cadr l))))
1030 (ver (if (== (caddr l) "") "!" (tmtex-decode-length (caddr l)))))
1031 (if (or (string-starts? hor "*") (string-starts? hor "/")) (set! hor "!"))
1032 (if (or (string-starts? ver "*") (string-starts? ver "/")) (set! ver "!"))
1033 (if (and (== hor "!") (== ver "!")) fig
1034 (list 'resizebox hor ver fig))))
1036 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1037 ;; Titles of documents
1038 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1040 (define (tmtex-compressed sep l)
1041 (cond ((null? l) l)
1042 ((null? (cdr l)) (list (tmtex (car l))))
1043 (else (cons* (tmtex (car l))
1044 sep
1045 (tmtex-compressed sep (cdr l))))))
1047 (define (tmtex-data-assemble sep l)
1048 (cond ((null? l) l)
1049 ((null? (cdr l)) (car l))
1050 (else (with r (tmtex-data-assemble sep (cdr l))
1051 (cond ((null? (car l)) r)
1052 ((null? r) (car l))
1053 (else (append (car l) (list sep) r)))))))
1055 (tm-define (tmtex-select-data expr tag)
1056 (:synopsis "Get data matching @tag in @expr with nice separators")
1057 (let* ((data (select expr (list tag)))
1058 (sep (if (== tag 'author-address) '(!nextline) "; "))
1059 (fun (lambda (x)
1060 (cond ((func? x 'document)
1061 (list (tex-concat* (tmtex-compressed sep (cdr x)))))
1062 (else (list (tmtex x)))))))
1063 (if (null? data) '()
1064 (with l (cdar data)
1065 (tmtex-data-assemble ", " (map fun l))))))
1067 (define (tmtex-data-apply tag l)
1068 (if (null? l) l
1069 (list (list tag (tex-concat* l)))))
1071 (define (tmtex-make-author tag)
1072 (let* ((name (tmtex-select-data tag 'author-name))
1073 (address (tmtex-select-data tag 'author-address))
1074 (note (tmtex-select-data tag 'author-note))
1075 (email (tmtex-select-data tag 'author-email))
1076 (homepage (tmtex-select-data tag 'author-homepage))
1077 (email* (tmtex-data-apply 'email email))
1078 (homepage* (tmtex-data-apply 'homepage homepage))
1079 (note* (tmtex-data-assemble "; " (list note email* homepage*)))
1080 (name* (append name (tmtex-data-apply 'thanks note*))))
1081 (tex-concat* (tmtex-data-assemble '(!nextline)
1082 (list name* address)))))
1084 (tm-define (tmtex-doc-data s l)
1085 (let* ((tag (cons s l))
1086 (title (tmtex-select-data tag 'doc-title))
1087 (authors (map tmtex-make-author (select tag '(doc-author-data))))
1088 (date (tmtex-select-data tag 'doc-date))
1089 (note (tmtex-select-data tag 'doc-note))
1090 (keywords (tmtex-select-data tag 'doc-keywords))
1091 (AMS-class (tmtex-select-data tag 'doc-AMS-class))
1092 (keywords* (tmtex-data-apply 'keywords keywords))
1093 (AMS-class* (tmtex-data-apply 'AMSclass AMS-class))
1094 (note* (tmtex-data-assemble "; " (list note keywords* AMS-class*)))
1095 (title* (append title (tmtex-data-apply 'thanks note*)))
1096 (author* (tmtex-data-assemble '(and) (map list authors))))
1097 (tex-concat `((title ,(tex-concat title*))
1098 (author ,(tex-concat author*))
1099 (maketitle)))))
1101 (define (tmtex-doc-data-wrapper s l)
1102 (tmtex-doc-data s l))
1104 (tm-define (tmtex-abstract s l)
1105 (tmtex-std-env s l))
1107 (define (tmtex-abstract-wrapper s l)
1108 (tmtex-abstract s l))
1110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1111 ;; TeXmacs style primitives
1112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1114 (define (tmtex-std-env s l)
1115 (if (== s "quote-env") (set! s "quote"))
1116 (list (list '!begin s) (tmtex (car l))))
1118 (define (tmtex-appendix s l)
1119 (with app (list (if (latex-book-style?) 'chapter 'section) (tmtex (car l)))
1120 (if tmtex-appendices? app
1121 (begin
1122 (set! tmtex-appendices? #t)
1123 (list '!concat '(appendix) app)))))
1125 (define (tmtex-tt-document l)
1126 (cond ((null? l) "")
1127 ((null? (cdr l)) (tmtex-tt (car l)))
1128 (else (string-append (tmtex-tt (car l)) "\n"
1129 (tmtex-tt-document (cdr l))))))
1131 (define (tmtex-tt x)
1132 (cond ((string? x) (tmtex-verb-string x))
1133 ((== x '(next-line)) "\n")
1134 ((func? x 'document) (tmtex-tt-document (cdr x)))
1135 ((func? x 'para) (tmtex-tt-document (cdr x)))
1136 ((func? x 'concat)
1137 (apply string-append (map-in-order tmtex-tt (cdr x))))
1138 (else "")))
1140 (define (tmtex-verbatim s l)
1141 (if (func? (car l) 'document)
1142 (list '!verbatim (tmtex-tt (car l)))
1143 (list 'tmtexttt (tmtex (car l)))))
1144 ;;(list '!verb (tmtex-tt (car l)))))
1146 (define (tmtex-indent s l)
1147 (list (list '!begin "tmindent") (tmtex (car l))))
1149 (define (tmtex-list-env s l)
1150 (let* ((r (string-replace s "-" ""))
1151 (t (cond ((== r "enumerateRoman") "enumerateromancap")
1152 ((== r "enumerateAlpha") "enumeratealphacap")
1153 (else r))))
1154 (list (list '!begin t) (tmtex (car l)))))
1156 (define (tmtex-tiny s l)
1157 (tex-apply 'tiny (tmtex (car l))))
1159 (define (tmtex-scriptsize s l)
1160 (tex-apply 'scriptsize (tmtex (car l))))
1162 (define (tmtex-footnotesize s l)
1163 (tex-apply 'footnotesize (tmtex (car l))))
1165 (define (tmtex-normalsize s l)
1166 (tex-apply 'normalsize (tmtex (car l))))
1168 (define (tmtex-large s l)
1169 (tex-apply 'large (tmtex (car l))))
1171 (define (tmtex-Large s l)
1172 (tex-apply 'Large (tmtex (car l))))
1174 (define (tmtex-LARGE s l)
1175 (tex-apply 'LARGE (tmtex (car l))))
1177 (define (tmtex-Huge s l)
1178 (list 'Huge (tmtex (car l))))
1180 (tm-define (tmtex-equation s l)
1181 (tmtex-env-set "mode" "math")
1182 (let ((r (tmtex (car l))))
1183 (tmtex-env-reset "mode")
1184 (if (== s "equation")
1185 (list (list '!begin s) r)
1186 (list '!eqn r))))
1188 (define (tmtex-equation-wrapper s l)
1189 (tmtex-equation s l))
1191 (define (tmtex-eqnarray s l)
1192 (tmtex-env-set "mode" "math")
1193 (let ((r (tmtex-table-apply (string->symbol s) (car l))))
1194 (tmtex-env-reset "mode")
1195 r))
1197 (define (tmtex-math s l)
1198 (tmtex `(with "mode" "math" ,(car l))))
1200 (define (tmtex-dummy s l)
1201 "")
1203 (define (tmtex-toc s l)
1204 (tex-apply 'tableofcontents))
1206 (define (tmtex-bib-sub doc)
1207 (cond ((nlist? doc) doc)
1208 ((match? doc '(concat (bibitem* :%1) (label :string?) :*))
1209 (let* ((l (cadr (caddr doc)))
1210 (s (if (string-starts? l "bib-") (string-drop l 4) l)))
1211 (cons* 'concat (list 'bibitem* (cadadr doc) s) (cdddr doc))))
1212 ((func? doc 'bib-list 2) (tmtex-bib-sub (cAr doc)))
1213 (else (map tmtex-bib-sub doc))))
1215 (define (tmtex-bib-max l)
1216 (cond ((npair? l) "")
1217 ((match? l '(bibitem* :string? :%1)) (cadr l))
1218 (else (let* ((s1 (tmtex-bib-max (car l)))
1219 (s2 (tmtex-bib-max (cdr l))))
1220 (if (< (string-length s1) (string-length s2)) s2 s1)))))
1222 (define (tmtex-bib s l)
1223 (if tmtex-indirect-bib?
1224 (tex-concat (list (list 'bibliographystyle (force-string (cadr l)))
1225 (list 'bibliography (force-string (caddr l)))))
1226 (let* ((doc (tmtex-bib-sub (cadddr l)))
1227 (max (tmtex-bib-max doc)))
1228 (tmtex (list 'thebibliography max doc)))))
1230 (define (tmtex-thebibliography s l)
1231 (list (list '!begin s (car l)) (tmtex (cadr l))))
1233 (define (tmtex-bibitem* s l)
1234 (cond ((= (length l) 1)
1235 `(bibitem ,(tmtex (car l))))
1236 ((= (length l) 2)
1237 `(bibitem (!option ,(tmtex (car l))) ,(tmtex (cadr l))))
1238 (else "")))
1240 (define (tmtex-figure s l)
1241 (tmtex-float-sub "h" (cons (string->symbol s) l)))
1243 (define (tmtex-item s l)
1244 (tex-concat (list (list 'item) " ")))
1246 (define (tmtex-item-arg s l)
1247 (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " ")))
1249 (define (tmtex-render-proof s l)
1250 (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l))))
1252 (define (tmtex-nbsp s l)
1253 '(!nbsp))
1255 (define (tmtex-session s l)
1256 (tmtex (cAr l)))
1258 (define (tmtex-input s l)
1259 (let ((prompt (car l)) (x (cadr l)))
1260 (tex-concat
1261 (list `(!group (!concat (color "red") (ttfamily ,(tmtex prompt))))
1262 (cond ((func? x 'math 1)
1263 (tmtex-env-set "mode" "math")
1264 (let ((r (tmtex (cadr x))))
1265 (tmtex-env-reset "mode")
1266 `(!math (!group (!concat (color "blue") ,r)))))
1267 (else `(!group (!concat (color "blue")
1268 (!verb ,(tmtex-tt x))))))))))
1270 (define (tmtex-output s l)
1271 (list '!group (list 'ttfamily (tmtex (car l)))))
1273 (define (tmtex-hlink s l)
1274 (list 'href (tmtex (cadr l)) (tmtex (car l))))
1276 (define (tmtex-href s l)
1277 (tmtex-function 'url l))
1279 (define (tmtex-action s l)
1280 (list 'tmaction (tmtex (car l)) (tmtex (cadr l))))
1282 (define (tmtex-choose s l)
1283 (list 'binom (tmtex (car l)) (tmtex (cadr l))))
1285 (define (tmtex-modifier s l)
1286 (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l))))
1288 (define (tmtex-menu-one x)
1289 (tmtex (list 'samp x)))
1291 (define (tmtex-menu-list l)
1292 (if (null? l) l
1293 (cons* (list '!math (list 'rightarrow))
1294 (tmtex-menu-one (car l))
1295 (tmtex-menu-list (cdr l)))))
1297 (define (tmtex-menu s l)
1298 (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l)))))
1300 (define ((tmtex-rename into) s l)
1301 (tmtex-apply into (tmtex-list l)))
1303 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1304 ;; Citations
1305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1307 (define (tmtex-cite-list l)
1308 (cond ((null? l) "")
1309 ((nstring? (car l)) (tmtex-cite-list (cdr l)))
1310 ((null? (cdr l)) (car l))
1311 (else (string-append (car l) "," (tmtex-cite-list (cdr l))))))
1313 (tm-define (tmtex-cite s l)
1314 (tex-apply 'cite (tmtex-cite-list l)))
1316 (tm-define (tmtex-cite s l)
1317 (:mode natbib-package?)
1318 (tex-apply 'citep (tmtex-cite-list l)))
1320 (define (tmtex-nocite s l)
1321 (tex-apply 'nocite (tmtex-cite-list l)))
1323 (tm-define (tmtex-cite-detail s l)
1324 (tex-apply 'cite `(!option ,(tmtex (cadr l))) (tmtex (car l))))
1326 (tm-define (tmtex-cite-detail s l)
1327 (:mode natbib-package?)
1328 (tex-apply 'citetext `(!concat (citealp ,(tmtex (car l))) ", "
1329 ,(tmtex (cadr l)))))
1331 (define (tmtex-cite-raw s l)
1332 (tex-apply 'citealp (tmtex-cite-list l)))
1334 (define (tmtex-cite-raw* s l)
1335 (tex-apply 'citealp* (tmtex-cite-list l)))
1337 (define (tmtex-cite-textual s l)
1338 (tex-apply 'citet (tmtex-cite-list l)))
1340 (define (tmtex-cite-textual* s l)
1341 (tex-apply 'citet* (tmtex-cite-list l)))
1343 (define (tmtex-cite-parenthesized s l)
1344 (tex-apply 'citep (tmtex-cite-list l)))
1346 (define (tmtex-cite-parenthesized* s l)
1347 (tex-apply 'citep* (tmtex-cite-list l)))
1349 (define (tmtex-render-cite s l)
1350 (tex-apply 'citetext (tmtex (car l))))
1352 (define (tmtex-cite-author s l)
1353 (tex-apply 'citeauthor (tmtex (car l))))
1355 (define (tmtex-cite-author* s l)
1356 (tex-apply 'citeauthor* (tmtex (car l))))
1358 (define (tmtex-cite-year s l)
1359 (tex-apply 'citeyear (tmtex (car l))))
1361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1362 ;; Glossaries
1363 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1365 (define (tmtex-glossary s l)
1366 (with nr (+ tmtex-auto-produce 1)
1367 (set! tmtex-auto-produce nr)
1368 `(label ,(string-append "autolab" (number->string nr)))))
1370 (define (tmtex-glossary-entry s l)
1371 (with nr (+ tmtex-auto-consume 1)
1372 (with lab (string-append "autolab" (number->string nr))
1373 (set! tmtex-auto-consume nr)
1374 `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab)))))
1376 (define (tmtex-the-glossary s l)
1377 `(!document
1378 (,(if (latex-book-style?) 'chapter* 'section*) "Glossary")
1379 ((!begin "theglossary" ,(car l)) ,(tmtex (cadr l)))))
1381 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1382 ;; The main conversion routines
1383 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1385 (define (tmtex-apply key args)
1386 (let ((n (length args))
1387 (r (drd-ref tmtex-methods% key)))
1388 (if (in? key '(quote quasiquote unquote)) (set! r tmtex-noop))
1389 (if r (r args)
1390 (let ((p (drd-ref tmtex-tmstyle% key)))
1391 (if (and p (or (= (cadr p) -1) (= (cadr p) n)))
1392 ((car p) (symbol->string key) args)
1393 (if (and (= n 1)
1394 (or (func? (car args) 'tformat)
1395 (func? (car args) 'table)))
1396 (tmtex-table-apply key (car args))
1397 (tmtex-function key args)))))))
1399 (define (tmtex-function f l)
1400 (if (== (string-ref (symbol->string f) 0) #\!)
1401 (cons f (map-in-order tmtex l))
1402 (let ((v (tmtex-var-name (symbol->string f))))
1403 (if (== v "") ""
1404 (apply tex-apply
1405 (cons (string->symbol v)
1406 (map-in-order tmtex l)))))))
1408 (define (tmtex-compound l)
1409 (if (string? (car l))
1410 (tmtex-apply (string->symbol (car l)) (cdr l))
1411 ""))
1413 (define (tmtex-list l)
1414 (map-in-order tmtex l))
1416 (tm-define (tmtex x)
1417 (if (string? x) (tmtex-string x)
1418 (tmtex-apply (car x) (cdr x))))
1420 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1421 ;; Dispatching
1422 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1424 (drd-dispatcher tmtex-methods%
1425 ((:or unknown uninit error raw-data) tmtex-noop)
1426 (document tmtex-document)
1427 (para tmtex-para)
1428 (surround tmtex-surround)
1429 (concat tmtex-concat)
1430 (group tmtex-group)
1431 (hidden tmtex-noop)
1432 (hspace tmtex-hspace)
1433 (vspace* tmtex-noop)
1434 (vspace tmtex-vspace)
1435 (space tmtex-space)
1436 (htab tmtex-htab)
1437 (move tmtex-noop)
1438 (resize tmtex-noop)
1439 (repeat tmtex-noop)
1440 (float tmtex-float)
1441 ((:or datoms dlines dpages dbox) tmtex-noop)
1443 (with-limits tmtex-noop)
1444 (line-break tmtex-line-break)
1445 (new-line tmtex-new-line)
1446 (next-line tmtex-next-line)
1447 (no-break tmtex-no-break)
1448 (no-indent tmtex-no-first-indentation)
1449 (yes-indent tmtex-noop)
1450 (no-indent* tmtex-noop)
1451 (yes-indent* tmtex-noop)
1452 (page-break* tmtex-noop)
1453 (page-break tmtex-page-break)
1454 (no-page-break* tmtex-noop)
1455 (no-page-break tmtex-noop)
1456 (new-page* tmtex-noop)
1457 (new-page tmtex-new-page)
1458 (new-dpage* tmtex-noop)
1459 (new-dpage tmtex-noop)
1461 (left tmtex-left)
1462 (mid tmtex-mid)
1463 (right tmtex-right)
1464 (big tmtex-big)
1465 (lprime tmtex-lprime)
1466 (rprime tmtex-rprime)
1467 (below tmtex-below)
1468 (above tmtex-above)
1469 (lsub tmtex-lsub)
1470 (lsup tmtex-lsup)
1471 (rsub tmtex-rsub)
1472 (rsup tmtex-rsup)
1473 (frac tmtex-frac)
1474 (sqrt tmtex-sqrt)
1475 (wide tmtex-wide)
1476 (neg tmtex-neg)
1477 (wide* tmtex-wide-star)
1478 ;;(tree tmtex-tree)
1479 (tree tmtex-tree-eps)
1481 (tformat tmtex-tformat)
1482 ((:or twith cwith tmarker) tmtex-noop)
1483 (table tmtex-table)
1484 ((:or row cell subtable) tmtex-noop)
1486 (assign tmtex-assign)
1487 (with tmtex-with)
1488 (provides tmtex-noop)
1489 (value tmtex-compound)
1490 (quote-value tmtex-noop)
1491 ((:or quote-value drd-props arg quote-arg) tmtex-noop)
1492 (compound tmtex-compound)
1493 ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop)
1494 ;; quote missing
1495 (quasi tmtex-noop)
1496 ;; quasiquote missing
1497 ;; unquote missing
1498 ((:or unquote* copy
1499 if if* case while for-each
1500 extern include use-package) tmtex-noop)
1502 ((:or or xor and not plus minus times over div mod
1503 merge length range number date translate change-case find-file
1504 is-tuple look-up
1505 equal unequal less lesseq greater greatereq) tmtex-noop)
1507 ((:or cm-length mm-length in-length pt-length
1508 bp-length dd-length pc-length cc-length
1509 fs-length fbs-length em-length
1510 ln-length sep-length yfrac-length ex-length
1511 fn-length fns-length bls-length
1512 spc-length xspc-length par-length pag-length
1513 gm-length gh-length) tmtex-noop)
1515 ((:or style-with style-with* style-only style-only*
1516 active active* inactive inactive*
1517 rewrite-inactive inline-tag open-tag middle-tag close-tag
1518 symbol latex hybrid) tmtex-noop)
1520 ((:or tuple attr tmlen collection associate backup) tmtex-noop)
1521 (label tmtex-label)
1522 (reference tmtex-reference)
1523 (pageref tmtex-pageref)
1524 (write tmtex-noop)
1525 (specific tmtex-specific)
1526 ((:or tag meaning flag) tmtex-noop)
1528 ((:or anim-compose anim-repeat anim-constant
1529 anim-translate anim-progressive video sound) tmtex-noop)
1531 (graphics tmtex-graphics)
1532 (superpose tmtex-noop)
1533 ((:or gr-group gr-linear-transform
1534 text-at cline arc carc spline spine* cspline fill) tmtex-noop)
1535 (postscript tmtex-postscript)
1536 ((:or box-info frame-direct frame-inverse) tmtex-noop)
1538 ((:or format line-sep split delay hold release
1539 old-matrix old-table old-mosaic old-mosaic-item
1540 set reset expand expand* hide-expand
1541 apply begin end func env) tmtex-noop)
1543 (shown tmtex-id)
1544 (!file tmtex-file)
1545 (!arg tmtex-tex-arg))
1547 (drd-table tmtex-tmstyle%
1548 ((:or hide-preamble show-preamble) (,tmtex-default -1))
1549 (hide-part (,tmtex-hide-part -1))
1550 (show-part (,tmtex-show-part -1))
1551 (doc-data (,tmtex-doc-data-wrapper -1))
1552 ((:or doc-title doc-author-data doc-date doc-note
1553 doc-keywords doc-AMS-class) (,tmtex-default -1))
1554 ((:or author-name author-address author-note
1555 author-email author-homepage) (,tmtex-default -1))
1556 (abstract (,tmtex-abstract-wrapper 1))
1557 (appendix (,tmtex-appendix 1))
1558 ((:or theorem proposition lemma corollary proof axiom definition
1559 notation conjecture remark note example exercise problem warning
1560 convention quote-env quotation verse)
1561 (,tmtex-std-env 1))
1562 ((:or verbatim code) (,tmtex-verbatim 1))
1563 (center (,tmtex-std-env 1))
1564 (indent (,tmtex-indent 1))
1565 ((:or description description-compact description-aligned
1566 description-dash description-long
1567 itemize itemize-minus itemize-dot itemize-arrow
1568 enumerate enumerate-numeric enumerate-roman enumerate-Roman
1569 enumerate-alpha enumerate-Alpha)
1570 (,tmtex-list-env 1))
1571 (really-tiny (,tmtex-tiny 1))
1572 (very-tiny (,tmtex-tiny 1))
1573 (really-small (,tmtex-scriptsize 1))
1574 (very-small (,tmtex-scriptsize 1))
1575 (smaller (,tmtex-footnotesize 1))
1576 (flat-size (,tmtex-footnotesize 1))
1577 (normal-size (,tmtex-normalsize 1))
1578 (sharp-size (,tmtex-large 1))
1579 (larger (,tmtex-Large 1))
1580 (very-large (,tmtex-LARGE 1))
1581 (really-large (,tmtex-LARGE 1))
1582 (really-huge (,tmtex-Huge 1))
1584 (math (,tmtex-math 1))
1585 ((:or equation equation*) (,tmtex-equation-wrapper 1))
1586 ((:or eqnarray eqnarray* leqnarray*) (,tmtex-eqnarray 1))
1587 (eq-number (,tmtex-default -1))
1588 (the-index (,tmtex-dummy -1))
1589 (glossary (,tmtex-glossary 1))
1590 (glossary-explain (,tmtex-glossary 2))
1591 (glossary-2 (,tmtex-glossary-entry 3))
1592 (the-glossary (,tmtex-the-glossary 2))
1593 ((:or table-of-contents) (,tmtex-toc 2))
1594 (bibliography (,tmtex-bib 4))
1595 (thebibliography (,tmtex-thebibliography 2))
1596 (bib-list (,tmtex-second 2))
1597 (bibitem* (,tmtex-bibitem* -1))
1598 ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2))
1599 (item (,tmtex-item 0))
1600 (item* (,tmtex-item-arg 1))
1601 (render-proof (,tmtex-render-proof 2))
1602 (nbsp (,tmtex-nbsp 0))
1603 (session (,tmtex-session -1))
1604 (input (,tmtex-input 2))
1605 (output (,tmtex-output 1))
1606 (hlink (,tmtex-hlink 2))
1607 (action (,tmtex-action -1))
1608 (href (,tmtex-href 1))
1609 (choose (,tmtex-choose 2))
1610 ((:or strong em tt name samp abbr dfn kbd var acronym person)
1611 (,tmtex-modifier 1))
1612 (menu (,tmtex-menu -1))
1613 (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0))
1614 (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0))
1615 (cite (,tmtex-cite -1))
1616 (nocite (,tmtex-nocite -1))
1617 (cite-detail (,tmtex-cite-detail 2))
1618 (cite-raw (,tmtex-cite-raw -1))
1619 (cite-raw* (,tmtex-cite-raw* -1))
1620 (cite-textual (,tmtex-cite-textual -1))
1621 (cite-textual* (,tmtex-cite-textual* -1))
1622 (cite-parenthesized (,tmtex-cite-parenthesized -1))
1623 (cite-parenthesized* (,tmtex-cite-parenthesized* -1))
1624 (render-cite (,tmtex-render-cite 1))
1625 ((:or cite-author cite-author-link) (,tmtex-cite-author 1))
1626 ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1))
1627 ((:or cite-year cite-year-link) (,tmtex-cite-year 1)))
1629 (drd-group tmtex-protected%
1630 a b c d i j k l o r t u v H L O P S
1631 aa ae bf cr dh dj dp em fi ge gg ht if in it le lg ll lu lq mp mu
1632 ne ng ni nu oe or pi pm rm rq sb sc sf sl sp ss th to tt wd wp wr xi
1633 AA AE DH DJ Im NG OE Pi Pr Re SS TH Xi)
1635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1636 ;; Expansion of all macros which are not recognized by LaTeX
1637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1639 (define tmtex-user-defs-table (make-ahash-table))
1641 (define (user-definition? x)
1642 (and (func? x 'assign 2)
1643 (string? (cadr x))))
1645 (define (collect-user-defs-sub t)
1646 (cond ((npair? t) (noop))
1647 ((user-definition? t)
1648 (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t))
1649 (else (for-each collect-user-defs-sub (cdr t)))))
1651 (define (collect-user-defs t)
1652 (if (== (get-preference "texmacs->latex:expand-user-macros") "on") '()
1653 (begin
1654 (set! tmtex-user-defs-table (make-ahash-table))
1655 (collect-user-defs-sub (cons 'document (tmtex-filter-preamble t)))
1656 (ahash-set->list tmtex-user-defs-table))))
1658 (define (as-string sym)
1659 (with s (symbol->string sym)
1660 (if (string-starts? s "begin-")
1661 (substring s 6 (string-length s))
1662 s)))
1664 (define (drd-first-list name)
1665 (let* ((l1 (query (cons name '('first 'second))))
1666 (l2 (map (cut assoc-ref <> 'first) l1)))
1667 (map as-string l2)))
1669 (define (tmtex-env-macro name)
1670 `(associate ,name (xmacro "x" (eval-args "x"))))
1672 (tm-define (tmtex-env-patch t)
1673 (let* ((l1 (drd-first-list 'tmtex-methods%))
1674 (l2 (drd-first-list 'tmtex-tmstyle%))
1675 (l3 (map as-string (drd-apply-list '(latex-tag%))))
1676 (l4 (map as-string (drd-apply-list '(latex-symbol%))))
1677 (l5 (list-difference l3 l4))
1678 (l6 (map as-string (collect-user-defs (tree->stree t))))
1679 (l7 (list-difference (list-union l2 (list-union l5 l6)) l1)))
1680 `(collection ,@(map tmtex-env-macro l7))))
1682 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1683 ;; Interface
1684 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1686 (define (tmtex-get-style sty)
1687 (cond ((string? sty) (set! sty (list sty)))
1688 ((func? sty 'tuple) (set! sty (cdr sty)))
1689 ((null? sty) (set! sty '("letter"))))
1690 (if (== (car sty) "generic") (set! sty (cons "letter" (cdr sty))))
1691 sty)
1693 (tm-define (texmacs->latex x opts)
1694 ;;(display* "texmacs->latex [" opts "], " x "\n")
1695 (if (tmfile? x)
1696 (let* ((body (tmfile-extract x 'body))
1697 (style (tmtex-get-style (tmfile-extract x 'style)))
1698 (main-style (or (tmtex-transform-style (car style)) "letter"))
1699 (lan (tmfile-init x "language"))
1700 (init (tmfile-extract x 'initial))
1701 (doc (list '!file body style lan init (get-texmacs-path))))
1702 (latex-set-style main-style)
1703 (latex-set-packages '())
1704 (latex-set-language lan)
1705 (set! tmtex-style (car style))
1706 (set! tmtex-packages (cdr style))
1707 (when (elsevier-style?)
1708 (import-from (convert latex tmtex-elsevier)))
1709 (tmtex-style-init body)
1710 (tmtex-set-language lan)
1711 (with result (texmacs->latex doc opts)
1712 (set! tmtex-style "generic")
1713 (set! tmtex-packages '())
1714 (tmtex-set-language "english")
1715 result))
1716 (let* ((x2 (tmtm-eqnumber->nonumber x))
1717 (x3 (tmtm-match-brackets x2)))
1718 (tmtex-initialize opts)
1719 (with r (tmtex (tmpre-produce x3))
1720 (if (not tmtex-use-macros?)
1721 (set! r (latex-expand-macros r)))
1722 (if (not tmtex-use-catcodes?)
1723 (set! r (latex-expand-catcodes r)))
1724 r))))