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