2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5 ;; DESCRIPTION : conversion of TeXmacs trees into TeX/LaTeX trees
6 ;; COPYRIGHT : (C) 2002 Joris van der Hoeven
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>.
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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))
77 (set! tmtex-auto-produce 0)
78 (set! tmtex-auto-consume 0)
79 (if (== (url-suffix current-save-target) "tex")
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))))
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)))
164 (define (tmtex-env-get var)
165 (let ((val (tmtex-env-list var)))
169 (define (tmtex-env-get-previous var)
170 (let ((val (tmtex-env-list var)))
171 (if (or (null? val) (null? (cdr val))) #f
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)))
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))))
199 ((and (func? (car l) '!sup) (func? (car r) '!sup))
200 (cons (list '!sup (tex-concat (list (cadar l) (cadar r))))
202 (else (cons (car l) r))))))
204 (define (tex-concat-list 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))))
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)))
229 (if (or (tmtex-math-mode?) (drd-in? (car l) tmpre-sectional%)) l
232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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") #\<)
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))))
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")
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)))
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)
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)
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)
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)))
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)
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)
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)
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)
365 (if (not (tmtex-string-break? (car l) (car l)))
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?)
378 (tmtex-text-list l)))
379 (r (tmtex-string-produce t)))
382 (define (tmtex-verb-string s)
383 (let* ((l (string->list s))
384 (t (tmtex-verb-list l))
385 (r (tmtex-string-produce t)))
388 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
405 (define (tmtex-filter-styles 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)
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)
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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))
471 (if (func? y '!document)
476 (cons (tex-concat (list x a)) b) z)))
477 (tex-concat (list x y z)))))
479 (define (tmtex-script? x)
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))
491 (cons* head " " tail)))))
493 (define (tmtex-rewrite-no-break 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"))
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)
564 (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "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)
572 ((tmtex-float-table? l)
573 (tmtex-float-make (tmtex-float-size l) "table" position (cadr 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
585 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
587 (define (tmtex-large-decode s)
588 (cond ((nstring? s) ".")
589 ((in? s '("(" ")" "[" "]" "|" "/" ".")) 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")
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))))
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")
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)
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))))
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))
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)
685 (tmtex-function 'sqrt l)
687 (list '!option (tmtex (cadr l)))
690 (define (tmtex-token? s)
691 (or (= (string-length s) 1)
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)))
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)))
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)
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)))))
721 (display* "TeXmacs] non converted accent below: " acc "\n")
724 (define (tmtex-wide? x)
725 (cond ((func? x 'wide 1) (tmtex-wide? (cadr x)))
727 (else (not (tmtex-token? x)))))
729 (define (tmtex-wide l)
730 (let ((wide (tmtex-wide? (car l)))
731 (arg (tmtex (car 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)))))
760 (display* "TeXmacs] non converted accent: " acc "\n")
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
776 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
778 (define (tmtex-table-rows-assemble tb bb 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)
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)))
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)))
809 (let* ((env (if (tmtex-math-mode?) 'array 'tabular))
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)))
839 ((< x 6.5) 'scriptsize)
840 ((< x 7.5) 'footnotesize)
842 ((< x 11.5) 'normalsize)
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"))
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)))
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)
877 (let ((old (tmtex-env-get-previous "mode")))
878 (cond ((and (== val "text") (!= old "text"))
880 ((and (== val "math") (!= old "math")
881 (ahash-ref tmtex-env :preamble))
882 (list 'ensuremath arg))
883 ((and (== val "math") (!= old "math"))
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))
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)))))
904 (define (tmtex-with 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)))
911 (tmtex-env-set var val)
912 (let ((r (tmtex-with-one var val (tmtex-with next))))
913 (tmtex-env-reset var)
916 (define (tmtex-var-name-sub 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))
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)
936 (define (tmtex-args-search x args)
937 (cond ((null? args) #f)
938 ((== x (car args)) 1)
940 (let ((n (tmtex-args-search x (cdr args))))
941 (if n (+ 1 n) #f)))))
943 (define (tmtex-args-sub l args)
945 (cons (tmtex-args (car l) args)
946 (tmtex-args-sub (cdr l) args))))
948 (define (tmtex-args x args)
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)))
958 (while (func? val 'quote 1) (set! val (cadr val)))
961 (tmtex-env-assign var val)
963 (let ((a (tmtex-get-assign-cmd var val)))
965 (list 'newcommand (string-append "\\" var)
967 ((or (func? val 'macro) (func? val 'func))
968 (if (null? (cddr val))
969 (list 'newcommand (string-append "\\" var)
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)
978 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
980 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
982 (define (tmtex-quote 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)))
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)
1042 ((null? (cdr l)) (list (tmtex (car l))))
1043 (else (cons* (tmtex (car l))
1045 (tmtex-compressed sep (cdr l))))))
1047 (define (tmtex-data-assemble sep l)
1049 ((null? (cdr l)) (car l))
1050 (else (with r (tmtex-data-assemble sep (cdr l))
1051 (cond ((null? (car l)) r)
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) "; "))
1060 (cond ((func? x 'document)
1061 (list (tex-concat* (tmtex-compressed sep (cdr x)))))
1062 (else (list (tmtex x)))))))
1063 (if (null? data) '()
1065 (tmtex-data-assemble ", " (map fun l))))))
1067 (define (tmtex-data-apply tag 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*))
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
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)))
1137 (apply string-append (map-in-order tmtex-tt (cdr x))))
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")
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)
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")
1197 (define (tmtex-math s l)
1198 (tmtex `(with "mode" "math" ,(car l))))
1200 (define (tmtex-dummy s l)
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))))
1237 `(bibitem (!option ,(tmtex (car l))) ,(tmtex (cadr l))))
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)
1255 (define (tmtex-session s l)
1258 (define (tmtex-input s l)
1259 (let ((prompt (car l)) (x (cadr l)))
1262 `(!group (!concat (color "red") (ttfamily ,(tmtex prompt))))
1263 (cond ((func? x 'math 1)
1264 (tmtex-env-set "mode" "math")
1265 (let ((r (tmtex (cadr x))))
1266 (tmtex-env-reset "mode")
1267 `(!math (!group (!concat (color "blue") ,r)))))
1268 (else `(!group (!concat (color "blue")
1269 (!verb ,(tmtex-tt x))))))
1272 (define (tmtex-output s l)
1275 (list '!group (list 'ttfamily (tmtex (car l))))
1278 (define (tmtex-hlink s l)
1279 (list 'href (tmtex (cadr l)) (tmtex (car l))))
1281 (define (tmtex-href s l)
1282 (tmtex-function 'url l))
1284 (define (tmtex-action s l)
1285 (list 'tmaction (tmtex (car l)) (tmtex (cadr l))))
1287 (define (tmtex-choose s l)
1288 (list 'binom (tmtex (car l)) (tmtex (cadr l))))
1290 (define (tmtex-modifier s l)
1291 (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l))))
1293 (define (tmtex-menu-one x)
1294 (tmtex (list 'samp x)))
1296 (define (tmtex-menu-list l)
1298 (cons* (list '!math (list 'rightarrow))
1299 (tmtex-menu-one (car l))
1300 (tmtex-menu-list (cdr l)))))
1302 (define (tmtex-menu s l)
1303 (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l)))))
1305 (define ((tmtex-rename into) s l)
1306 (tmtex-apply into (tmtex-list l)))
1308 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1310 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1312 (define (tmtex-cite-list l)
1313 (cond ((null? l) "")
1314 ((nstring? (car l)) (tmtex-cite-list (cdr l)))
1315 ((null? (cdr l)) (car l))
1316 (else (string-append (car l) "," (tmtex-cite-list (cdr l))))))
1318 (tm-define (tmtex-cite s l)
1319 (tex-apply 'cite (tmtex-cite-list l)))
1321 (tm-define (tmtex-cite s l)
1322 (:mode natbib-package?)
1323 (tex-apply 'citep (tmtex-cite-list l)))
1325 (define (tmtex-nocite s l)
1326 (tex-apply 'nocite (tmtex-cite-list l)))
1328 (tm-define (tmtex-cite-detail s l)
1329 (tex-apply 'cite `(!option ,(tmtex (cadr l))) (tmtex (car l))))
1331 (tm-define (tmtex-cite-detail s l)
1332 (:mode natbib-package?)
1333 (tex-apply 'citetext `(!concat (citealp ,(tmtex (car l))) ", "
1334 ,(tmtex (cadr l)))))
1336 (define (tmtex-cite-raw s l)
1337 (tex-apply 'citealp (tmtex-cite-list l)))
1339 (define (tmtex-cite-raw* s l)
1340 (tex-apply 'citealp* (tmtex-cite-list l)))
1342 (define (tmtex-cite-textual s l)
1343 (tex-apply 'citet (tmtex-cite-list l)))
1345 (define (tmtex-cite-textual* s l)
1346 (tex-apply 'citet* (tmtex-cite-list l)))
1348 (define (tmtex-cite-parenthesized s l)
1349 (tex-apply 'citep (tmtex-cite-list l)))
1351 (define (tmtex-cite-parenthesized* s l)
1352 (tex-apply 'citep* (tmtex-cite-list l)))
1354 (define (tmtex-render-cite s l)
1355 (tex-apply 'citetext (tmtex (car l))))
1357 (define (tmtex-cite-author s l)
1358 (tex-apply 'citeauthor (tmtex (car l))))
1360 (define (tmtex-cite-author* s l)
1361 (tex-apply 'citeauthor* (tmtex (car l))))
1363 (define (tmtex-cite-year s l)
1364 (tex-apply 'citeyear (tmtex (car l))))
1366 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1368 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1370 (define (tmtex-glossary s l)
1371 (with nr (+ tmtex-auto-produce 1)
1372 (set! tmtex-auto-produce nr)
1373 `(label ,(string-append "autolab" (number->string nr)))))
1375 (define (tmtex-glossary-entry s l)
1376 (with nr (+ tmtex-auto-consume 1)
1377 (with lab (string-append "autolab" (number->string nr))
1378 (set! tmtex-auto-consume nr)
1379 `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab)))))
1381 (define (tmtex-the-glossary s l)
1383 (,(if (latex-book-style?) 'chapter* 'section*) "Glossary")
1384 ((!begin "theglossary" ,(car l)) ,(tmtex (cadr l)))))
1386 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1387 ;; The main conversion routines
1388 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1390 (define (tmtex-apply key args)
1391 (let ((n (length args))
1392 (r (drd-ref tmtex-methods% key)))
1393 (if (in? key '(quote quasiquote unquote)) (set! r tmtex-noop))
1395 (let ((p (drd-ref tmtex-tmstyle% key)))
1396 (if (and p (or (= (cadr p) -1) (= (cadr p) n)))
1397 ((car p) (symbol->string key) args)
1399 (or (func? (car args) 'tformat)
1400 (func? (car args) 'table)))
1401 (tmtex-table-apply key (car args))
1402 (tmtex-function key args)))))))
1404 (define (tmtex-function f l)
1405 (if (== (string-ref (symbol->string f) 0) #\!)
1406 (cons f (map-in-order tmtex l))
1407 (let ((v (tmtex-var-name (symbol->string f))))
1410 (cons (string->symbol v)
1411 (map-in-order tmtex l)))))))
1413 (define (tmtex-compound l)
1414 (if (string? (car l))
1415 (tmtex-apply (string->symbol (car l)) (cdr l))
1418 (define (tmtex-list l)
1419 (map-in-order tmtex l))
1421 (tm-define (tmtex x)
1422 (if (string? x) (tmtex-string x)
1423 (tmtex-apply (car x) (cdr x))))
1425 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1427 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1429 (drd-dispatcher tmtex-methods%
1430 ((:or unknown uninit error raw-data) tmtex-noop)
1431 (document tmtex-document)
1433 (surround tmtex-surround)
1434 (concat tmtex-concat)
1437 (hspace tmtex-hspace)
1438 (vspace* tmtex-noop)
1439 (vspace tmtex-vspace)
1446 ((:or datoms dlines dpages dbox) tmtex-noop)
1448 (with-limits tmtex-noop)
1449 (line-break tmtex-line-break)
1450 (new-line tmtex-new-line)
1451 (next-line tmtex-next-line)
1452 (no-break tmtex-no-break)
1453 (no-indent tmtex-no-first-indentation)
1454 (yes-indent tmtex-noop)
1455 (no-indent* tmtex-noop)
1456 (yes-indent* tmtex-noop)
1457 (page-break* tmtex-noop)
1458 (page-break tmtex-page-break)
1459 (no-page-break* tmtex-noop)
1460 (no-page-break tmtex-noop)
1461 (new-page* tmtex-noop)
1462 (new-page tmtex-new-page)
1463 (new-dpage* tmtex-noop)
1464 (new-dpage tmtex-noop)
1470 (lprime tmtex-lprime)
1471 (rprime tmtex-rprime)
1482 (wide* tmtex-wide-star)
1484 (tree tmtex-tree-eps)
1486 (tformat tmtex-tformat)
1487 ((:or twith cwith tmarker) tmtex-noop)
1489 ((:or row cell subtable) tmtex-noop)
1491 (assign tmtex-assign)
1493 (provides tmtex-noop)
1494 (value tmtex-compound)
1495 (quote-value tmtex-noop)
1496 ((:or quote-value drd-props arg quote-arg) tmtex-noop)
1497 (compound tmtex-compound)
1498 ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop)
1501 ;; quasiquote missing
1504 if if* case while for-each
1505 extern include use-package) tmtex-noop)
1507 ((:or or xor and not plus minus times over div mod
1508 merge length range number date translate change-case find-file
1510 equal unequal less lesseq greater greatereq) tmtex-noop)
1512 ((:or cm-length mm-length in-length pt-length
1513 bp-length dd-length pc-length cc-length
1514 fs-length fbs-length em-length
1515 ln-length sep-length yfrac-length ex-length
1516 fn-length fns-length bls-length
1517 spc-length xspc-length par-length pag-length
1518 gm-length gh-length) tmtex-noop)
1520 ((:or style-with style-with* style-only style-only*
1521 active active* inactive inactive*
1522 rewrite-inactive inline-tag open-tag middle-tag close-tag
1523 symbol latex hybrid) tmtex-noop)
1525 ((:or tuple attr tmlen collection associate backup) tmtex-noop)
1527 (reference tmtex-reference)
1528 (pageref tmtex-pageref)
1530 (specific tmtex-specific)
1531 ((:or tag meaning flag) tmtex-noop)
1533 ((:or anim-compose anim-repeat anim-constant
1534 anim-translate anim-progressive video sound) tmtex-noop)
1536 (graphics tmtex-graphics)
1537 (superpose tmtex-noop)
1538 ((:or gr-group gr-linear-transform
1539 text-at cline arc carc spline spine* cspline fill) tmtex-noop)
1540 (postscript tmtex-postscript)
1541 ((:or box-info frame-direct frame-inverse) tmtex-noop)
1543 ((:or format line-sep split delay hold release
1544 old-matrix old-table old-mosaic old-mosaic-item
1545 set reset expand expand* hide-expand
1546 apply begin end func env) tmtex-noop)
1550 (!arg tmtex-tex-arg))
1552 (drd-table tmtex-tmstyle%
1553 ((:or hide-preamble show-preamble) (,tmtex-default -1))
1554 (hide-part (,tmtex-hide-part -1))
1555 (show-part (,tmtex-show-part -1))
1556 (doc-data (,tmtex-doc-data-wrapper -1))
1557 ((:or doc-title doc-author-data doc-date doc-note
1558 doc-keywords doc-AMS-class) (,tmtex-default -1))
1559 ((:or author-name author-address author-note
1560 author-email author-homepage) (,tmtex-default -1))
1561 (abstract (,tmtex-abstract-wrapper 1))
1562 (appendix (,tmtex-appendix 1))
1563 ((:or theorem proposition lemma corollary proof axiom definition
1564 notation conjecture remark note example exercise problem warning
1565 convention quote-env quotation verse)
1567 ((:or verbatim code) (,tmtex-verbatim 1))
1568 (center (,tmtex-std-env 1))
1569 (indent (,tmtex-indent 1))
1570 ((:or description description-compact description-aligned
1571 description-dash description-long
1572 itemize itemize-minus itemize-dot itemize-arrow
1573 enumerate enumerate-numeric enumerate-roman enumerate-Roman
1574 enumerate-alpha enumerate-Alpha)
1575 (,tmtex-list-env 1))
1576 (really-tiny (,tmtex-tiny 1))
1577 (very-tiny (,tmtex-tiny 1))
1578 (really-small (,tmtex-scriptsize 1))
1579 (very-small (,tmtex-scriptsize 1))
1580 (smaller (,tmtex-footnotesize 1))
1581 (flat-size (,tmtex-footnotesize 1))
1582 (normal-size (,tmtex-normalsize 1))
1583 (sharp-size (,tmtex-large 1))
1584 (larger (,tmtex-Large 1))
1585 (very-large (,tmtex-LARGE 1))
1586 (really-large (,tmtex-LARGE 1))
1587 (really-huge (,tmtex-Huge 1))
1589 (math (,tmtex-math 1))
1590 ((:or equation equation*) (,tmtex-equation-wrapper 1))
1591 ((:or eqnarray eqnarray* leqnarray*) (,tmtex-eqnarray 1))
1592 (eq-number (,tmtex-default -1))
1593 (the-index (,tmtex-dummy -1))
1594 (glossary (,tmtex-glossary 1))
1595 (glossary-explain (,tmtex-glossary 2))
1596 (glossary-2 (,tmtex-glossary-entry 3))
1597 (the-glossary (,tmtex-the-glossary 2))
1598 ((:or table-of-contents) (,tmtex-toc 2))
1599 (bibliography (,tmtex-bib 4))
1600 (thebibliography (,tmtex-thebibliography 2))
1601 (bib-list (,tmtex-second 2))
1602 (bibitem* (,tmtex-bibitem* -1))
1603 ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2))
1604 (item (,tmtex-item 0))
1605 (item* (,tmtex-item-arg 1))
1606 (render-proof (,tmtex-render-proof 2))
1607 (nbsp (,tmtex-nbsp 0))
1608 (session (,tmtex-session -1))
1609 (input (,tmtex-input 2))
1610 (output (,tmtex-output 1))
1611 (hlink (,tmtex-hlink 2))
1612 (action (,tmtex-action -1))
1613 (href (,tmtex-href 1))
1614 (choose (,tmtex-choose 2))
1615 ((:or strong em tt name samp abbr dfn kbd var acronym person)
1616 (,tmtex-modifier 1))
1617 (menu (,tmtex-menu -1))
1618 (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0))
1619 (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0))
1620 (cite (,tmtex-cite -1))
1621 (nocite (,tmtex-nocite -1))
1622 (cite-detail (,tmtex-cite-detail 2))
1623 (cite-raw (,tmtex-cite-raw -1))
1624 (cite-raw* (,tmtex-cite-raw* -1))
1625 (cite-textual (,tmtex-cite-textual -1))
1626 (cite-textual* (,tmtex-cite-textual* -1))
1627 (cite-parenthesized (,tmtex-cite-parenthesized -1))
1628 (cite-parenthesized* (,tmtex-cite-parenthesized* -1))
1629 (render-cite (,tmtex-render-cite 1))
1630 ((:or cite-author cite-author-link) (,tmtex-cite-author 1))
1631 ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1))
1632 ((:or cite-year cite-year-link) (,tmtex-cite-year 1)))
1634 (drd-group tmtex-protected%
1635 a b c d i j k l o r t u v H L O P S
1636 aa ae bf cr dh dj dp em fi ge gg ht if in it le lg ll lu lq mp mu
1637 ne ng ni nu oe or pi pm rm rq sb sc sf sl sp ss th to tt wd wp wr xi
1638 AA AE DH DJ Im NG OE Pi Pr Re SS TH Xi)
1640 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1641 ;; Expansion of all macros which are not recognized by LaTeX
1642 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1644 (define tmtex-user-defs-table (make-ahash-table))
1646 (define (user-definition? x)
1647 (and (func? x 'assign 2)
1648 (string? (cadr x))))
1650 (define (collect-user-defs-sub t)
1651 (cond ((npair? t) (noop))
1652 ((user-definition? t)
1653 (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t))
1654 (else (for-each collect-user-defs-sub (cdr t)))))
1656 (define (collect-user-defs t)
1657 (if (== (get-preference "texmacs->latex:expand-user-macros") "on") '()
1659 (set! tmtex-user-defs-table (make-ahash-table))
1660 (collect-user-defs-sub (cons 'document (tmtex-filter-preamble t)))
1661 (ahash-set->list tmtex-user-defs-table))))
1663 (define (as-string sym)
1664 (with s (symbol->string sym)
1665 (if (string-starts? s "begin-")
1666 (substring s 6 (string-length s))
1669 (define (drd-first-list name)
1670 (let* ((l1 (query (cons name '('first 'second))))
1671 (l2 (map (cut assoc-ref <> 'first) l1)))
1672 (map as-string l2)))
1674 (define (tmtex-env-macro name)
1675 `(associate ,name (xmacro "x" (eval-args "x"))))
1677 (tm-define (tmtex-env-patch t)
1678 (let* ((l1 (drd-first-list 'tmtex-methods%))
1679 (l2 (drd-first-list 'tmtex-tmstyle%))
1680 (l3 (map as-string (drd-apply-list '(latex-tag%))))
1681 (l4 (map as-string (drd-apply-list '(latex-symbol%))))
1682 (l5 (list-difference l3 l4))
1683 (l6 (map as-string (collect-user-defs (tree->stree t))))
1684 (l7 (list-difference (list-union l2 (list-union l5 l6)) l1)))
1685 `(collection ,@(map tmtex-env-macro l7))))
1687 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1689 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1691 (define (tmtex-get-style sty)
1692 (cond ((string? sty) (set! sty (list sty)))
1693 ((func? sty 'tuple) (set! sty (cdr sty)))
1694 ((null? sty) (set! sty '("letter"))))
1695 (if (== (car sty) "generic") (set! sty (cons "letter" (cdr sty))))
1698 (tm-define (texmacs->latex x opts)
1699 ;;(display* "texmacs->latex [" opts "], " x "\n")
1701 (let* ((body (tmfile-extract x 'body))
1702 (style (tmtex-get-style (tmfile-extract x 'style)))
1703 (main-style (or (tmtex-transform-style (car style)) "letter"))
1704 (lan (tmfile-init x "language"))
1705 (init (tmfile-extract x 'initial))
1706 (doc (list '!file body style lan init (get-texmacs-path))))
1707 (latex-set-style main-style)
1708 (latex-set-packages '())
1709 (latex-set-language lan)
1710 (set! tmtex-style (car style))
1711 (set! tmtex-packages (cdr style))
1712 (when (elsevier-style?)
1713 (import-from (convert latex tmtex-elsevier)))
1714 (tmtex-style-init body)
1715 (tmtex-set-language lan)
1716 (with result (texmacs->latex doc opts)
1717 (set! tmtex-style "generic")
1718 (set! tmtex-packages '())
1719 (tmtex-set-language "english")
1721 (let* ((x2 (tmtm-eqnumber->nonumber x))
1722 (x3 (tmtm-match-brackets x2)))
1723 (tmtex-initialize opts)
1724 (with r (tmtex (tmpre-produce x3))
1725 (if (not tmtex-use-macros?)
1726 (set! r (latex-expand-macros r)))
1727 (if (not tmtex-use-catcodes?)
1728 (set! r (latex-expand-catcodes r)))