diff --git a/TeXmacs/plugins/latex/progs/convert/latex/tmtex.scm b/TeXmacs/plugins/latex/progs/convert/latex/tmtex.scm index 8bb76792fe..ddbe9a0898 100644 --- a/TeXmacs/plugins/latex/progs/convert/latex/tmtex.scm +++ b/TeXmacs/plugins/latex/progs/convert/latex/tmtex.scm @@ -13,14 +13,15 @@ (texmacs-module (convert latex tmtex) (:use (convert tools tmpre) - (convert tools old-tmtable) - (convert tools tmlength) - (convert rewrite tmtm-brackets) - (convert latex texout) - (doc tmdoc-markup) - (convert latex latex-tools))) + (convert tools old-tmtable) + (convert tools tmlength) + (convert rewrite tmtm-brackets) + (convert latex texout) + (doc tmdoc-markup) + (convert latex latex-tools) + ) ;:use +) ;texmacs-module -;(use-modules (ice-9 format)) (tm-define tmtex-debug-mode? #f) @@ -31,96 +32,174 @@ (tm-define tmtex-style "generic") (tm-define tmtex-packages '()) (tm-define tmtex-replace-style? #t) + (define tmtex-languages '()) + (define tmtex-colors '()) + (define tmtex-colormaps '()) + (define tmtex-env (make-ahash-table)) + (define tmtex-macros (make-ahash-table)) + (define tmtex-dynamic (make-ahash-table)) + (define tmtex-serial 0) + (define tmtex-ref-cnt 1) + (define tmtex-auto-produce 0) + (define tmtex-auto-consume 0) + (define tmtex-image-root-url (unix->url "image")) + (define tmtex-image-root-string "image") + (define tmtex-appendices? #f) + (define tmtex-indirect-bib? #f) + (define tmtex-mathjax? #f) +(define tmtex-image-progress 0) + +(define tmtex-image-total 0) + +(define (tmtex-count-images t) + (cond ((null? t) 0) + ((npair? t) 0) + ((in? (car t) + '(image graphics + draw-over + draw-under + para + table + tformat + equation + equation* + eqnarray + eqnarray* + section + subsection + subsubsection) + ) ;in? + 1 + ) ; + (else (let loop + ((lst t) (sum 0)) + (if (null? lst) + sum + (if (pair? lst) + (loop (cdr lst) (+ sum (tmtex-count-images (car lst)))) + (+ sum (tmtex-count-images lst)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond +) ;define + +(define (tmtex-image-increment) + (set! tmtex-image-progress (+ tmtex-image-progress 1)) + (when (and (qt-gui?) (> tmtex-image-total 0)) + (latex-progress-update tmtex-image-progress) + ) ;when +) ;define + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Style ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (texmacs-modes ;;; Elsevier styles - (elsevier-style% (in? tmtex-style '("elsart" "jsc" "elsarticle" - "ifac"))) - (jsc-style% (in? tmtex-style '("jsc")) elsevier-style%) - (elsarticle-style% (in? tmtex-style '("elsarticle")) elsevier-style%) - (elsart-style% (in? tmtex-style '("elsart")) elsevier-style%) - (ifac-style% (in? tmtex-style '("ifac")) elsevier-style%) + (elsevier-style% (in? tmtex-style '("elsart" "jsc" "elsarticle" "ifac"))) + (jsc-style% (in? tmtex-style '("jsc")) elsevier-style%) + (elsarticle-style% (in? tmtex-style '("elsarticle")) elsevier-style%) + (elsart-style% (in? tmtex-style '("elsart")) elsevier-style%) + (ifac-style% (in? tmtex-style '("ifac")) elsevier-style%) ;;; ACM styles - (acm-style% (in? tmtex-style '("acmconf" "sig-alternate" - "acm_proc_article-sp" - "acmsmall" "acmlarge" "acmtog" - "sigconf" "sigchi" "sigplan" - "acmart"))) - (acm-art-style% (in? tmtex-style '("acmsmall" "acmlarge" "acmtog" - "sigconf" "sigchi" "sigplan" - "acmart")) acm-style%) + (acm-style% (in? tmtex-style + '("acmconf" + "sig-alternate" + "acm_proc_article-sp" + "acmsmall" + "acmlarge" + "acmtog" + "sigconf" + "sigchi" + "sigplan" + "acmart") + ) ;in? + ) ;acm-style% + (acm-art-style% (in? tmtex-style + '("acmsmall" + "acmlarge" + "acmtog" + "sigconf" + "sigchi" + "sigplan" + "acmart") + ) ;in? + acm-style% + ) ;acm-art-style% (sig-alternate-style% (in? tmtex-style '("sig-alternate")) acm-style%) - (acm-conf-style% (in? tmtex-style '("acmconf" "sig-alternate" - "acm_proc_article-sp")) acm-style%) - (acm-small-style% (in? tmtex-style '("acmsmall")) acm-art-style%) - (acm-large-style% (in? tmtex-style '("acmlarge")) acm-art-style%) - (acm-tog-style% (in? tmtex-style '("acmtog")) acm-art-style%) - (acm-sigconf-style% (in? tmtex-style '("sigconf")) acm-art-style%) - (acm-sigchi-style% (in? tmtex-style '("sigchi")) acm-art-style%) - (acm-sigplan-style% (in? tmtex-style '("sigplan")) acm-art-style%) + (acm-conf-style% (in? tmtex-style '("acmconf" + "sig-alternate" + "acm_proc_article-sp")) + acm-style% + ) ;acm-conf-style% + (acm-small-style% (in? tmtex-style '("acmsmall")) acm-art-style%) + (acm-large-style% (in? tmtex-style '("acmlarge")) acm-art-style%) + (acm-tog-style% (in? tmtex-style '("acmtog")) acm-art-style%) + (acm-sigconf-style% (in? tmtex-style '("sigconf")) acm-art-style%) + (acm-sigchi-style% (in? tmtex-style '("sigchi")) acm-art-style%) + (acm-sigplan-style% (in? tmtex-style '("sigplan")) acm-art-style%) ;; AMS styles - (ams-style% (in? tmtex-style '("amsart"))) + (ams-style% (in? tmtex-style '("amsart"))) ;; Revtex styles - (revtex-style% (in? tmtex-style '("aip" "aps"))) - (aip-style% (in? tmtex-style '("aip")) revtex-style%) - (aps-style% (in? tmtex-style '("aps")) revtex-style%) - (sv-style% (in? tmtex-style '("svjour" "svjour3" - "llncs" "svmono"))) + (revtex-style% (in? tmtex-style '("aip" "aps"))) + (aip-style% (in? tmtex-style '("aip")) revtex-style%) + (aps-style% (in? tmtex-style '("aps")) revtex-style%) + (sv-style% (in? tmtex-style '("svjour" "svjour3" "llncs" "svmono"))) ;; Springer styles - (springer-style% (in? tmtex-style '("svjour" "svjour3" - "llncs" sv-style%))) - (svjour-style% (in? tmtex-style '("svjour" - "svjour3")) springer-style%) - (llncs-style% (in? tmtex-style '("llncs")) springer-style%) - (svmono-style% (in? tmtex-style '("svmono")) sv-style%) + (springer-style% (in? tmtex-style '("svjour" "svjour3" "llncs" sv-style%))) + (svjour-style% (in? tmtex-style '("svjour" "svjour3")) springer-style%) + (llncs-style% (in? tmtex-style '("llncs")) springer-style%) + (svmono-style% (in? tmtex-style '("svmono")) sv-style%) ;; IEEE styles - (ieee-style% (in? tmtex-style '("ieeeconf" "ieeetran"))) - (ieee-conf-style% (in? tmtex-style '("ieeeconf")) ieee-style%) - (ieee-tran-style% (in? tmtex-style '("ieeetran")) ieee-style%) + (ieee-style% (in? tmtex-style '("ieeeconf" "ieeetran"))) + (ieee-conf-style% (in? tmtex-style '("ieeeconf")) ieee-style%) + (ieee-tran-style% (in? tmtex-style '("ieeetran")) ieee-style%) ;; Other styles - (beamer-style% (in? tmtex-style '("beamer" "old-beamer"))) - (natbib-package% (in? "cite-author-year" tmtex-packages))) + (beamer-style% (in? tmtex-style '("beamer" "old-beamer"))) + (natbib-package% (in? "cite-author-year" tmtex-packages)) +) ;texmacs-modes -(tm-define (tmtex-style-init body) - (noop)) +(tm-define (tmtex-style-init body) (noop)) (tm-define (tmtex-style-preprocess doc) doc) (define (import-tmtex-styles) (cond ((elsevier-style?) (import-from (convert latex tmtex-elsevier))) - ((acm-style?) (import-from (convert latex tmtex-acm))) - ((ams-style?) (import-from (convert latex tmtex-ams))) - ((revtex-style?) (import-from (convert latex tmtex-revtex))) - ((ieee-style?) (import-from (convert latex tmtex-ieee))) - ((beamer-style?) (import-from (convert latex tmtex-beamer))) + ((acm-style?) (import-from (convert latex tmtex-acm))) + ((ams-style?) (import-from (convert latex tmtex-ams))) + ((revtex-style?) (import-from (convert latex tmtex-revtex))) + ((ieee-style?) (import-from (convert latex tmtex-ieee))) + ((beamer-style?) (import-from (convert latex tmtex-beamer))) ((or (springer-style?) (svmono-style?)) - (import-from (convert latex tmtex-springer))) - (else (noop)))) + (import-from (convert latex tmtex-springer)) + ) ; + (else (noop)) + ) ;cond +) ;define (tm-define (tmtex-provided-packages) '()) @@ -129,6 +208,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-initialize opts) + (set! tmtex-image-progress 0) (set! tmtex-ref-cnt 1) (set! tmtex-env (make-ahash-table)) (set! tmtex-macros (make-ahash-table)) @@ -138,114 +218,157 @@ (set! tmtex-auto-consume 0) (set! tmtex-mathjax? #f) (if (== (url-suffix current-save-target) "tex") - (begin - (set! tmtex-image-root-url (url-unglue current-save-target 4)) - (with suf (url-suffix tmtex-image-root-url) - (when (!= suf "") - (set! tmtex-image-root-url - (url-unglue tmtex-image-root-url - (+ (string-length suf) 1))))) - (set! tmtex-image-root-string - (url->unix (url-tail tmtex-image-root-url)))) - (begin - (set! tmtex-image-root-url (unix->url "image")) - (set! tmtex-image-root-string "image"))) + (begin + (set! tmtex-image-root-url (url-unglue current-save-target 4)) + (with suf + (url-suffix tmtex-image-root-url) + (when (!= suf "") + (set! tmtex-image-root-url + (url-unglue tmtex-image-root-url (+ (string-length suf) 1)) + ) ;set! + ) ;when + ) ;with + (set! tmtex-image-root-string (url->unix (url-tail tmtex-image-root-url))) + ) ;begin + (begin + (set! tmtex-image-root-url (unix->url "image")) + (set! tmtex-image-root-string "image") + ) ;begin + ) ;if (set! tmtex-appendices? #f) (set! tmtex-replace-style? - (== (assoc-ref opts "texmacs->latex:replace-style") "on")) + (== (assoc-ref opts "texmacs->latex:replace-style") "on") + ) ;set! (set! tmtex-indirect-bib? - (== (assoc-ref opts "texmacs->latex:indirect-bib") "on")) - (set! tmtex-use-macros? - (== (assoc-ref opts "texmacs->latex:use-macros") "on")) + (== (assoc-ref opts "texmacs->latex:indirect-bib") "on") + ) ;set! + (set! tmtex-use-macros? (== (assoc-ref opts "texmacs->latex:use-macros") "on")) (when (== (assoc-ref opts "texmacs->latex:mathjax") "on") (tmtex-env-set "mode" "math") - (set! tmtex-mathjax? #t)) - (with charset (assoc-ref opts "texmacs->latex:encoding") + (set! tmtex-mathjax? #t) + ) ;when + (with charset + (assoc-ref opts "texmacs->latex:encoding") (if tmtex-cjk-document? (set! charset "utf-8")) (cond ((== charset "utf-8") (set! tmtex-use-catcodes? #f) - (set! tmtex-use-ascii? #f) - (set! tmtex-use-unicode? #t)) + (set! tmtex-use-ascii? #f) + (set! tmtex-use-unicode? #t) + ) ; ((== charset "cork") (set! tmtex-use-catcodes? #t) - (set! tmtex-use-ascii? #f) - (set! tmtex-use-unicode? #f)) + (set! tmtex-use-ascii? #f) + (set! tmtex-use-unicode? #f) + ) ; ((== charset "ascii") (set! tmtex-use-catcodes? #f) - (set! tmtex-use-ascii? #t) - (set! tmtex-use-unicode? #f))))) + (set! tmtex-use-ascii? #t) + (set! tmtex-use-unicode? #f) + ) ; + ) ;cond + ) ;with +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Determination of the mode in which commands are used ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define command-text-uses (make-ahash-table)) + (define command-math-uses (make-ahash-table)) (define (compute-mode-stats t mode) (when (tree-compound? t) - (let* ((h (if (== mode (tree "math")) - command-math-uses - command-text-uses)) - (n (or (ahash-ref h (tree-label t)) 0))) + (let* ((h (if (== mode (tree "math")) command-math-uses command-text-uses)) + (n (or (ahash-ref h (tree-label t)) 0)) + ) ; (ahash-set! h (tree-label t) (+ n 1)) (for-each (lambda (i) - (with nmode (tree-child-env t i "mode" mode) - (compute-mode-stats (tree-ref t i) nmode))) - (.. 0 (tree-arity t)))))) + (with nmode + (tree-child-env t i "mode" mode) + (compute-mode-stats (tree-ref t i) nmode) + ) ;with + ) ;lambda + (.. 0 (tree-arity t)) + ) ;for-each + ) ;let* + ) ;when +) ;define (define (init-mode-stats t) (set! command-text-uses (make-ahash-table)) (set! command-math-uses (make-ahash-table)) - (compute-mode-stats (tm->tree t) "text")) + (compute-mode-stats (tm->tree t) "text") +) ;define (define (mode-protect t) - (cond ((and (pair? t) (symbol? (car t)) - (string-starts? (symbol->string (car t)) "tmtext")) - `(text ,t)) - ((and (pair? t) (symbol? (car t)) - (or (string-starts? (symbol->string (car t)) "tmmath") - (string-starts? (symbol->string (car t)) "math"))) - `(ensuremath ,t)) - ((func? t '!concat) - `(!concat ,@(map mode-protect (cdr t)))) - (else t))) + (cond ((and (pair? t) + (symbol? (car t)) + (string-starts? (symbol->string (car t)) "tmtext") + ) ;and + `(text ,t) + ) ; + ((and (pair? t) + (symbol? (car t)) + (or (string-starts? (symbol->string (car t)) "tmmath") + (string-starts? (symbol->string (car t)) "math") + ) ;or + ) ;and + `(ensuremath ,t) + ) ; + ((func? t '!concat) `(!concat ,@(map mode-protect (cdr t)))) + (else t) + ) ;cond +) ;define (define (tmtex-pre t) - (cond ((tm-func? t 'para) - (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) + (cond ((tm-func? t 'para) (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) ((tm-func? t 'concat) - (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) - ((tm-func? t 'mtm 2) - `(mtm ,(cadr t) ,(tmtex-pre (caddr t)))) + (cons '!paragraph (map-in-order tmtex-pre (tm-children t))) + ) ; + ((tm-func? t 'mtm 2) `(mtm ,(cadr t) ,(tmtex-pre (caddr t)))) ((and (tm-func? t 'assign 2) (tm-atomic? (tm-ref t 0))) (let* ((name (tm-ref t 0)) (tag (string->symbol name)) (tnr (or (ahash-ref command-text-uses tag) 0)) - (mnr (or (ahash-ref command-math-uses tag) 0))) - ;;(display* tag ", " tnr ", " mnr "\n") + (mnr (or (ahash-ref command-math-uses tag) 0)) + ) ; + ;; (display* tag ", " tnr ", " mnr "\n") (cond ((and (string-ends? name "*") - (or (string-starts? name "itemize") - (string-starts? name "enumerate") - (string-starts? name "description"))) - "") + (or (string-starts? name "itemize") + (string-starts? name "enumerate") + (string-starts? name "description") + ) ;or + ) ;and + "" + ) ; ((>= tnr mnr) - (with r (tmtex t) - ;;(display* t " -> " r "\n") + (with r + (tmtex t) + ;; (display* t " -> " r "\n") (when (and (> mnr 0) (func? r 'newcommand 2)) - (with val (mode-protect (caddr r)) - (set! r (list (car r) (cadr r) val)))) - r)) - (else - (tmtex-env-set "mode" "math") - (with r (tmtex t) + (with val (mode-protect (caddr r)) (set! r (list (car r) (cadr r) val))) + ) ;when + r + ) ;with + ) ; + (else (tmtex-env-set "mode" "math") + (with r + (tmtex t) (tmtex-env-reset "mode") - ;;(display* t " -> " r "\n") + ;; (display* t " -> " r "\n") (when (and (> tnr 0) (func? r 'newcommand 2)) - (with val (mode-protect (caddr r)) - (set! r (list (car r) (cadr r) val)))) - r))))) - (else (tmtex t)))) + (with val (mode-protect (caddr r)) (set! r (list (car r) (cadr r) val))) + ) ;when + r + ) ;with + ) ;else + ) ;cond + ) ;let* + ) ; + (else (tmtex t)) + ) ;cond +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Data @@ -265,74 +388,78 @@ (choice ((left\{) "l" (right.) #f)) (tabbed ("" "l" "" #f)) (tabbed* ("" "l" "" #f)) - (rcl-table ("{\\setlength\\arraylinesep{0.4em}\\everymath={\\displaystyle}" - "rcl" "}" #f))) + (rcl-table ("{\\setlength\\arraylinesep{0.4em}\\everymath={\\displaystyle}" "rcl" "}" #f) + ) ;rcl-table +) ;logic-table (logic-table tex-with-cmd% - (("font-family" "rm") textrm) - (("font-family" "ss") textsf) - (("font-family" "tt") texttt) - (("font-series" "medium") textmd) - (("font-series" "bold") textbf) - (("font-shape" "right") textup) - (("font-shape" "slanted") textsl) - (("font-shape" "italic") textit) - (("font-shape" "small-caps") textsc) - (("par-columns" "2") (!begin "multicols" "2")) - (("par-columns" "3") (!begin "multicols" "3")) - (("par-mode" "center") (!begin "center")) - (("par-mode" "left") (!begin "flushleft")) - (("par-mode" "right") (!begin "flushright"))) + (("font-family" "rm") textrm) + (("font-family" "ss") textsf) + (("font-family" "tt") texttt) + (("font-series" "medium") textmd) + (("font-series" "bold") textbf) + (("font-shape" "right") textup) + (("font-shape" "slanted") textsl) + (("font-shape" "italic") textit) + (("font-shape" "small-caps") textsc) + (("par-columns" "2") (!begin "multicols" "2")) + (("par-columns" "3") (!begin "multicols" "3")) + (("par-mode" "center") (!begin "center")) + (("par-mode" "left") (!begin "flushleft")) + (("par-mode" "right") (!begin "flushright")) +) ;logic-table (logic-table tex-with-cmd-math% - (("font" "cal") mathcal) - (("font" "cal*") mathscr) - (("font" "cal**") EuScript) - (("font" "Euler") mathfrak) - (("font" "Bbb") mathbb) - (("font" "Bbb*") mathbbm) - (("font" "Bbb**") mathbbmss) - (("font" "Bbb***") mathbb) - (("font" "Bbb****") mathds) - (("font-family" "rm") mathrm) - (("font-family" "ss") mathsf) - (("font-family" "tt") mathtt) - (("font-series" "medium") tmmathmd) - (("font-series" "bold") tmmathbf) - (("font-shape" "right") mathrm) - (("font-shape" "slanted") mathit) - (("font-shape" "italic") mathit) - (("font-shape" "small-caps") mathrm) - (("math-font" "cal") mathcal) - (("math-font" "cal*") mathscr) - (("math-font" "cal**") EuScript) - (("math-font" "Euler") mathfrak) - (("math-font" "Bbb") mathbb) - (("math-font" "Bbb*") mathbbm) - (("math-font" "Bbb**") mathbbmss) - (("math-font" "Bbb***") mathbb) - (("math-font" "Bbb****") mathds) - (("math-font-family" "mr") mathrm) - (("math-font-family" "ms") mathsf) - (("math-font-family" "mt") mathtt) - (("math-font-family" "normal") mathnormal) - (("math-font-family" "rm") mathrm) - (("math-font-family" "ss") mathsf) - (("math-font-family" "tt") mathtt) - (("math-font-family" "bf") mathbf) - (("math-font-family" "it") mathit) - (("math-font-series" "bold") tmmathbf)) + (("font" "cal") mathcal) + (("font" "cal*") mathscr) + (("font" "cal**") EuScript) + (("font" "Euler") mathfrak) + (("font" "Bbb") mathbb) + (("font" "Bbb*") mathbbm) + (("font" "Bbb**") mathbbmss) + (("font" "Bbb***") mathbb) + (("font" "Bbb****") mathds) + (("font-family" "rm") mathrm) + (("font-family" "ss") mathsf) + (("font-family" "tt") mathtt) + (("font-series" "medium") tmmathmd) + (("font-series" "bold") tmmathbf) + (("font-shape" "right") mathrm) + (("font-shape" "slanted") mathit) + (("font-shape" "italic") mathit) + (("font-shape" "small-caps") mathrm) + (("math-font" "cal") mathcal) + (("math-font" "cal*") mathscr) + (("math-font" "cal**") EuScript) + (("math-font" "Euler") mathfrak) + (("math-font" "Bbb") mathbb) + (("math-font" "Bbb*") mathbbm) + (("math-font" "Bbb**") mathbbmss) + (("math-font" "Bbb***") mathbb) + (("math-font" "Bbb****") mathds) + (("math-font-family" "mr") mathrm) + (("math-font-family" "ms") mathsf) + (("math-font-family" "mt") mathtt) + (("math-font-family" "normal") mathnormal) + (("math-font-family" "rm") mathrm) + (("math-font-family" "ss") mathsf) + (("math-font-family" "tt") mathtt) + (("math-font-family" "bf") mathbf) + (("math-font-family" "it") mathit) + (("math-font-series" "bold") tmmathbf) +) ;logic-table (logic-table tex-assign-cmd% - (("font-family" "rm") rmfamily) - (("font-family" "ss") ssfamily) - (("font-family" "tt") ttfamily) - (("font-series" "medium") mdseries) - (("font-series" "bold") bfseries) - (("font-shape" "right") upshape) - (("font-shape" "slanted") slshape) - (("font-shape" "italic") itshape) - (("font-shape" "small-caps") scshape)) + (("font-family" "rm") rmfamily) + (("font-family" "ss") ssfamily) + (("font-family" "tt") ttfamily) + (("font-series" "medium") mdseries) + (("font-series" "bold") bfseries) + (("font-shape" "right") upshape) + (("font-shape" "slanted") slshape) + (("font-shape" "italic") itshape) + (("font-shape" "small-caps") scshape) +) ;logic-table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Manipulation of the environment @@ -340,31 +467,40 @@ (define (tmtex-env-list var) (let ((r (ahash-ref tmtex-env var))) - (if r r '()))) + (if r r '()) + ) ;let +) ;define (define (tmtex-env-get var) (let ((val (tmtex-env-list var))) - (and (pair? val) (car val)))) + (and (pair? val) (car val)) + ) ;let +) ;define (define (tmtex-env-get-previous var) (let ((val (tmtex-env-list var))) - (if (or (null? val) (null? (cdr val))) #f - (cadr val)))) + (if (or (null? val) (null? (cdr val))) #f (cadr val)) + ) ;let +) ;define (define (tmtex-math-mode?) - (== (tmtex-env-get "mode") "math")) + (== (tmtex-env-get "mode") "math") +) ;define (tm-define (tmtex-env-set var val) - (ahash-set! tmtex-env var (cons val (tmtex-env-list var)))) + (ahash-set! tmtex-env var (cons val (tmtex-env-list var))) +) ;tm-define (tm-define (tmtex-env-reset var) (let ((val (tmtex-env-list var))) - (if (nnull? val) - (ahash-set! tmtex-env var (cdr val))))) + (if (nnull? val) (ahash-set! tmtex-env var (cdr val))) + ) ;let +) ;tm-define (tm-define (tmtex-env-assign var val) (tmtex-env-reset var) - (tmtex-env-set var val)) + (tmtex-env-set var val) +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Frequently used TeX construction subroutines @@ -372,59 +508,72 @@ (tm-define (tmtex-concat-sep l) (set! l (list-intersperse l '(!concat (tmsep) " "))) - (if (null? l) '() `((!concat ,@l)))) + (if (null? l) '() `((!concat ,@l))) +) ;tm-define (tm-define (tmtex-concat-Sep l) (set! l (list-intersperse l '(!concat (tmSep) " "))) - (if (null? l) '() `((!concat ,@l)))) + (if (null? l) '() `((!concat ,@l))) +) ;tm-define (define (tex-concat-similar l) (cond ((or (null? l) (null? (cdr l))) l) ((> (length l) 1000) - (let* ((s (quotient (length l) 2)) - (h (list-head l s)) - (t (list-tail l s))) - (tex-concat-similar `((!concat ,@h) (!concat ,@t))))) - (else - (let ((r (tex-concat-similar (cdr l)))) - (cond ((and (func? (car l) '!sub) (func? (car r) '!sub)) - (cons (list '!sub (tex-concat (list (cadar l) (cadar r)))) - (cdr r))) - ((and (func? (car l) '!sup) (func? (car r) '!sup)) - (cons (list '!sup (tex-concat (list (cadar l) (cadar r)))) - (cdr r))) - (else (cons (car l) r))))))) + (let* ((s (quotient (length l) 2)) (h (list-head l s)) (t (list-tail l s))) + (tex-concat-similar `((!concat ,@h) (!concat ,@t))) + ) ;let* + ) ; + (else (let ((r (tex-concat-similar (cdr l)))) + (cond ((and (func? (car l) '!sub) (func? (car r) '!sub)) + (cons (list '!sub (tex-concat (list (cadar l) (cadar r)))) (cdr r)) + ) ; + ((and (func? (car l) '!sup) (func? (car r) '!sup)) + (cons (list '!sup (tex-concat (list (cadar l) (cadar r)))) (cdr r)) + ) ; + (else (cons (car l) r)) + ) ;cond + ) ;let + ) ;else + ) ;cond +) ;define (define (tex-concat-list l) (cond ((null? l) l) ((== (car l) "") (tex-concat-list (cdr l))) ((func? (car l) '!concat) (append (cdar l) (tex-concat-list (cdr l)))) - (else (cons (car l) (tex-concat-list (cdr l)))))) + (else (cons (car l) (tex-concat-list (cdr l)))) + ) ;cond +) ;define (tm-define (tex-concat l) (:synopsis "Horizontal concatenation of list of LaTeX expressions") (let ((r (tex-concat-similar (tex-concat-list l)))) - (if (null? r) "" - (if (null? (cdr r)) (car r) - (cons '!concat r))))) + (if (null? r) "" (if (null? (cdr r)) (car r) (cons '!concat r))) + ) ;let +) ;tm-define (define (tex-concat-strings l) (cond ((< (length l) 2) l) ((and (string? (car l)) (string? (cadr l))) - (tex-concat-strings (cons (string-append (car l) (cadr l)) (cddr l)))) - (else (cons (car l) (tex-concat-strings (cdr l)))))) + (tex-concat-strings (cons (string-append (car l) (cadr l)) (cddr l))) + ) ; + (else (cons (car l) (tex-concat-strings (cdr l)))) + ) ;cond +) ;define (tm-define (tex-concat* l) (:synopsis "Variant of tex-concat which concatenates adjacent strings") - (tex-concat (tex-concat-strings l))) + (tex-concat (tex-concat-strings l)) +) ;tm-define (tm-define (tex-apply . l) - (if (or (tmtex-math-mode?) (logic-in? (car l) tmpre-sectional%)) l - (list '!group l))) + (if (or (tmtex-math-mode?) (logic-in? (car l) tmpre-sectional%)) + l + (list '!group l) + ) ;if +) ;tm-define -(tm-define (tex-math-apply . l) - (if (tmtex-math-mode?) l - (list 'ensuremath l))) +(tm-define (tex-math-apply . l) (if (tmtex-math-mode?) l (list 'ensuremath l))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Strings @@ -432,544 +581,757 @@ (define (string-starts? s r) (and (>= (string-length s) (string-length r)) - (== (substring s 0 (string-length r)) r))) + (== (substring s 0 (string-length r)) r) + ) ;and +) ;define (define (tmtex-modified-token op s i) (tex-math-apply op (if (= (string-length s) (+ i 1)) - (substring s i (string-length s)) - (tex-apply (string->symbol (substring s i (string-length s))))))) + (substring s i (string-length s)) + (tex-apply (string->symbol (substring s i (string-length s)))) + ) ;if + ) ;tex-math-apply +) ;define (logic-table latex-special-symbols% - ("less" #\<) - ("gtr" #\>) - ("box" (Box)) - ("over" #\:) - ("||" (|)) ;; | - ("precdot" (tmprecdot))) + ("less" #\<) + ("gtr" #\>) + ("box" (Box)) + ("over" #\:) + ("||" (|)) + ;; | + ("precdot" (tmprecdot)) +) ;logic-table (logic-table latex-text-symbols% - ("#20AC" euro) - ("cent" textcent) - ("circledR" textregistered) - ("copyright" textcopyright) - ("currency" textcurrency) - ("degree" textdegree) - ("textdegree" textdegree) - ("mu" textmu) - ("onehalf" textonehalf) - ("onequarter" textonequarter) - ("onesuperior" textonesuperior) - ("paragraph" P) - ("threequarters" textthreequarters) - ("threesuperior" textthreesuperior) - ("trademark" texttrademark) - ("twosuperior" texttwosuperior) - ("yen" textyen)) + ("#20AC" euro) + ("cent" textcent) + ("circledR" textregistered) + ("copyright" textcopyright) + ("currency" textcurrency) + ("degree" textdegree) + ("textdegree" textdegree) + ("mu" textmu) + ("onehalf" textonehalf) + ("onequarter" textonequarter) + ("onesuperior" textonesuperior) + ("paragraph" P) + ("threequarters" textthreequarters) + ("threesuperior" textthreesuperior) + ("trademark" texttrademark) + ("twosuperior" texttwosuperior) + ("yen" textyen) +) ;logic-table (tm-define (tmtex-token-sub s group?) - (cond ((logic-ref latex-special-symbols% s) - (logic-ref latex-special-symbols% s)) + (cond ((logic-ref latex-special-symbols% s) (logic-ref latex-special-symbols% s)) ((string-starts? s "up-") (tmtex-modified-token 'mathrm s 3)) - ;;((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4)) + ;; ((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4)) ((and (string-starts? s "bbb-") - (>= (string-length s) 5) - (string-number? (substring s 4 5))) - (tmtex-modified-token 'mathbbm s 4)) + (>= (string-length s) 5) + (string-number? (substring s 4 5)) + ) ;and + (tmtex-modified-token 'mathbbm s 4) + ) ; ((string-starts? s "bbb-") (tmtex-modified-token 'mathbb s 4)) ((string-starts? s "cal-") (tmtex-modified-token 'mathcal s 4)) - ((and (string-starts? s "cal*-") - (>= (string-length s) 6)) - (tmtex-modified-token 'mathscr s 5)) - ((and (string-starts? s "cal**-") - (>= (string-length s) 7)) - (tmtex-modified-token 'EuScript s 6)) + ((and (string-starts? s "cal*-") (>= (string-length s) 6)) + (tmtex-modified-token 'mathscr s 5) + ) ; + ((and (string-starts? s "cal**-") (>= (string-length s) 7)) + (tmtex-modified-token 'EuScript s 6) + ) ; ((string-starts? s "frak-") (tmtex-modified-token 'mathfrak s 5)) ((string-starts? s "b-cal-") - (tex-math-apply 'tmmathbf (tmtex-modified-token 'mathcal s 6))) + (tex-math-apply 'tmmathbf (tmtex-modified-token 'mathcal s 6)) + ) ; ((string-starts? s "b-up-") (tmtex-modified-token 'mathbf s 5)) ((string-starts? s "b-") (tmtex-modified-token 'tmmathbf s 2)) ((and (not (tmtex-math-mode?)) (logic-ref latex-text-symbols% s)) - (list '!group (list (logic-ref latex-text-symbols% s)))) + (list '!group (list (logic-ref latex-text-symbols% s))) + ) ; ((and (string-starts? s "#") (not tmtex-use-catcodes?)) - (let* ((qs (string-append "<" s ">")) - (cv (string-convert qs "Cork" "UTF-8"))) - (list '!widechar (string->symbol cv)))) + (let* ((qs (string-append "<" s ">")) (cv (string-convert qs "Cork" "UTF-8"))) + (list '!widechar (string->symbol cv)) + ) ;let* + ) ; ((and (string-starts? s "#") tmtex-use-catcodes?) (let* ((qs (string-append "<" s ">")) (us (string-convert qs "Cork" "UTF-8")) - (cv (string-convert us "UTF-8" "LaTeX"))) - (list '!widechar (string->symbol cv)))) - (else (let* ((s2 (string-replace s "-" "")) - (ss (list (string->symbol s2)))) + (cv (string-convert us "UTF-8" "LaTeX")) + ) ; + (list '!widechar (string->symbol cv)) + ) ;let* + ) ; + (else (let* ((s2 (string-replace s "-" "")) (ss (list (string->symbol s2)))) (cond ((logic-in? (car ss) tmtex-protected-symbol%) - (with sy (string->symbol (string-append "tmx" s2)) - (list '!symbol (list sy)))) + (with sy (string->symbol (string-append "tmx" s2)) (list '!symbol (list sy))) + ) ; ((not (logic-in? (car ss) latex-symbol%)) (display* "TeXmacs] non converted symbol: " s "\n") - (list '!symbol (list 'nonconverted s2))) + (list '!symbol (list 'nonconverted s2)) + ) ; (group? (list '!group ss)) - (else (list '!symbol ss))))))) + (else (list '!symbol ss)) + ) ;cond + ) ;let* + ) ;else + ) ;cond +) ;tm-define (define (tmtex-token l routine group?) - (receive (p1 p2) (list-break (cdr l) (lambda (x) (== x #\>))) - (let* ((s (list->string p1)) - (q (if (null? p2) '() (cdr p2))) - (r (routine q))) - (cons (tmtex-token-sub s group?) r)))) + (receive (p1 p2) + (list-break (cdr l) (lambda (x) (== x #\>))) + (let* ((s (list->string p1)) (q (if (null? p2) '() (cdr p2))) (r (routine q))) + (cons (tmtex-token-sub s group?) r) + ) ;let* + ) ;receive +) ;define (define (tmtex-text-sub head l) (if (string? head) (append (string->list head) (tmtex-text-list (cdr l))) - (append (list head) (tmtex-text-list (cdr l))))) + (append (list head) (tmtex-text-list (cdr l))) + ) ;if +) ;define (define (tmtex-special-char? c) - (string-index "#$%&_{}" c)) + (string-index "#$%&_{}" c) +) ;define (define (tmtex-break-char? c) - (string-index "+ -:=,?;()[]{}<>/" c)) + (string-index "+ -:=,?;()[]{}<>/" c) +) ;define (define (tmtex-text-list-space l) (cond ((null? l) l) ((== (car l) #\space) - (cons (list (string->symbol " ")) (tmtex-text-list-space (cdr l)))) - (else (tmtex-text-list l)))) + (cons (list (string->symbol " ")) (tmtex-text-list-space (cdr l))) + ) ; + (else (tmtex-text-list l)) + ) ;cond +) ;define (define (tmtex-text-list l) - (if (null? l) l - (let ((c (car l))) - (cond ((== c #\<) (tmtex-token l tmtex-text-list #t)) - ((== c #\space) (cons c (tmtex-text-list-space (cdr l)))) - ((tmtex-special-char? c) - (cons (list (string->symbol (char->string c))) - (tmtex-text-list (cdr l)))) - ((== c #\~) (tmtex-text-sub "\\~{}" l)) - ((== c #\^) (tmtex-text-sub "\\^{}" l)) - ((== c #\\) (tmtex-text-sub '(textbackslash) l)) - ((== c #\`) (tmtex-text-sub "`" l)) - ((== c #\x00) (tmtex-text-sub "\\`{}" l)) - ((== c #\x01) (tmtex-text-sub "\\'{}" l)) - ((== c #\x04) (tmtex-text-sub "\\\"{}" l)) - ((== c #\x05) (tmtex-text-sub "\\H{}" l)) - ((== c #\x06) (tmtex-text-sub "\\r{}" l)) - ((== c #\x07) (tmtex-text-sub "\\v{}" l)) - ((== c #\x08) (tmtex-text-sub "\\u{}" l)) - ((== c #\x09) (tmtex-text-sub "\\={}" l)) - ((== c #\x0A) (tmtex-text-sub "\\.{}" l)) - ((== c #\x0E) (tmtex-text-sub "\\k{}" l)) - ((== c #\x10) (tmtex-text-sub "``" l)) - ((== c #\x11) (tmtex-text-sub "''" l)) - ((== c #\x12) (tmtex-text-sub ",," l)) - ((== c #\x15) (tmtex-text-sub "--" l)) - ((== c #\x16) (tmtex-text-sub "---" l)) - ((== c #\x17) (tmtex-text-sub "{}" l)) - ((== c #\x1B) (tmtex-text-sub "ff" l)) - ((== c #\x1C) (tmtex-text-sub '(textbackslash) l)) - ((== c #\x1D) (tmtex-text-sub "fl" l)) - ((== c #\x1E) (tmtex-text-sub "ffi" l)) - ((== c #\x1F) (tmtex-text-sub "ffl" l)) - ((== c #\|) (tmtex-text-sub '(textbar) l)) - (else - (append - (if (or tmtex-use-unicode? tmtex-use-ascii?) - (string->list (string-convert (char->string c) - "Cork" "UTF-8")) - (list c)) - (tmtex-text-list (cdr l)))))))) + (if (null? l) + l + (let ((c (car l))) + (cond ((== c #\<) (tmtex-token l tmtex-text-list #t)) + ((== c #\space) (cons c (tmtex-text-list-space (cdr l)))) + ((tmtex-special-char? c) + (cons (list (string->symbol (char->string c))) (tmtex-text-list (cdr l))) + ) ; + ((== c #\~) (tmtex-text-sub "\\~{}" l)) + ((== c #\^) (tmtex-text-sub "\\^{}" l)) + ((== c #\\) (tmtex-text-sub '(textbackslash) l)) + ((== c #\`) (tmtex-text-sub "`" l)) + ((== c #\x00) (tmtex-text-sub "\\`{}" l)) + ((== c #\x01) (tmtex-text-sub "\\'{}" l)) + ((== c #\x04) (tmtex-text-sub "\\\"{}" l)) + ((== c #\x05) (tmtex-text-sub "\\H{}" l)) + ((== c #\x06) (tmtex-text-sub "\\r{}" l)) + ((== c #\x07) (tmtex-text-sub "\\v{}" l)) + ((== c #\x08) (tmtex-text-sub "\\u{}" l)) + ((== c #\x09) (tmtex-text-sub "\\={}" l)) + ((== c #\x0A) (tmtex-text-sub "\\.{}" l)) + ((== c #\x0E) (tmtex-text-sub "\\k{}" l)) + ((== c #\x10) (tmtex-text-sub "``" l)) + ((== c #\x11) (tmtex-text-sub "''" l)) + ((== c #\x12) (tmtex-text-sub ",," l)) + ((== c #\x15) (tmtex-text-sub "--" l)) + ((== c #\x16) (tmtex-text-sub "---" l)) + ((== c #\x17) (tmtex-text-sub "{}" l)) + ((== c #\x1B) (tmtex-text-sub "ff" l)) + ((== c #\x1C) (tmtex-text-sub '(textbackslash) l)) + ((== c #\x1D) (tmtex-text-sub "fl" l)) + ((== c #\x1E) (tmtex-text-sub "ffi" l)) + ((== c #\x1F) (tmtex-text-sub "ffl" l)) + ((== c #\|) (tmtex-text-sub '(textbar) l)) + (else (append (if (or tmtex-use-unicode? tmtex-use-ascii?) + (string->list (string-convert (char->string c) "Cork" "UTF-8")) + (list c) + ) ;if + (tmtex-text-list (cdr l)) + ) ;append + ) ;else + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-math-operator l) - (receive (p q) (list-break l (lambda (c) (not (char-alphabetic? c)))) - (let* ((op (tmtex-textual (list->string p))) - (tail (tmtex-math-list q))) + (receive (p q) + (list-break l (lambda (c) (not (char-alphabetic? c)))) + (let* ((op (tmtex-textual (list->string p))) (tail (tmtex-math-list q))) (if (logic-in? (string->symbol op) latex-operator%) - (cons (list '!symbol (tex-apply (string->symbol op))) tail) - (cons (post-process-math-text (tex-apply 'tmop op)) tail))))) + (cons (list '!symbol (tex-apply (string->symbol op))) tail) + (cons (post-process-math-text (tex-apply 'tmop op)) tail) + ) ;if + ) ;let* + ) ;receive +) ;define (define (tmtex-math-list l) - (if (null? l) l - (let ((c (car l))) - (cond ((== c #\<) (tmtex-token l tmtex-math-list #f)) - ((tmtex-special-char? c) - (cons (list (string->symbol (char->string c))) - (tmtex-math-list (cdr l)))) - ((== c #\~) (tmtex-math-list (cdr l))) - ((== c #\^) (tmtex-math-list (cdr l))) - ((== c #\\) - (cons (list 'backslash) (tmtex-math-list (cdr l)))) -;; ((== c #\*) (cons '(*) (tmtex-math-list (cdr l)))) - ((== c #\*) (tmtex-math-list (cdr l))) - ((== c #\') (append (list '(prime)) (tmtex-math-list (cdr l)))) - ((== c #\`) (append (list '(backprime)) (tmtex-math-list (cdr l)))) -;; ((== c #\space) (tmtex-math-list (cdr l))) - ((and (char-alphabetic? c) - (nnull? (cdr l)) - (char-alphabetic? (cadr l))) - (tmtex-math-operator l)) - (else - (with c - (if (or tmtex-use-unicode? tmtex-use-ascii?) - (string->list (string-convert (char->string c) - "Cork" "UTF-8")) - (list c)) - (append c (tmtex-math-list (cdr l))))))))) + (if (null? l) + l + (let ((c (car l))) + (cond ((== c #\<) (tmtex-token l tmtex-math-list #f)) + ((tmtex-special-char? c) + (cons (list (string->symbol (char->string c))) (tmtex-math-list (cdr l))) + ) ; + ((== c #\~) (tmtex-math-list (cdr l))) + ((== c #\^) (tmtex-math-list (cdr l))) + ((== c #\\) (cons (list 'backslash) (tmtex-math-list (cdr l)))) + ;; ((== c #\*) (cons '(*) (tmtex-math-list (cdr l)))) + ((== c #\*) (tmtex-math-list (cdr l))) + ((== c #\') (append (list '(prime)) (tmtex-math-list (cdr l)))) + ((== c #\`) (append (list '(backprime)) (tmtex-math-list (cdr l)))) + ;; ((== c #\space) (tmtex-math-list (cdr l))) + ((and (char-alphabetic? c) (nnull? (cdr l)) (char-alphabetic? (cadr l))) + (tmtex-math-operator l) + ) ; + (else (with c + (if (or tmtex-use-unicode? tmtex-use-ascii?) + (string->list (string-convert (char->string c) "Cork" "UTF-8")) + (list c) + ) ;if + (append c (tmtex-math-list (cdr l))) + ) ;with + ) ;else + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-verb-list l) - (if (null? l) l - (let ((c (car l))) - (if (== c #\<) - (let ((r (tmtex-token l tmtex-verb-list #t))) - (if (char? (car r)) r (cdr r))) - (cons c (tmtex-verb-list (cdr l))))))) + (if (null? l) + l + (let ((c (car l))) + (if (== c #\<) + (let ((r (tmtex-token l tmtex-verb-list #t))) + (if (char? (car r)) r (cdr r)) + ) ;let + (cons c (tmtex-verb-list (cdr l))) + ) ;if + ) ;let + ) ;if +) ;define (define (tmtex-string-break? x start) (or (not (char? x)) - (and (tmtex-math-mode?) - (or (tmtex-break-char? x) - (and (char-alphabetic? x) (char-numeric? start)) - (and (char-alphabetic? start) (char-numeric? x)))))) + (and (tmtex-math-mode?) + (or (tmtex-break-char? x) + (and (char-alphabetic? x) (char-numeric? start)) + (and (char-alphabetic? start) (char-numeric? x)) + ) ;or + ) ;and + ) ;or +) ;define (define (tmtex-string-produce l) - (if (null? l) l - (if (not (tmtex-string-break? (car l) (car l))) - (receive (p q) - (list-break l (lambda (x) (tmtex-string-break? x (car l)))) - (cons (list->string p) (tmtex-string-produce q))) - (if (equal? (car l) #\space) - (tmtex-string-produce (cdr l)) - (cons (if (char? (car l)) (char->string (car l)) (car l)) - (tmtex-string-produce (cdr l))))))) + (if (null? l) + l + (if (not (tmtex-string-break? (car l) (car l))) + (receive (p q) + (list-break l (lambda (x) (tmtex-string-break? x (car l)))) + (cons (list->string p) (tmtex-string-produce q)) + ) ;receive + (if (equal? (car l) #\space) + (tmtex-string-produce (cdr l)) + (cons (if (char? (car l)) (char->string (car l)) (car l)) + (tmtex-string-produce (cdr l)) + ) ;cons + ) ;if + ) ;if + ) ;if +) ;define (define (tmtex-string s) (if (> (string-length s) 1000) `(!concat ,@(map tmtex (tmstring-split s))) (let* ((l (string->list s)) - (t (if (tmtex-math-mode?) - (tmtex-math-list l) - (tmtex-text-list l))) - (r (tmtex-string-produce t))) - (tex-concat r)))) + (t (if (tmtex-math-mode?) (tmtex-math-list l) (tmtex-text-list l))) + (r (tmtex-string-produce t)) + ) ; + (tex-concat r) + ) ;let* + ) ;if +) ;define (define (string-convert* what from to) - (with c (string->list what) + (with c + (string->list what) (apply string-append - (map (lambda (x) (string-convert (char->string x) from to)) c)))) + (map (lambda (x) (string-convert (char->string x) from to)) c) + ) ;apply + ) ;with +) ;define (define (tmtex-verb-string s) (when (nstring? s) - (set! s (texmacs->verbatim (tm->tree s)))) - (let* ((l (string->list s)) - (t (tmtex-verb-list l)) - (r (tmtex-string-produce t))) + (set! s (texmacs->verbatim (tm->tree s))) + ) ;when + (let* ((l (string->list s)) (t (tmtex-verb-list l)) (r (tmtex-string-produce t))) (if (or tmtex-use-unicode? tmtex-use-ascii?) - (set! r (map (lambda (x) (string-convert* x "Cork" "UTF-8")) r)) - (set! r (map unescape-angles r))) - (tex-concat r))) + (set! r (map (lambda (x) (string-convert* x "Cork" "UTF-8")) r)) + (set! r (map unescape-angles r)) + ) ;if + (tex-concat r) + ) ;let* +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Entire files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (tm-define (tmtex-transform-style x) - (cond ((in? x '("generic" "exam" - "old-generic" "old-article" - "tmarticle" "tmdoc" "mmxdoc")) "article") - ((in? x '("book" "old-book" "tmbook" "tmmanual")) "book") - ((in? x '("letter" "old-letter")) "letter") - ((in? x '("beamer" "old-beamer")) "beamer") - ((in? x '("seminar" "old-seminar")) "slides") + (cond ((in? x + '("generic" + "exam" + "old-generic" + "old-article" + "tmarticle" + "tmdoc" + "mmxdoc") + ) ;in? + "article" + ) ; + ((in? x '("book" "old-book" "tmbook" "tmmanual")) "book") + ((in? x '("letter" "old-letter")) "letter") + ((in? x '("beamer" "old-beamer")) "beamer") + ((in? x '("seminar" "old-seminar")) "slides") ((not tmtex-replace-style?) x) - (else #f))) + (else #f) + ) ;cond +) ;tm-define (define (tmtex-filter-styles l) - (if (null? l) l - (let* ((next (tmtex-transform-style (car l))) - (tail (tmtex-filter-styles (cdr l)))) - (if next (cons next tail) tail)))) + (if (null? l) + l + (let* ((next (tmtex-transform-style (car l))) (tail (tmtex-filter-styles (cdr l)))) + (if next (cons next tail) tail) + ) ;let* + ) ;if +) ;define (define (macro-definition? x) - (and (func? x 'assign 2) - (string? (cadr x)) - (func? (caddr x) 'macro))) + (and (func? x 'assign 2) (string? (cadr x)) (func? (caddr x) 'macro)) +) ;define (define (tmtex-filter-style-macro t) - (letrec ((ndef-style? (lambda (x env) (or (not (macro-definition? x)) - (nin? (cadr x) env)))) - (filter-style-macro - (lambda (t env) - (cond ((nlist? t) t) - (else (map (cut filter-style-macro <> env) - (filter (cut ndef-style? <> env) t))))))) - (with env (append (logic-first-list 'tmtex-methods%) - (logic-first-list 'tmtex-tmstyle%)) - (filter-style-macro t env)))) + (letrec ((ndef-style? (lambda (x env) (or (not (macro-definition? x)) (nin? (cadr x) env))) + ) ;ndef-style? + (filter-style-macro (lambda (t env) + (cond ((nlist? t) t) + (else (map (cut filter-style-macro <> env) (filter (cut ndef-style? <> env) t))) + ) ;cond + ) ;lambda + ) ;filter-style-macro + ) ; + (with env + (append (logic-first-list 'tmtex-methods%) (logic-first-list 'tmtex-tmstyle%)) + (filter-style-macro t env) + ) ;with + ) ;letrec +) ;define (define (comment-preamble t) (cond ((string? t) `(!comment ,t)) - ((or (func? t 'para) - (func? t 'concat) - (func? t 'document)) (map comment-preamble t)) - (else t))) + ((or (func? t 'para) (func? t 'concat) (func? t 'document)) + (map comment-preamble t) + ) ; + (else t) + ) ;cond +) ;define (define (tmtex-filter-preamble l) (cond ((or (nlist? l) (null? l)) '()) ((macro-definition? l) (list l)) - ((and (func? l 'hide-preamble 1) - (list>0? (cadr l))) (map comment-preamble (cdadr l))) - (else (append-map tmtex-filter-preamble (cdr l))))) + ((and (func? l 'hide-preamble 1) (list>0? (cadr l))) + (map comment-preamble (cdadr l)) + ) ; + (else (append-map tmtex-filter-preamble (cdr l))) + ) ;cond +) ;define (define (tmtex-non-preamble-statement? l) (cond ((or (nlist? l) (null? l)) #t) ((== (car l) 'assign) #f) ((== (car l) 'hide-preamble) #f) ((func? l 'mtm 2) (tmtex-non-preamble-statement? (caddr l))) - (else #t))) + (else #t) + ) ;cond +) ;define (define (tmtex-filter-body l) (cond ((or (nlist? l) (null? l)) l) ((== (car l) 'assign) "") ((== (car l) 'hide-preamble) "") ((in? (car l) '(concat document)) - (with a (list-filter (cdr l) tmtex-non-preamble-statement?) + (with a + (list-filter (cdr l) tmtex-non-preamble-statement?) (if (null? a) - (if (== (car l) 'concat) "" '(document "")) - (cons (car l) (map tmtex-filter-body a))))) - (else (cons (car l) (map tmtex-filter-body (cdr l)))))) + (if (== (car l) 'concat) "" '(document "")) + (cons (car l) (map tmtex-filter-body a)) + ) ;if + ) ;with + ) ; + (else (cons (car l) (map tmtex-filter-body (cdr l)))) + ) ;cond +) ;define (define (tmtex-filter-duplicates* l t) (cond ((null? l) l) ((func? (car l) 'assign 2) (let* ((var (cadr (car l))) (r (tmtex-filter-duplicates* (cdr l) t)) - (dup? (ahash-ref t var))) + (dup? (ahash-ref t var)) + ) ; (ahash-set! t var #t) - (if dup? r (cons (car l) r)))) - ((or (func? (car l) 'concat) - (func? (car l) 'para) - (func? (car l) 'document)) - (with r (tmtex-filter-duplicates* (cdr l) t) - (cons (cons (caar l) (tmtex-filter-duplicates* (cdar l) t)) r))) - (else (cons (car l) (tmtex-filter-duplicates* (cdr l) t))))) + (if dup? r (cons (car l) r)) + ) ;let* + ) ; + ((or (func? (car l) 'concat) (func? (car l) 'para) (func? (car l) 'document)) + (with r + (tmtex-filter-duplicates* (cdr l) t) + (cons (cons (caar l) (tmtex-filter-duplicates* (cdar l) t)) r) + ) ;with + ) ; + (else (cons (car l) (tmtex-filter-duplicates* (cdr l) t))) + ) ;cond +) ;define (define (tmtex-filter-duplicates l) - (with t (make-ahash-table) - (tmtex-filter-duplicates* l t))) + (with t (make-ahash-table) (tmtex-filter-duplicates* l t)) +) ;define (define (tmtex-apply-init body init) - ;;(display* "init= " init "\n") + ;; (display* "init= " init "\n") (cond ((== (assoc-ref init "language") "verbatim") - (with init* (assoc-remove! init "language") - (tmtex-apply-init `(verbatim ,body) init*))) - (else body))) + (with init* + (assoc-remove! init "language") + (tmtex-apply-init `(verbatim ,body) init*) + ) ;with + ) ; + (else body) + ) ;cond +) ;define (define (tmtex-clean-body b) - (when (and (func? b '!document) - (> (length b) 1) - (== (cadr b) `(!document ""))) - (set! b (cons (car b) (cddr b)))) - b) + (when (and (func? b '!document) (> (length b) 1) (== (cadr b) '(!document ""))) + (set! b (cons (car b) (cddr b))) + ) ;when + b +) ;define (define (tmtex-file l) (let* ((doc (car l)) (styles (cadr l)) (init* (cadddr l)) (init (or (and (!= init* "#f") init*) '(collection))) - (init-bis (if (list>1? init) - (map (lambda (x) (cons (cadr x) (caddr x))) (cdr init)) - '())) + (init-bis (if (list>1? init) (map (lambda (x) (cons (cadr x) (caddr x))) (cdr init)) '()) + ) ;init-bis (att (or (cadddr (cdr l)) '())) (doc-pre (tmtex-filter-preamble (tmtex-filter-style-macro doc))) (doc-preamble (tmtex-filter-duplicates doc-pre)) (doc-body-pre (tmtex-filter-body doc)) - (doc-body (tmtex-apply-init doc-body-pre init-bis))) + (doc-body (tmtex-apply-init doc-body-pre init-bis)) + ) ; (init-mode-stats doc-body-pre) (latex-set-texmacs-style (if (pair? styles) (car styles) "none")) (latex-set-texmacs-packages (if (pair? styles) (cdr styles) (list))) (if (== (get-preference "texmacs->latex:expand-user-macros") "on") - (set! doc-preamble '())) - (if (null? styles) (tmtex doc) + (set! doc-preamble '()) + ) ;if + (if (null? styles) + (tmtex doc) (let* ((styles* (tmtex-filter-styles styles)) - (styles** (if (and (== styles* (list "article")) - (in? `(associate "par-columns" "2") init)) - (list `("twocolumn" "article")) - styles*)) - (preamble* (ahash-with tmtex-env :preamble #t - (map-in-order tmtex-pre doc-preamble))) + (styles** (if (and (== styles* (list "article")) (in? '(associate "par-columns" + "2") init)) + (list '("twocolumn" "article")) + styles* + ) ;if + ) ;styles** + (preamble* (ahash-with tmtex-env :preamble #t (map-in-order tmtex-pre doc-preamble)) + ) ;preamble* (body* (tmtex-postprocess-body (tmtex doc-body))) (body** (tmtex-clean-body body*)) - (needs (list tmtex-languages tmtex-colors tmtex-colormaps))) - (list '!file body** styles** needs init preamble*))))) + (needs (list tmtex-languages tmtex-colors tmtex-colormaps)) + ) ; + (list '!file body** styles** needs init preamble*) + ) ;let* + ) ;if + ) ;let* +) ;define (define (convert-charset t) (cond ((string? t) (unescape-angles (utf8->cork t))) - ((list>0? t) `(,(car t) ,@(map convert-charset (cdr t)))))) + ((list>0? t) `(,(car t) ,@(map convert-charset (cdr t)))) + ) ;cond +) ;define (define (tmtex-ilx l) - `(!invariant ,(car l))) + `(!invariant ,(car l)) +) ;define (define (tmtex-mtm l) (cond ((null? l) "") ((null? (cdr l)) (tmtex (car l))) - (else - (with lab (car l) - (when (func? lab 'mtm 1) (set! lab (cadr lab))) - `(!concat (!marker btm ,lab) - ,(tmtex (cadr l)) - (!marker etm ,lab)))))) + (else (with lab + (car l) + (when (func? lab 'mtm 1) + (set! lab (cadr lab)) + ) ;when + `(!concat (!marker btm ,lab) + ,(tmtex (cadr l)) + (!marker etm ,lab)) + ) ;with + ) ;else + ) ;cond +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Simple text ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (tmtex-noop . l) "") -(define (tmtex-default s l) (cons (string->symbol s) (tmtex-list l))) -(define (tmtex-id l) (tmtex (car l))) -(define (tmtex-first l) (tmtex (car l))) -(define (tmtex-style-first s l) (tmtex (car l))) -(define (tmtex-second l) (tmtex (cadr l))) -(define (tmtex-style-second s l) (tmtex (cadr l))) -(define (tmtex-hide-part s l) "") -(define (tmtex-show-part s l) (tmtex (cadr l))) +(define (tmtex-noop . l) + "" +) ;define + +(define (tmtex-default s l) + (cons (string->symbol s) (tmtex-list l)) +) ;define + +(define (tmtex-id l) + (tmtex (car l)) +) ;define + +(define (tmtex-first l) + (tmtex (car l)) +) ;define + +(define (tmtex-style-first s l) + (tmtex (car l)) +) ;define + +(define (tmtex-second l) + (tmtex (cadr l)) +) ;define + +(define (tmtex-style-second s l) + (tmtex (cadr l)) +) ;define + +(define (tmtex-hide-part s l) + "" +) ;define + +(define (tmtex-show-part s l) + (tmtex (cadr l)) +) ;define (define (tmtex-error l) (display* "TeXmacs] error in conversion: " l "\n") - (if tmtex-debug-mode? "(error)" "")) + (if tmtex-debug-mode? "(error)" "") +) ;define (define (tmtex-line-note l) `(tmlinenote ,(tmtex (car l)) - ,(tmtex-decode-length (cadr l)) - ,(tmtex-decode-length (caddr l)))) + ,(tmtex-decode-length (cadr l)) + ,(tmtex-decode-length (caddr l))) +) ;define (define (tmtex-marginal-left-note l) - `(marginpar (!option ,(tmtex (cAr l))) ,(tmtex '()))) + `(marginpar (!option ,(tmtex (cAr l))) ,(tmtex '())) +) ;define (define (tmtex-marginal-right-note l) - `(marginpar (!option "") ,(tmtex (cAr l)))) + `(marginpar (!option "") ,(tmtex (cAr l))) +) ;define (define (tmtex-marginal-note l) (cond ((== (car l) "left") (tmtex-marginal-left-note (cdr l))) ((== (car l) "right") (tmtex-marginal-right-note (cdr l))) - (else `(marginpar ,(tmtex (cAr l)))))) + (else `(marginpar ,(tmtex (cAr l)))) + ) ;cond +) ;define (define (tmtex-document l) - (cons '!document (tmtex-list l))) + (cons '!document (tmtex-list l)) +) ;define (define (tmtex-date l) - (tmtex-default "tmdate" l)) + (tmtex-default "tmdate" l) +) ;define (define (tmtex-para l) - (cons '!paragraph (tmtex-list l))) + (tmtex-image-increment) + (cons '!paragraph (tmtex-list l)) +) ;define (define (tmtex-surround-sub l z) (if (null? (cdr l)) - (list (tex-concat (list (car l) z))) - (cons (car l) (tmtex-surround-sub (cdr l) z)))) + (list (tex-concat (list (car l) z))) + (cons (car l) (tmtex-surround-sub (cdr l) z)) + ) ;if +) ;define (define (tmtex-surround l) - (let* ((ll (tmtex-list l)) - (x (car ll)) - (y (caddr ll)) - (z (cadr ll))) + (let* ((ll (tmtex-list l)) (x (car ll)) (y (caddr ll)) (z (cadr ll))) (if (func? y '!document) - (let* ((a (cadr y)) - (b (cddr y))) - (cons '!document - (tmtex-surround-sub - (cons (tex-concat (list x a)) b) z))) - (tex-concat (list x y z))))) + (let* ((a (cadr y)) (b (cddr y))) + (cons '!document (tmtex-surround-sub (cons (tex-concat (list x a)) b) z)) + ) ;let* + (tex-concat (list x y z)) + ) ;if + ) ;let* +) ;define (define (tmtex-no-space-before? x) (or (func? x '!sub) - (func? x '!sup) - (and (string? x) (!= x "") - (in? (string-ref x 0) '(#\' #\, #\) #\]))) - (and (func? x '!concat) (tmtex-no-space-before? (cadr x))))) + (func? x '!sup) + (and (string? x) (!= x "") (in? (string-ref x 0) '(#\' #\, #\) #\]))) + (and (func? x '!concat) (tmtex-no-space-before? (cadr x))) + ) ;or +) ;define (define (tmtex-no-space-after? x) - (or (and (string? x) (!= x "") - (in? (string-ref x 0) '(#\( #\[))) - (and (func? x '!concat) (tmtex-no-space-after? (cAr x))))) + (or (and (string? x) (!= x "") (in? (string-ref x 0) '(#\( #\[))) + (and (func? x '!concat) (tmtex-no-space-after? (cAr x))) + ) ;or +) ;define (define (tmtex-math-concat-spaces l) - (if (or (null? l) (null? (cdr l))) l - (let* ((head (car l)) - (tail (tmtex-math-concat-spaces (cdr l)))) - (if (or (tmtex-no-space-after? head) - (tmtex-no-space-before? (car tail))) - (cons head tail) - (cons* head " " tail))))) + (if (or (null? l) (null? (cdr l))) + l + (let* ((head (car l)) (tail (tmtex-math-concat-spaces (cdr l)))) + (if (or (tmtex-no-space-after? head) (tmtex-no-space-before? (car tail))) + (cons head tail) + (cons* head " " tail) + ) ;if + ) ;let* + ) ;if +) ;define (define (tmtex-rewrite-no-break l) (cond ((null? l) l) - ((and (string? (car l)) (string-ends? (car l) " ") - (nnull? (cdr l)) (== (cadr l) '(no-break))) + ((and (string? (car l)) + (string-ends? (car l) " ") + (nnull? (cdr l)) + (== (cadr l) '(no-break)) + ) ;and (let* ((s (substring (car l) 0 (- (string-length (car l)) 1))) - (r (tmtex-rewrite-no-break (cddr l)))) - (if (== s "") (cons '(!nbsp) r) (cons* s '(!nbsp) r)))) - (else (cons (car l) (tmtex-rewrite-no-break (cdr l)))))) + (r (tmtex-rewrite-no-break (cddr l))) + ) ; + (if (== s "") (cons '(!nbsp) r) (cons* s '(!nbsp) r)) + ) ;let* + ) ; + (else (cons (car l) (tmtex-rewrite-no-break (cdr l)))) + ) ;cond +) ;define (define (check-double-script? l sub? sup?) (cond ((or (null? l) (npair? (car l))) #f) - ((== (caar l) 'rsub) - (or sub? (check-double-script? (cdr l) #t sup?))) - ((in? (caar l) '(rsup rprime)) - (or sup? (check-double-script? (cdr l) sub? #t))) - (else #f))) + ((== (caar l) 'rsub) (or sub? (check-double-script? (cdr l) #t sup?))) + ((in? (caar l) '(rsup rprime)) (or sup? (check-double-script? (cdr l) sub? #t))) + (else #f) + ) ;cond +) ;define (define (pre-scripts l) (cond ((or (null? l) (null? (cdr l))) l) ((check-double-script? (cdr l) #f #f) (if (== (== (caadr l) 'rsub) (== (caaddr l) 'rsub)) - (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l))) - (cddr l))) - (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l) ,(caddr l))) - (cdddr l))))) - (else - (cons (car l) (pre-scripts (cdr l)))))) + (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l))) (cddr l))) + (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l) ,(caddr l))) (cdddr l))) + ) ;if + ) ; + (else (cons (car l) (pre-scripts (cdr l)))) + ) ;cond +) ;define (define (tmtex-concat l) - ;;(display* "l= " l "\n") + ;; (display* "l= " l "\n") (if (> (length l) 50) - (with s (quotient (length l) 2) - (let ((h (list-head l s)) - (t (list-tail l s))) - (tmtex-concat `((concat ,@h) (concat ,@t))))) + (with s + (quotient (length l) 2) + (let ((h (list-head l s)) (t (list-tail l s))) + (tmtex-concat `((concat ,@h) (concat ,@t))) + ) ;let + ) ;with (if (tmtex-math-mode?) - (with l* (pre-scripts l) - ;;(when (!= l* l) (display* l " -> " l* "\n")) - ;;(display* "l1= " l* "\n") - ;;(display* "l2= " (pre-brackets-recurse l*) "\n") - ;;(display* "l3= " (tmtex-list (pre-brackets-recurse l*)) "\n") - (tex-concat (tmtex-math-concat-spaces - (tmtex-list (pre-brackets-recurse l*))))) - (tex-concat (tmtex-list (tmtex-rewrite-no-break l)))))) + (with l* + (pre-scripts l) + ;; (when (!= l* l) (display* l " -> " l* "\n")) + ;; (display* "l1= " l* "\n") + ;; (display* "l2= " (pre-brackets-recurse l*) "\n") + ;; (display* "l3= " (tmtex-list (pre-brackets-recurse l*)) "\n") + (tex-concat (tmtex-math-concat-spaces (tmtex-list (pre-brackets-recurse l*)))) + ) ;with + (tex-concat (tmtex-list (tmtex-rewrite-no-break l))) + ) ;if + ) ;if +) ;define (define (tmtex-rigid l) - (tmtex-function '!group l)) + (tmtex-function '!group l) +) ;define + +(define (tmtex-no-first-indentation l) + (tex-apply 'noindent) +) ;define + +(define (tmtex-line-break l) + (tex-apply 'linebreak) +) ;define + +(define (tmtex-page-break l) + (tex-apply 'pagebreak) +) ;define + +(define (tmtex-new-page l) + (tex-apply 'newpage) +) ;define + +(define (tmtex-no-page-break l) + (tex-apply 'nopagebreak) +) ;define -(define (tmtex-no-first-indentation l) (tex-apply 'noindent)) -(define (tmtex-line-break l) (tex-apply 'linebreak)) -(define (tmtex-page-break l) (tex-apply 'pagebreak)) -(define (tmtex-new-page l) (tex-apply 'newpage)) -(define (tmtex-no-page-break l) (tex-apply 'nopagebreak)) -(define (tmtex-next-line l) (list '!nextline)) -(define (tmtex-no-break l) '(!group (nobreak))) -(define (tmtex-emdash l) "---") +(define (tmtex-next-line l) + (list '!nextline) +) ;define + +(define (tmtex-no-break l) + '(!group (nobreak)) +) ;define + +(define (tmtex-emdash l) + "---" +) ;define (define (tmtex-new-line l) - (if (tmtex-math-mode?) (tmtex-next-line l) (tex-apply '!newline))) + (if (tmtex-math-mode?) (tmtex-next-line l) (tex-apply '!newline)) +) ;define (tm-define (tmtex-decode-length len) ;; FIXME: should be completed - (with s (force-string len) - (cond ((string-ends? s "fn") (string-replace s "fn" "em")) - ((string-ends? s "tab") (string-replace s "tab" "em")) - ((string-ends? s "spc") (string-replace s "spc" "em")) - ((string-ends? s "sep") (string-replace s "sep" "ex")) - ((string-ends? s "par") (string-replace s "par" "\\columnwidth")) - ((string-ends? s "pag") (string-replace s "pag" "\\textheight")) - (else s)))) - -(define (tmtex-hrule s l) (list 'hrulefill)) + (with s + (force-string len) + (cond ((string-ends? s "fn") (string-replace s "fn" "em")) + ((string-ends? s "tab") (string-replace s "tab" "em")) + ((string-ends? s "spc") (string-replace s "spc" "em")) + ((string-ends? s "sep") (string-replace s "sep" "ex")) + ((string-ends? s "par") (string-replace s "par" "\\columnwidth")) + ((string-ends? s "pag") (string-replace s "pag" "\\textheight")) + (else s) + ) ;cond + ) ;with +) ;tm-define + +(define (tmtex-hrule s l) + (list 'hrulefill) +) ;define (define (tmtex-hspace l) (let ((s (if (= (length l) 1) (car l) (cadr l)))) @@ -984,87 +1346,123 @@ (cond ((== s "0.4spc") (list (string->symbol ","))) ((== s "0.6spc") (list (string->symbol ","))) ((== s "0.16667em") (list (string->symbol ","))) - (else (tex-apply 'hspace (tmtex-decode-length s))))) + (else (tex-apply 'hspace (tmtex-decode-length s))) + ) ;cond + ) ; ((== s "0.4spc") (list (string->symbol ":"))) ((== s "0.6spc") (list (string->symbol ";"))) ((== s "-0.6spc") '(!concat (!) (!) (!))) ((== s "-0.4spc") '(!concat (!) (!))) ((== s "-0.2spc") '(!concat (!))) - (else (tex-apply 'hspace (tmtex-decode-length s)))))) + (else (tex-apply 'hspace (tmtex-decode-length s))) + ) ;cond + ) ;let +) ;define (define (tmtex-hspace* s l) - (tmtex-hspace l)) + (tmtex-hspace l) +) ;define (define (tmtex-vspace l) (let ((s (if (= (length l) 1) (car l) (cadr l)))) (cond ((== s "0.5fn") (tex-apply 'smallskip)) ((== s "1fn") (tex-apply 'medskip)) ((== s "2fn") (tex-apply 'bigskip)) - (else (tex-apply 'vspace (tmtex-decode-length s)))))) + (else (tex-apply 'vspace (tmtex-decode-length s))) + ) ;cond + ) ;let +) ;define (define (tmtex-space l) - (tmtex-hspace (list (car l)))) + (tmtex-hspace (list (car l))) +) ;define (define (into-single-paragraph t) - (set! t (tm-replace t (lambda (x) (tm-in? x '(equation equation*))) - (lambda (x) - (if (and (== (length x) 2) - (tm-func? (cadr x) 'document 1)) - `(math ,(cadr (cadr x))) - `(math ,@(cdr x)))))) - (set! t (tm-replace t (lambda (x) (tm-func? x 'document)) - (lambda (x) `(para ,@(cdr x))))) - t) + (set! t + (tm-replace t + (lambda (x) (tm-in? x '(equation equation*))) + (lambda (x) + (if (and (== (length x) 2) (tm-func? (cadr x) 'document 1)) + `(math ,(cadr (cadr x))) + `(math ,@(cdr x)) + ) ;if + ) ;lambda + ) ;tm-replace + ) ;set! + (set! t + (tm-replace t + (lambda (x) (tm-func? x 'document)) + (lambda (x) `(para ,@(cdr x))) + ) ;tm-replace + ) ;set! + t +) ;define (define (tmtex-float-make wide? size type position x capt) (let* ((pos (string-replace position "f" "")) (type* (if wide? (string-append type "*") type)) (body (tmtex x)) (caption (tmtex (into-single-paragraph capt))) - (body* `(!paragraph ,body (caption ,caption)))) + (body* `(!paragraph ,body (caption ,caption))) + ) ; (cond ((and (== size "big") (== type "figure")) (if (== pos "") - `((!begin ,type) ,body*) - `((!begin ,type* (!option ,pos)) ,body*))) + `((!begin ,type) ,body*) + `((!begin ,type* (!option ,pos)) ,body*) + ) ;if + ) ; ((and (== size "big") (== type "table")) (if (== pos "") - `((!begin ,type) ,body*) - `((!begin ,type* (!option ,pos)) ,body*))) - (else (list 'tmfloat pos size type* body caption))))) + `((!begin ,type) ,body*) + `((!begin ,type* (!option ,pos)) ,body*) + ) ;if + ) ; + (else (list 'tmfloat pos size type* body caption)) + ) ;cond + ) ;let* +) ;define (define (tmtex-float-table? x) - (or (func? x 'small-table 2) (func? x 'big-table 2))) + (or (func? x 'small-table 2) (func? x 'big-table 2)) +) ;define (define (tmtex-float-figure? x) - (or (func? x 'small-figure 2) (func? x 'big-figure 2))) + (or (func? x 'small-figure 2) (func? x 'big-figure 2)) +) ;define (define (tmtex-float-size l) (if (list? l) - (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big") - "big")) + (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big") + "big" + ) ;if +) ;define (define (tmtex-float-sub wide? position l) - (with pos (string-replace position "f" "") - (cond ((func? l 'document 1) - (tmtex-float-sub wide? pos (cadr l))) + (with pos + (string-replace position "f" "") + (cond ((func? l 'document 1) (tmtex-float-sub wide? pos (cadr l))) ((tmtex-float-figure? l) - (tmtex-float-make wide? (tmtex-float-size l) "figure" - pos (cadr l) (caddr l))) + (tmtex-float-make wide? (tmtex-float-size l) "figure" pos (cadr l) (caddr l)) + ) ; ((tmtex-float-table? l) - (tmtex-float-make wide? (tmtex-float-size l) "table" - pos (cadr l) (caddr l))) - (else - (tmtex-float-make wide? "big" "figure" - pos l ""))))) + (tmtex-float-make wide? (tmtex-float-size l) "table" pos (cadr l) (caddr l)) + ) ; + (else (tmtex-float-make wide? "big" "figure" pos l "")) + ) ;cond + ) ;with +) ;define (define (tmtex-float l) - (tmtex-float-sub #f (force-string (cadr l)) (caddr l))) + (tmtex-float-sub #f (force-string (cadr l)) (caddr l)) +) ;define (define (tmtex-wide-float l) - (tmtex-float-sub #t (force-string (cadr l)) (caddr l))) + (tmtex-float-sub #t (force-string (cadr l)) (caddr l)) +) ;define (define (tmtex-htab l) - (tex-apply 'hspace* (list 'fill))) + (tex-apply 'hspace* (list 'fill)) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Make brackets small when necessary @@ -1072,72 +1470,89 @@ (define (disable-large? x level) (cond ((string? x) #t) - ((func? x 'concat) - (list-and (map (cut disable-large? <> level) (cdr x)))) + ((func? x 'concat) (list-and (map (cut disable-large? <> level) (cdr x)))) ((tm-in? x '(left mid right)) #t) ((tm-in? x '(lsub lsup rsub rsup)) - (and (> level 0) (disable-large? (cadr x) (- level 1)))) + (and (> level 0) (disable-large? (cadr x) (- level 1))) + ) ; ((tm-in? x '(lprime rprime)) #t) - ((tm-in? x '(wide wide*)) - (disable-large? (cadr x) (- level 1))) - ((tm-in? x '(with rigid locus)) - (disable-large? (cAr x) level)) + ((tm-in? x '(wide wide*)) (disable-large? (cadr x) (- level 1))) + ((tm-in? x '(with rigid locus)) (disable-large? (cAr x) level)) ((tm-in? x '(math-up math-ss math-tt math-bf math-it math-sl)) - (and (== (tm-arity x) 1) (disable-large? (cadr x) level))) - (else #f))) + (and (== (tm-arity x) 1) (disable-large? (cadr x) level)) + ) ; + (else #f) + ) ;cond +) ;define (define (make-small s) (cond ((nstring? s) "") ((== s ".") "") ((<= (string-length s) 1) s) ((and (string-starts? s "<") (string-ends? s ">")) s) - (else (string-append "<" s ">")))) + (else (string-append "<" s ">")) + ) ;cond +) ;define (define (make-small-bracket x) - (if (tm-in? x '(left mid right)) (make-small (cadr x)) x)) + (if (tm-in? x '(left mid right)) (make-small (cadr x)) x) +) ;define (define (find-right l) (cond ((null? l) #f) ((func? (car l) 'left) #f) ((func? (car l) 'right) 2) - (else (with i (find-right (cdr l)) (and i (+ i 1)))))) + (else (with i (find-right (cdr l)) (and i (+ i 1)))) + ) ;cond +) ;define (define (pre-brackets l) (cond ((null? l) l) ((func? (car l) 'left) - (with n (find-right (cdr l)) - (if (not n) (cons (car l) (pre-brackets (cdr l))) - (let* ((r (pre-brackets (sublist l n (length l)))) - (m (sublist l 0 n))) - (if (disable-large? `(concat ,@m) 2) - (begin - ;;(display* "< " m "\n") - ;;(display* "> " (map make-small-bracket m) "\n") - (append (map make-small-bracket m) r)) - (append m r)))))) - (else (cons (car l) (pre-brackets (cdr l)))))) + (with n + (find-right (cdr l)) + (if (not n) + (cons (car l) (pre-brackets (cdr l))) + (let* ((r (pre-brackets (sublist l n (length l)))) (m (sublist l 0 n))) + (if (disable-large? `(concat ,@m) 2) + (begin + ;; (display* "< " m "\n") + ;; (display* "> " (map make-small-bracket m) "\n") + (append (map make-small-bracket m) r) + ) ;begin + (append m r) + ) ;if + ) ;let* + ) ;if + ) ;with + ) ; + (else (cons (car l) (pre-brackets (cdr l)))) + ) ;cond +) ;define (define (pre-brackets-recurse l) - (with r (pre-brackets l) - (if (== r l) r - (pre-brackets-recurse r)))) + (with r (pre-brackets l) (if (== r l) r (pre-brackets-recurse r))) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mathematics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (convert-around x) - (with d (downgrade-brackets x) - (tmtex-concat (if (pair? d) (cdr d) (list d))))) + (with d (downgrade-brackets x) (tmtex-concat (if (pair? d) (cdr d) (list d)))) +) ;define (define (tmtex-around l) - (convert-around (cons 'around l))) + (convert-around (cons 'around l)) +) ;define (define (tmtex-around* l) - (convert-around (cons 'around* l))) + (convert-around (cons 'around* l)) +) ;define (define (tmtex-big-around l) - (convert-around (cons 'big-around l))) + (convert-around (cons 'big-around l)) +) ;define (define (tmtex-large-decode s) (cond ((nstring? s) ".") @@ -1145,50 +1560,66 @@ ((in? s '("||" "<||>")) "\\|") ((== s "\\") "\\backslash") ((and (string-starts? s "<") (string-ends? s ">")) - (string-append "\\" (substring s 1 (- (string-length s) 1)))) - (else (string-append "\\" s)))) + (string-append "\\" (substring s 1 (- (string-length s) 1))) + ) ; + (else (string-append "\\" s)) + ) ;cond +) ;define (define (tmtex-large-decode-text s) (cond ((nstring? s) "") ((== s ".") "") ((in? s '("(" ")" "[" "]" "|" "/")) s) ((in? s '("{" "}")) (string-append "\\" s)) - (else - (display* "TeXmacs] non converted bracket: " s "\n") - ""))) + (else (display* "TeXmacs] non converted bracket: " s "\n") "") + ) ;cond +) ;define (define (tmtex-left l) (if (tmtex-math-mode?) - (let* ((s (tmtex-large-decode (car l))) - (n (if (= (length l) 2) (string->number (cadr l)) 0)) - (b (cond ((not n) "left") - ((= n 1) "bigl") - ((= n 2) "Bigl") - ((= n 3) "biggl") - ((= n 4) "Biggl") - (else "left")))) - (list (string->symbol (string-append b s)))) - (tmtex-large-decode-text (car l)))) + (let* ((s (tmtex-large-decode (car l))) + (n (if (= (length l) 2) (string->number (cadr l)) 0)) + (b (cond ((not n) "left") + ((= n 1) "bigl") + ((= n 2) "Bigl") + ((= n 3) "biggl") + ((= n 4) "Biggl") + (else "left") + ) ;cond + ) ;b + ) ; + (list (string->symbol (string-append b s))) + ) ;let* + (tmtex-large-decode-text (car l)) + ) ;if +) ;define (define (tmtex-mid l) (display* "TeXmacs] downgraded large middle delimiter: " (car l) "\n") (if (tmtex-math-mode?) - (with s (tmtex-large-decode (car l)) - (if (== s ".") "" s)) - (tmtex-large-decode-text (car l)))) + (with s (tmtex-large-decode (car l)) (if (== s ".") "" s)) + (tmtex-large-decode-text (car l)) + ) ;if +) ;define (define (tmtex-right l) (if (tmtex-math-mode?) - (let* ((s (tmtex-large-decode (car l))) - (n (if (= (length l) 2) (string->number (cadr l)) 0)) - (b (cond ((not n) "right") - ((= n 1) "bigr") - ((= n 2) "Bigr") - ((= n 3) "biggr") - ((= n 4) "Biggr") - (else "right")))) - (list (string->symbol (string-append b s)))) - (tmtex-large-decode-text (car l)))) + (let* ((s (tmtex-large-decode (car l))) + (n (if (= (length l) 2) (string->number (cadr l)) 0)) + (b (cond ((not n) "right") + ((= n 1) "bigr") + ((= n 2) "Bigr") + ((= n 3) "biggr") + ((= n 4) "Biggr") + (else "right") + ) ;cond + ) ;b + ) ; + (list (string->symbol (string-append b s))) + ) ;let* + (tmtex-large-decode-text (car l)) + ) ;if +) ;define (define (tmtex-big-decode s) (cond ((nstring? s) "bignone") @@ -1198,111 +1629,155 @@ ((== s "amalg") "coprod") ((== s "pluscup") "uplus") ((== s ".") "bignone") - (else (string-append "big" s)))) + (else (string-append "big" s)) + ) ;cond +) ;define (define (tmtex-big l) - (list (string->symbol (tmtex-big-decode (car l))))) + (list (string->symbol (tmtex-big-decode (car l)))) +) ;define (define (tmtex-decode-long-arrow s) (cond ((nstring? s) #f) ((and (string-starts? s "")) - (tmtex-decode-long-arrow (substring s 8 (- (string-length s) 1)))) - ((in? s '("minus" "leftarrow" "rightarrow" "leftrightarrow" - "equal" "Leftarrow" "Rightarrow" "Leftrightarrow" - "mapsto" "mapsfrom")) - (string->symbol (string-append "x" s))) - ((in? s '("leftrightarrows" "leftleftarrows" - "threeleftarrows" "fourleftarrows" - "rightleftarrows" "rightrightarrows" - "threerightarrows" "fourrightarrows")) - (string-append "")) + (tmtex-decode-long-arrow (substring s 8 (- (string-length s) 1))) + ) ; + ((in? s + '("minus" + "leftarrow" + "rightarrow" + "leftrightarrow" + "equal" + "Leftarrow" + "Rightarrow" + "Leftrightarrow" + "mapsto" + "mapsfrom") + ) ;in? + (string->symbol (string-append "x" s)) + ) ; + ((in? s + '("leftrightarrows" + "leftleftarrows" + "threeleftarrows" + "fourleftarrows" + "rightleftarrows" + "rightrightarrows" + "threerightarrows" + "fourrightarrows") + ) ;in? + (string-append "") + ) ; ((== s "Lleftarrow") "") ((== s "Rrightarrow") "") ((== s "LRleftrightarrow") "") - (else (string-append "<" s ">")))) + (else (string-append "<" s ">")) + ) ;cond +) ;define (define (tmtex-long-arrow l) - (with cmd (tmtex-decode-long-arrow (car l)) - (cond ((and (symbol? cmd) (== (length l) 2)) - (list cmd (tmtex (cadr l)))) - ((symbol? cmd) - (list cmd (list '!option (tmtex (caddr l))) (tmtex (cadr l)))) - ((== (length l) 2) - (list 'overset (tmtex (cadr l)) (tmtex cmd))) - ((== (cadr l) "") - (list 'underset (tmtex (caddr l)) (tmtex cmd))) - (else - (list 'underset (tmtex (caddr l)) - (list 'overset (tmtex (cadr l)) (tmtex cmd))))))) + (with cmd + (tmtex-decode-long-arrow (car l)) + (cond ((and (symbol? cmd) (== (length l) 2)) (list cmd (tmtex (cadr l)))) + ((symbol? cmd) (list cmd (list '!option (tmtex (caddr l))) (tmtex (cadr l)))) + ((== (length l) 2) (list 'overset (tmtex (cadr l)) (tmtex cmd))) + ((== (cadr l) "") (list 'underset (tmtex (caddr l)) (tmtex cmd))) + (else (list 'underset (tmtex (caddr l)) (list 'overset (tmtex (cadr l)) (tmtex cmd))) + ) ;else + ) ;cond + ) ;with +) ;define (define (tmtex-below l) - (list 'underset (tmtex (cadr l)) (tmtex (car l)))) + (list 'underset (tmtex (cadr l)) (tmtex (car l))) +) ;define (define (tmtex-above l) - (list 'overset (tmtex (cadr l)) (tmtex (car l)))) + (list 'overset (tmtex (cadr l)) (tmtex (car l))) +) ;define (define (tmtex-lsub l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex `(concat (!group) (rsub ,(car l))))) - (else (tmtex `(rsub ,(car l)))))) + (else (tmtex `(rsub ,(car l)))) + ) ;cond +) ;define (define (tmtex-lsup l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex `(concat (!group) (rsup ,(car l))))) - (else (tmtex `(rsup ,(car l)))))) + (else (tmtex `(rsup ,(car l)))) + ) ;cond +) ;define (define (tmtex-contains-table? x) (cond ((nlist? x) #f) ((and (>= (length x) 2) (== (car x) '!table)) #t) - (else (list-or (map-in-order tmtex-contains-table? (cdr x)))))) + (else (list-or (map-in-order tmtex-contains-table? (cdr x)))) + ) ;cond +) ;define (define (tmtex-script which script) - (with r (tmtex script) - (if (tmtex-contains-table? r) - (list which (list 'tmscript r)) - (list which r)))) + (with r + (tmtex script) + (if (tmtex-contains-table? r) (list which (list 'tmscript r)) (list which r)) + ) ;with +) ;define (define (tmtex-rsub l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex-script '!sub (car l))) - (else (list 'tmrsub (tmtex (car l)))))) + (else (list 'tmrsub (tmtex (car l)))) + ) ;cond +) ;define (define (tmtex-rsup l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex-script '!sup (car l))) - (else (list 'tmrsup (tmtex (car l)))))) + (else (list 'tmrsup (tmtex (car l)))) + ) ;cond +) ;define (define (tmtex-modulo l) - (tmtex-script 'mod (car l))) + (tmtex-script 'mod (car l)) +) ;define (define (tmtex-frac l) - (tmtex-function 'frac l)) + (tmtex-function 'frac l) +) ;define (define (tmtex-sqrt l) (if (= (length l) 1) - (tmtex-function 'sqrt l) - (list 'sqrt - (list '!option (tmtex (cadr l))) - (tmtex (car l))))) + (tmtex-function 'sqrt l) + (list 'sqrt (list '!option (tmtex (cadr l))) (tmtex (car l))) + ) ;if +) ;define (define (tmtex-token? s) (or (= (string-length s) 1) - (and (!= s "") - (== (string-ref s 0) #\<) - (== (string-index s #\>) (- (string-length s) 1))))) + (and (!= s "") + (== (string-ref s 0) #\<) + (== (string-index s #\>) (- (string-length s) 1)) + ) ;and + ) ;or +) ;define (define (tmtex-wide-star? x) (cond ((func? x 'wide* 1) (tmtex-wide-star? (cadr x))) ((nstring? x) #t) - (else (not (tmtex-token? x))))) + (else (not (tmtex-token? x))) + ) ;cond +) ;define (define (tmtex-wide-star l) (let ((wide? (tmtex-wide-star? (car l))) (arg (tmtex (car l))) (acc (cadr l)) - (text? (not (tmtex-math-mode?)))) + (text? (not (tmtex-math-mode?))) + ) ; (if (and (string? acc) (string-starts? acc "" "^")) (list (if wide? 'uwidehat 'uhat) arg)) ((in? acc '("" "~")) (list (if wide? 'uwidetilde 'utilde) arg)) @@ -1324,57 +1799,56 @@ ((== acc "") (list 'underrightarrow arg)) ((== acc "") (list 'underleftarrow arg)) ((== acc "") (list 'underleftrightarrow arg)) - ((in? acc '("" "")) - (list 'underbrace arg)) + ((in? acc '("" "")) (list 'underbrace arg)) ((in? acc '("" "")) - (tmtex-below `(,(car l) (text (downbracefill))))) - ((in? acc '("" "")) - (list 'underbrace arg)) + (tmtex-below `(,(car l) (text (downbracefill)))) + ) ; + ((in? acc '("" "")) (list 'underbrace arg)) ((in? acc '("" "")) - (tmtex-below `(,(car l) (text (downbracefill))))) + (tmtex-below `(,(car l) (text (downbracefill)))) + ) ; ;; imperfect translations - ((in? acc '("" "")) - (list 'underbrace arg)) + ((in? acc '("" "")) (list 'underbrace arg)) ((in? acc '("" "")) - (tmtex-below `(,(car l) (text (downbracefill))))) - (else - (display* "TeXmacs] non converted accent below: " acc "\n") - arg)))) + (tmtex-below `(,(car l) (text (downbracefill)))) + ) ; + (else (display* "TeXmacs] non converted accent below: " acc "\n") arg) + ) ;cond + ) ;let +) ;define (define (tmtex-wide? x) (cond ((func? x 'wide 1) (tmtex-wide? (cadr x))) ((nstring? x) #t) - (else (not (tmtex-token? x))))) + (else (not (tmtex-token? x))) + ) ;cond +) ;define (define (tmtex-wide l) (let ((wide? (tmtex-wide? (car l))) (arg (tmtex (car l))) (acc (cadr l)) - (text? (not (tmtex-math-mode?)))) + (text? (not (tmtex-math-mode?))) + ) ; (if (and (string? acc) (string-starts? acc "" "^")) - (list (if text? '^ (if wide? 'widehat 'hat)) arg)) + ((in? acc '("" "^")) (list (if text? '^ (if wide? 'widehat 'hat)) arg)) ((in? acc '("" "~")) - (list (if text? '~ (if wide? 'widetilde 'tilde)) arg)) - ((== (cadr l) "") - (list (if text? '= 'overline) arg)) - ((== acc "") - (list (if text? '= (if wide? 'overline 'bar)) arg)) + (list (if text? '~ (if wide? 'widetilde 'tilde)) arg) + ) ; + ((== (cadr l) "") (list (if text? '= 'overline) arg)) + ((== acc "") (list (if text? '= (if wide? 'overline 'bar)) arg)) ((== acc "") (list (if wide? 'overrightarrow 'vec) arg)) ((== acc "") (list (if text? 'u 'breve) arg)) ((== acc "") (list 'invbreve arg)) ((== acc "") (list (if text? 'v 'check) arg)) ((== acc "") (list (if text? 'r 'ring) arg)) - ((== acc "") - (list (if text? (string->symbol "'") 'acute) arg)) - ((== acc "") - (list (if text? (string->symbol "`") 'grave) arg)) - ((== acc "") - (list (if text? (string->symbol ".") 'dot) arg)) - ((== acc "") - (list (if text? (string->symbol "\"") 'ddot) arg)) + ((== acc "") (list (if text? (string->symbol "'") 'acute) arg)) + ((== acc "") (list (if text? (string->symbol "`") 'grave) arg)) + ((== acc "") (list (if text? (string->symbol ".") 'dot) arg)) + ((== acc "") (list (if text? (string->symbol "\"") 'ddot) arg)) ((== acc "") (list 'dddot arg)) ((== acc "") (list 'ddddot arg)) ((== acc "") (list 'overrightarrow arg)) @@ -1383,160 +1857,200 @@ ((== acc "") (list 'overrightarrow arg)) ((== acc "") (list 'overleftarrow arg)) ((== acc "") (list 'overleftrightarrow arg)) - ((in? acc '("" "")) - (list 'overbrace arg)) + ((in? acc '("" "")) (list 'overbrace arg)) ((in? acc '("" "")) - (tmtex-above `(,(car l) (text (upbracefill))))) - ((in? acc '("" "")) - (list 'overbrace arg)) + (tmtex-above `(,(car l) (text (upbracefill)))) + ) ; + ((in? acc '("" "")) (list 'overbrace arg)) ((in? acc '("" "")) - (tmtex-above `(,(car l) (text (upbracefill))))) + (tmtex-above `(,(car l) (text (upbracefill)))) + ) ; ;; FIXME: imperfect translations - ((in? acc '("" "")) - (list 'overbrace arg)) + ((in? acc '("" "")) (list 'overbrace arg)) ((in? acc '("" "")) - (tmtex-above `(,(car l) (text (upbracefill))))) - (else - (display* "TeXmacs] non converted accent: " acc "\n") - arg)))) + (tmtex-above `(,(car l) (text (upbracefill)))) + ) ; + (else (display* "TeXmacs] non converted accent: " acc "\n") arg) + ) ;cond + ) ;let +) ;define (define (tmtex-neg l) - (tmtex-function 'not l)) + (tmtex-function 'not l) +) ;define (define (tmtex-tree l) (let* ((root (list '!begin "bundle" (tmtex (car l)))) - (children (map (lambda (x) (list 'chunk (tmtex x))) (cdr l)))) - (list root (tex-concat children)))) + (children (map (lambda (x) (list 'chunk (tmtex x))) (cdr l))) + ) ; + (list root (tex-concat children)) + ) ;let* +) ;define (define (tmtex-tree-eps l) - (tmtex-eps (cons 'tree l))) + (tmtex-eps (cons 'tree l)) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Hacks for tables with multi-paragraph cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (map-or l1 l2) - (if (or (null? l1) (null? l2)) (list) - (cons (or (car l1) (car l2)) (map-or (cdr l1) (cdr l2))))) + (if (or (null? l1) (null? l2)) + (list) + (cons (or (car l1) (car l2)) (map-or (cdr l1) (cdr l2))) + ) ;if +) ;define (define (tmtex-block-columns t) (cond ((tm-func? t 'tformat) (tmtex-block-columns (cAr t))) ((tm-func? t 'table 1) (tmtex-block-columns (cAr t))) ((tm-func? t 'table) (let* ((b1 (tmtex-block-columns `(table ,(cadr t)))) - (b2 (tmtex-block-columns `(table ,@(cddr t))))) - (map-or b1 b2))) + (b2 (tmtex-block-columns `(table ,@(cddr t)))) + ) ; + (map-or b1 b2) + ) ;let* + ) ; ((tm-func? t 'row) (map tmtex-block-columns (cdr t))) ((tm-func? t 'cell) (tmtex-block-columns (cAr t))) - (else (tm-func? t 'document)))) + (else (tm-func? t 'document)) + ) ;cond +) ;define (define (column-numbers l i) (cond ((null? l) (list)) ((car l) (cons i (column-numbers (cdr l) (+ i 1)))) - (else (column-numbers (cdr l) (+ i 1))))) + (else (column-numbers (cdr l) (+ i 1))) + ) ;cond +) ;define (define (block-align nr out-of) (let* ((c (number->string nr)) - (p (string-append "p{" (number->string (/ 12.0 out-of)) "cm}"))) - `(cwith "1" "-1" ,c ,c "cell-halign" ,p))) + (p (string-append "p{" (number->string (/ 12.0 out-of)) "cm}")) + ) ; + `(cwith ,"1" ,"-1" ,c ,c ,"cell-halign" ,p) + ) ;let* +) ;define (define (tmtex-block-adjust t) - (cond ((tm-func? t 'tformat) - (append (cDr t) (list (tmtex-block-adjust (cAr t))))) + (cond ((tm-func? t 'tformat) (append (cDr t) (list (tmtex-block-adjust (cAr t))))) ((tm-func? t 'table) - (let* ((b (tmtex-block-columns t)) - (n (column-numbers b 1))) - (if (null? n) t - `(tformat ,@(map (cut block-align <> (length n)) n) ,t)))) - (else t))) + (let* ((b (tmtex-block-columns t)) (n (column-numbers b 1))) + (if (null? n) t `(tformat ,@(map (cut block-align <> (length n)) n) + ,t)) + ) ;let* + ) ; + (else t) + ) ;cond +) ;define (define (tm-big-figure? t) - (tm-in? t '(big-figure big-table))) + (tm-in? t '(big-figure big-table)) +) ;define (define (tm-replace-figure t) - (cond ((tm-func? t 'big-figure) - (list 'tmfloat "h" "big" "figure" (cadr t) (caddr t))) - ((tm-func? t 'big-table) - (list 'tmfloat "h" "big" "table" (cadr t) (caddr t))) - (else t))) + (cond ((tm-func? t 'big-figure) (list 'tmfloat "h" "big" "figure" (cadr t) (caddr t))) + ((tm-func? t 'big-table) (list 'tmfloat "h" "big" "table" (cadr t) (caddr t))) + (else t) + ) ;cond +) ;define (define (tmtex-figure-adjust t) - (tm-replace t tm-big-figure? tm-replace-figure)) + (tm-replace t tm-big-figure? tm-replace-figure) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-table-rows-assemble tb bb rows) - (cond ((null? rows) - (if (null? bb) '() (if (car bb) (list (list 'hline)) '()))) + (cond ((null? rows) (if (null? bb) '() (if (car bb) (list (list 'hline)) '()))) (else (append (if (or (car tb) (car bb)) (list (list 'hline)) '()) - (cons (cons '!row (map tmtex (car rows))) - (tmtex-table-rows-assemble - (cdr tb) (cdr bb) (cdr rows))))))) + (cons (cons '!row (map tmtex (car rows))) + (tmtex-table-rows-assemble (cdr tb) (cdr bb) (cdr rows)) + ) ;cons + ) ;append + ) ;else + ) ;cond +) ;define (define (tmtex-table-make p) - (let ((tb (p 'rows 'tborder)) - (bb (p 'rows 'bborder)) - (l (p 'rows 'content))) - (cons '!table (tmtex-table-rows-assemble tb (cons (car tb) bb) l)))) + (let ((tb (p 'rows 'tborder)) (bb (p 'rows 'bborder)) (l (p 'rows 'content))) + (cons '!table (tmtex-table-rows-assemble tb (cons (car tb) bb) l)) + ) ;let +) ;define (define (tmtex-table-args-assemble lb rb ha) - (cond - ((null? ha) (if (null? rb) '() (list (if (car rb) "|" "")))) - (else (cons (if (or (car lb) (car rb)) "|" "") - (cons (car ha) (tmtex-table-args-assemble - (cdr lb) (cdr rb) (cdr ha))))))) + (cond ((null? ha) (if (null? rb) '() (list (if (car rb) "|" "")))) + (else (cons (if (or (car lb) (car rb)) "|" "") + (cons (car ha) (tmtex-table-args-assemble (cdr lb) (cdr rb) (cdr ha))) + ) ;cons + ) ;else + ) ;cond +) ;define (define (tmtex-table-args p) - (let ((lb (p 'cols 'lborder)) - (rb (p 'cols 'rborder)) - (l (p 'cols 'halign))) - (apply string-append - (tmtex-table-args-assemble lb (cons (car lb) rb) l)))) + (let ((lb (p 'cols 'lborder)) (rb (p 'cols 'rborder)) (l (p 'cols 'halign))) + (apply string-append (tmtex-table-args-assemble lb (cons (car lb) rb) l)) + ) ;let +) ;define (define (tmtex-table-apply key args x) (let* ((props (logic-ref tmtex-table-props% key)) - (wide? (and props (string-contains? (cadr props) "X")))) + (wide? (and props (string-contains? (cadr props) "X"))) + ) ; (when (== key 'rcl-table) - (latex-add-extra "tabls")) + (latex-add-extra "tabls") + ) ;when (when (and (not (tmtex-math-mode?)) (not wide?)) (set! x (tmtex-block-adjust x)) - (set! x (tmtex-figure-adjust x))) + (set! x (tmtex-figure-adjust x)) + ) ;when (if props - (let* ((env (if (tmtex-math-mode?) "array" "tabular")) - (env* (if wide? (list "tabularx" "1.0\\textwidth") (list env))) - (before (car props)) - (after (caddr props)) - (defaults (append (tmtable-cell-halign (cadr props)) - (tmtable-block-borders (cadddr props)))) - (p (tmtable-parser `(tformat ,@defaults ,x))) - (e `(!begin ,@env* ,(tmtex-table-args p))) - (r (tmtex-table-make p))) - (tex-concat (list before (list e r) after))) - (begin - (list `(!begin ,(symbol->string key) ,@args) - (tmtex-table-make (tmtable-parser x))))))) + (let* ((env (if (tmtex-math-mode?) "array" "tabular")) + (env* (if wide? (list "tabularx" "1.0\\textwidth") (list env))) + (before (car props)) + (after (caddr props)) + (defaults (append (tmtable-cell-halign (cadr props)) + (tmtable-block-borders (cadddr props)) + ) ;append + ) ;defaults + (p (tmtable-parser `(tformat ,@defaults ,x))) + (e `(!begin ,@env* ,(tmtex-table-args p))) + (r (tmtex-table-make p)) + ) ; + (tex-concat (list before (list e r) after)) + ) ;let* + (begin + (list `(!begin ,(symbol->string key) ,@args) + (tmtex-table-make (tmtable-parser x)) + ) ;list + ) ;begin + ) ;if + ) ;let* +) ;define (define (tmtex-tformat l) - (tmtex-table-apply 'tabular '() (cons 'tformat l))) + (tmtex-table-apply 'tabular '() (cons 'tformat l)) +) ;define (define (tmtex-table l) - (tmtex-table-apply 'tabular '() (cons 'table l))) + (tmtex-image-increment) + (tmtex-table-apply 'tabular '() (cons 'table l)) +) ;define (define (tmtex-stack l) (when (nnull? l) - (let* ((x (car l)) - (p (tmtable-parser x)) - (rows (p 'rows 'content))) + (let* ((x (car l)) (p (tmtable-parser x)) (rows (p 'rows 'content))) (latex-add-extra "mathtools") (tex-apply 'substack - (tex-concat - (list-intersperse - (map (lambda (row) - (tex-concat (map tmtex row))) - rows) - "\\\\")))))) + (tex-concat (list-intersperse (map (lambda (row) (tex-concat (map tmtex row))) rows) "\\\\") + ) ;tex-concat + ) ;tex-apply + ) ;let* + ) ;when +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Local and global environment changes @@ -1544,85 +2058,120 @@ (define (tmtex-get-with-cmd var val) (if (tmtex-math-mode?) - (or (logic-ref tex-with-cmd-math% (list var val)) - (logic-ref tex-with-cmd% (list var val))) - (logic-ref tex-with-cmd% (list var val)))) + (or (logic-ref tex-with-cmd-math% (list var val)) + (logic-ref tex-with-cmd% (list var val)) + ) ;or + (logic-ref tex-with-cmd% (list var val)) + ) ;if +) ;define (define (tmtex-get-assign-cmd var val) (if (== var "font-size") - (let ((x (* (string->number val) 10))) - (cond ((< x 1) #f) - ((< x 5.5) 'tiny) - ((< x 6.5) 'scriptsize) - ((< x 7.5) 'footnotesize) - ((< x 9.5) 'small) - ((< x 11.5) 'normalsize) - ((< x 13.5) 'large) - ((< x 15.5) 'Large) - ((< x 18.5) 'LARGE) - ((< x 22.5) 'huge) - ((< x 50) 'Huge) - (else #f))) - (logic-ref tex-assign-cmd% (list var val)))) + (let ((x (* (string->number val) 10))) + (cond ((< x 1) #f) + ((< x 5.5) 'tiny) + ((< x 6.5) 'scriptsize) + ((< x 7.5) 'footnotesize) + ((< x 9.5) 'small) + ((< x 11.5) 'normalsize) + ((< x 13.5) 'large) + ((< x 15.5) 'Large) + ((< x 18.5) 'LARGE) + ((< x 22.5) 'huge) + ((< x 50) 'Huge) + (else #f) + ) ;cond + ) ;let + (logic-ref tex-assign-cmd% (list var val)) + ) ;if +) ;define (define (tmlength->texlength len) ;; TODO: rewrite (quote x) -> x and (tmlen ...) -> ...pt - (with tmlen (string->tmlength (force-string len)) - (if (tmlength-null? tmlen) "0pt" - (let* ((val (tmlength-value tmlen)) - (unit (symbol->string (tmlength-unit tmlen))) - (val-string (number->string val))) - (cond ((== unit "fn") (string-append val-string "em")) - (else len)))))) + (with tmlen + (string->tmlength (force-string len)) + (if (tmlength-null? tmlen) + "0pt" + (let* ((val (tmlength-value tmlen)) + (unit (symbol->string (tmlength-unit tmlen))) + (val-string (number->string val)) + ) ; + (cond ((== unit "fn") (string-append val-string "em")) + (else len) + ) ;cond + ) ;let* + ) ;if + ) ;with +) ;define (define (tmtex-make-parmod x y z arg flag?) (set! x (tmlength->texlength x)) (set! y (tmlength->texlength y)) (set! z (tmlength->texlength z)) (if (and (tmlength-zero? (string->tmlength x)) - (tmlength-zero? (string->tmlength y)) - (tmlength-zero? (string->tmlength z)) - flag?) - arg - (list (list '!begin "tmparmod" x y z) arg))) + (tmlength-zero? (string->tmlength y)) + (tmlength-zero? (string->tmlength z)) + flag? + ) ;and + arg + (list (list '!begin "tmparmod" x y z) arg) + ) ;if +) ;define (define (tmtex-make-parsep x arg) (set! x (tmlength->texlength x)) - (list (list '!begin "tmparsep" x) arg)) + (list (list '!begin "tmparsep" x) arg) +) ;define (define (tmtex-make-lang val arg) (if (== val "verbatim") `(tt ,arg) (begin (if (nin? val tmtex-languages) - (set! tmtex-languages (append (list val) tmtex-languages))) + (set! tmtex-languages (append (list val) tmtex-languages)) + ) ;if (if (texout-multiline? arg) - `((!begin "otherlanguage" ,val) ,arg) - `(foreignlanguage ,val ,arg))))) + `((!begin ,"otherlanguage" ,val) ,arg) + `(foreignlanguage ,val ,arg) + ) ;if + ) ;begin + ) ;if +) ;define (define (tmtex-decode-color s . force-html) - (with cm (if (string-starts? s "#") "HTML" (named-color->xcolormap s)) + (with cm + (if (string-starts? s "#") "HTML" (named-color->xcolormap s)) (cond ((and (== cm "none") (nnull? force-html)) - (tmtex-decode-color (get-hex-color s) force-html)) + (tmtex-decode-color (get-hex-color s) force-html) + ) ; ((and (== cm "HTML") (nnull? force-html)) - `((!option "HTML") ,(html-color->latex-xcolor s))) + `((!option "HTML") ,(html-color->latex-xcolor s)) + ) ; ((== cm "texmacs") (when (nin? s tmtex-colors) - (set! tmtex-colors (append (list s) tmtex-colors))) - (string-replace s " " "")) - ((in? cm (list "x11names")) - (tmtex-decode-color (get-hex-color s) #t)) - (else - (when (and (nin? cm tmtex-colormaps) - (!= cm "xcolor") (!= cm "none")) - (set! tmtex-colormaps (append (list cm) tmtex-colormaps))) - (string-replace s " " ""))))) + (set! tmtex-colors (append (list s) tmtex-colors)) + ) ;when + (string-replace s " " "") + ) ; + ((in? cm (list "x11names")) (tmtex-decode-color (get-hex-color s) #t)) + (else (when (and (nin? cm tmtex-colormaps) (!= cm "xcolor") (!= cm "none")) + (set! tmtex-colormaps (append (list cm) tmtex-colormaps)) + ) ;when + (string-replace s " " "") + ) ;else + ) ;cond + ) ;with +) ;define (define (tmtex-make-color val arg) - (with ltxcolor (tmtex-decode-color val #t) + (with ltxcolor + (tmtex-decode-color val #t) (if (list? ltxcolor) - `(!group (!append (color ,@ltxcolor) ,arg)) - `(tmcolor ,ltxcolor ,arg)))) + `(!group (!append (color ,@ltxcolor) ,arg)) + `(tmcolor ,ltxcolor ,arg) + ) ;if + ) ;with +) ;define (define (post-process-math-text t) (cond ((or (nlist? t) (!= (length t) 2)) t) @@ -1635,182 +2184,232 @@ ((func? t 'mathsl 1) `(textsl ,(cadr t))) ((func? t 'mathtt 1) `(texttt ,(cadr t))) ((func? t 'tmop 1) `(textrm ,(cadr t))) - (else t))) + (else t) + ) ;cond +) ;define (define (tmtex-with-one var val arg) (if (== var "mode") - (let ((old (tmtex-env-get-previous "mode"))) - (cond ((and (== val "text") (!= old "text")) - (list 'text arg)) - ((and (== val "math") (!= old "math") - (ahash-ref tmtex-env :preamble)) - (list 'ensuremath arg)) - ((and (== val "math") (!= old "math")) - (list '!math arg)) - ((and (== val "prog") (== old "text")) - `(tt ,arg)) - ((and (== val "prog") (== old "math")) - `(text (tt ,arg))) - (else arg))) - (let ((w (tmtex-get-with-cmd var val)) - (a (tmtex-get-assign-cmd var val))) - (cond ((and w (tm-func? arg w 1)) arg) - ((in? w '(mathrm mathbf mathsf mathit mathtt mathsl)) - (post-process-math-text (list w arg))) - (w (list w arg)) - (a (list '!group (tex-concat (list (list a) " " arg)))) - ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg #t)) - ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg #t)) - ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg #f)) - ((== "par-par-sep" var) (tmtex-make-parsep val arg)) - ((== var "language") (tmtex-make-lang val arg)) - ((== var "color") (tmtex-make-color val arg)) - (else arg))))) + (let ((old (tmtex-env-get-previous "mode"))) + (cond ((and (== val "text") (!= old "text")) (list 'text arg)) + ((and (== val "math") (!= old "math") (ahash-ref tmtex-env :preamble)) + (list 'ensuremath arg) + ) ; + ((and (== val "math") (!= old "math")) (list '!math arg)) + ((and (== val "prog") (== old "text")) `(tt ,arg)) + ((and (== val "prog") (== old "math")) `(text (tt ,arg))) + (else arg) + ) ;cond + ) ;let + (let ((w (tmtex-get-with-cmd var val)) (a (tmtex-get-assign-cmd var val))) + (cond ((and w (tm-func? arg w 1)) arg) + ((in? w '(mathrm mathbf mathsf mathit mathtt mathsl)) + (post-process-math-text (list w arg)) + ) ; + (w (list w arg)) + (a (list '!group (tex-concat (list (list a) " " arg)))) + ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg #t)) + ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg #t)) + ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg #f)) + ((== "par-par-sep" var) (tmtex-make-parsep val arg)) + ((== var "language") (tmtex-make-lang val arg)) + ((== var "color") (tmtex-make-color val arg)) + (else arg) + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-with l) (cond ((null? l) "") ((null? (cdr l)) (tmtex (car l))) ((func? (cAr l) 'graphics) (tmtex-eps (cons 'with l))) - (else (let ((var (force-string (car l))) - (val (force-string (cadr l))) - (next (cddr l))) + (else (let ((var (force-string (car l))) (val (force-string (cadr l))) (next (cddr l))) (tmtex-env-set var val) (let ((r (tmtex-with-one var val (tmtex-with next)))) (tmtex-env-reset var) - r))))) + r + ) ;let + ) ;let + ) ;else + ) ;cond +) ;define (define (tmtex-with-wrapped l) (if (and (== (length l) 3) - (== (car l) "par-columns") - (== (cadr l) "1") - (tm-in? (caddr l) '(small-figure big-figure - small-table big-table))) - (tmtex-float-sub #t "h" (caddr l)) - (tmtex-with l))) + (== (car l) "par-columns") + (== (cadr l) "1") + (tm-in? (caddr l) '(small-figure big-figure small-table big-table)) + ) ;and + (tmtex-float-sub #t "h" (caddr l)) + (tmtex-with l) + ) ;if +) ;define (define (tmtex-var-name-sub l) - (if (null? l) l - (let ((c (car l)) (r (tmtex-var-name-sub (cdr l)))) - (cond ((char-alphabetic? c) (cons c r)) - ((char-numeric? c) - (cond ((char=? c #\0) (cons* #\z #\e #\r #\o r)) - ((char=? c #\1) (cons* #\o #\n #\e r)) - ((char=? c #\2) (cons* #\t #\w #\o r)) - ((char=? c #\3) (cons* #\t #\h #\r #\e #\e r)) - ((char=? c #\4) (cons* #\f #\o #\u #\r r)) - ((char=? c #\5) (cons* #\f #\i #\v #\e r)) - ((char=? c #\6) (cons* #\s #\i #\x r)) - ((char=? c #\7) (cons* #\s #\e #\v #\e #\n r)) - ((char=? c #\8) (cons* #\e #\i #\g #\h #\t r)) - ((char=? c #\9) (cons* #\n #\i #\n #\e r)) - (else r))) - ((and (char=? c #\*) (null? (cdr l))) (list c)) - (else r))))) + (if (null? l) + l + (let ((c (car l)) (r (tmtex-var-name-sub (cdr l)))) + (cond ((char-alphabetic? c) (cons c r)) + ((char-numeric? c) + (cond ((char=? c #\0) (cons* #\z #\e #\r #\o r)) + ((char=? c #\1) (cons* #\o #\n #\e r)) + ((char=? c #\2) (cons* #\t #\w #\o r)) + ((char=? c #\3) (cons* #\t #\h #\r #\e #\e r)) + ((char=? c #\4) (cons* #\f #\o #\u #\r r)) + ((char=? c #\5) (cons* #\f #\i #\v #\e r)) + ((char=? c #\6) (cons* #\s #\i #\x r)) + ((char=? c #\7) (cons* #\s #\e #\v #\e #\n r)) + ((char=? c #\8) (cons* #\e #\i #\g #\h #\t r)) + ((char=? c #\9) (cons* #\n #\i #\n #\e r)) + (else r) + ) ;cond + ) ; + ((and (char=? c #\*) (null? (cdr l))) (list c)) + (else r) + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-var-name var) (cond ((nstring? var) "") - ((logic-in? (string->symbol var) tmtex-protected%) - (string-append "tm" var)) + ((logic-in? (string->symbol var) tmtex-protected%) (string-append "tm" var)) ((<= (string-length var) 1) var) - (else - (with r (list->string (tmtex-var-name-sub (string->list var))) - (if (and (string-occurs? "*" r) - (== (latex-type r) "undefined")) - (string-replace r "*" "star") - r))))) + (else (with r + (list->string (tmtex-var-name-sub (string->list var))) + (if (and (string-occurs? "*" r) (== (latex-type r) "undefined")) + (string-replace r "*" "star") + r + ) ;if + ) ;with + ) ;else + ) ;cond +) ;define (define (tmtex-tex-arg l) - (cons '!arg l)) + (cons '!arg l) +) ;define (define (tmtex-args-search x args) (cond ((null? args) #f) ((== x (car args)) 1) - (else - (let ((n (tmtex-args-search x (cdr args)))) - (if n (+ 1 n) #f))))) + (else (let ((n (tmtex-args-search x (cdr args)))) (if n (+ 1 n) #f))) + ) ;cond +) ;define (define (tmtex-args-sub l args) - (if (null? l) l - (cons (tmtex-args (car l) args) - (tmtex-args-sub (cdr l) args)))) + (if (null? l) l (cons (tmtex-args (car l) args) (tmtex-args-sub (cdr l) args))) +) ;define (define (tmtex-args x args) (cond ((nlist? x) x) ((or (func? x 'arg) (func? x 'value)) (let ((n (tmtex-args-search (cadr x) args))) - (if n (list '!arg (number->string n)) (tmtex-args-sub x args)))) - (else (tmtex-args-sub x args)))) + (if n (list '!arg (number->string n)) (tmtex-args-sub x args)) + ) ;let + ) ; + (else (tmtex-args-sub x args)) + ) ;cond +) ;define (define (tmtex-assign l) (let* ((var (tmtex-var-name (car l))) (bsvar (string-append "\\" var)) (type (latex-type var)) (def (if (== type "undefined") 'newcommand 'providecommand)) - (val (cadr l))) + (val (cadr l)) + ) ; (while (func? val 'quote 1) (set! val (cadr val))) (if (!= var "") - (begin - (tmtex-env-assign var val) - (cond ((string? val) - (let ((a (tmtex-get-assign-cmd var val))) - (if a (list a) (list def bsvar (tmtex val))))) - ((or (func? val 'macro) (func? val 'func)) - (if (null? (cddr val)) - (list def bsvar (tmtex (cAr val))) - (list def bsvar - (list '!option (number->string (- (length val) 2))) - (tmtex (tmtex-args (cAr val) (cDdr val)))))) - (else (list def bsvar (tmtex val))))) - ""))) + (begin + (tmtex-env-assign var val) + (cond ((string? val) + (let ((a (tmtex-get-assign-cmd var val))) + (if a (list a) (list def bsvar (tmtex val))) + ) ;let + ) ; + ((or (func? val 'macro) (func? val 'func)) + (if (null? (cddr val)) + (list def bsvar (tmtex (cAr val))) + (list def + bsvar + (list '!option (number->string (- (length val) 2))) + (tmtex (tmtex-args (cAr val) (cDdr val))) + ) ;list + ) ;if + ) ; + (else (list def bsvar (tmtex val))) + ) ;cond + ) ;begin + "" + ) ;if + ) ;let* +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Other primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-quote l) - (tmtex (car l))) + (tmtex (car l)) +) ;define (define (tmtex-hidden-binding l) (if (and (== (length l) 2) (string->number (force-string (cAr l)))) - (list 'custombinding (force-string (cAr l))) - "")) + (list 'custombinding (force-string (cAr l))) + "" + ) ;if +) ;define (define (tmtex-label l) - (list 'label (force-string (car l)))) + (list 'label (force-string (car l))) +) ;define (define (tmtex-reference l) - (list 'ref (force-string (car l)))) + (list 'ref (force-string (car l))) +) ;define (define (tmtex-pageref l) - (list 'pageref (force-string (car l)))) + (list 'pageref (force-string (car l))) +) ;define (define (tmtex-eqref s l) - (list 'eqref (force-string (car l)))) + (list 'eqref (force-string (car l))) +) ;define (define (tmtex-smart-ref s l) - (let* ((ss (map force-string l)) - (key (string-recompose ss ","))) - (list 'Cref key))) + (let* ((ss (map force-string l)) (key (string-recompose ss ","))) + (list 'Cref key) + ) ;let* +) ;define (define (tmtex-specific l) (cond ((== (car l) "latex") (tmtex-tt (cadr l))) ((== (car l) "image") (tmtex-eps (cadr l))) ((== (car l) "printer") (tmtex (cadr l))) - ((== (car l) "odd") `(ifthispageodd ,(tmtex (cadr l)) "")) - ((== (car l) "even") `(ifthispageodd "" ,(tmtex (cadr l)))) - (else ""))) + ((== (car l) "odd") `(ifthispageodd ,(tmtex (cadr l)) ,"")) + ((== (car l) "even") `(ifthispageodd ,"" ,(tmtex (cadr l)))) + (else "") + ) ;cond +) ;define (define (tmtex-eps-names) (set! tmtex-serial (+ tmtex-serial 1)) (let* ((suffix ".pdf") (postfix (string-append "-" (number->string tmtex-serial) suffix)) (name-url (url-glue tmtex-image-root-url postfix)) - (name-string (string-append tmtex-image-root-string postfix))) - (values name-url name-string))) + (name-string (string-append tmtex-image-root-string postfix)) + ) ; + (values name-url name-string) + ) ;let* +) ;define (define (tmtex-eps x) - (if (tmtex-math-mode?) (set! x `(with "mode" "math" ,x))) - (receive (name-url name-string) (tmtex-eps-names) + (tmtex-image-increment) + (if (tmtex-math-mode?) (set! x `(with ,"mode" ,"math" ,x))) + (receive (name-url name-string) + (tmtex-eps-names) (let* ((extents (print-snippet name-url x #t)) (unit (* (/ 1.0 60984.0) (/ 600.0 (tenth extents)))) (x3 (* unit (first extents))) @@ -1828,213 +2427,276 @@ (opt `(!option ,(string-append "width=" ww ",height=" hh))) (rat (/ y3 (- y4 y3))) (dy `(!concat ,(number->string rat) (height))) - (rb `(raisebox ,dy (includegraphics ,opt ,name-string)))) + (rb `(raisebox ,dy (includegraphics ,opt ,name-string))) + ) ; ;; TODO: top and bottom margins - ;;(display* name-url ": " x1 ", " y1 "; " x2 ", " y2 "\n") - ;;(display* name-url ": " x3 ", " y3 "; " x4 ", " y4 "\n") - (if (and (< (abs (- x3 x1)) 0.01) (< (abs (- x2 x4)) 0.01)) rb - `(!concat (hspace ,lm) ,rb (hspace ,rm)))))) + ;; (display* name-url ": " x1 ", " y1 "; " x2 ", " y2 "\n") + ;; (display* name-url ": " x3 ", " y3 "; " x4 ", " y4 "\n") + (if (and (< (abs (- x3 x1)) 0.01) (< (abs (- x2 x4)) 0.01)) + rb + `(!concat (hspace ,lm) ,rb (hspace ,rm)) + ) ;if + ) ;let* + ) ;receive +) ;define (define (tmtex-make-eps s l) - (tmtex-eps (cons (string->symbol s) l))) + (tmtex-eps (cons (string->symbol s) l)) +) ;define (define (tmtex-graphics l) - (tmtex-eps (cons 'graphics l))) + (tmtex-eps (cons 'graphics l)) +) ;define (define (tmtex-as-eps name) + (tmtex-image-increment) (let* ((u (url-relative current-save-target (unix->url name))) (suffix (url-suffix u)) - (fm (string-append (format-from-suffix suffix) "-file"))) + (fm (string-append (format-from-suffix suffix) "-file")) + ) ; (if (and (url-exists? u) (in? suffix (list "eps" "pdf" "png" "jpg"))) - (with p (url->string "$TEXMACS_PATH") - (set! name (string-replace name "$TEXMACS_PATH" p)) - (set! name (string-replace name "file://" "")) - (list 'includegraphics name)) - (receive (name-url name-string) (tmtex-eps-names) - (when (string-starts? name "..") - (set! u (url-relative current-save-source (unix->url name)))) - (with nfm (if (== (url-suffix name-url) "pdf") "pdf-file" - "postscript-file") - (convert-to-file u fm nfm name-url)) - (list 'includegraphics name-string))))) + (with p + (url->string "$TEXMACS_PATH") + (set! name (string-replace name "$TEXMACS_PATH" p)) + (set! name (string-replace name "file://" "")) + (list 'includegraphics name) + ) ;with + (receive (name-url name-string) + (tmtex-eps-names) + (when (string-starts? name "..") + (set! u (url-relative current-save-source (unix->url name))) + ) ;when + (with nfm + (if (== (url-suffix name-url) "pdf") "pdf-file" "postscript-file") + (convert-to-file u fm nfm name-url) + ) ;with + (list 'includegraphics name-string) + ) ;receive + ) ;if + ) ;let* +) ;define (define (tmtex-image-length len) - (let* ((s (force-string len)) - (unit (and (tm-length? s) (tm-length-unit len)))) + (let* ((s (force-string len)) (unit (and (tm-length? s) (tm-length-unit len)))) (cond ((== s "") "!") ((string-ends? s "%") "!") ((in? unit '("w" "h")) "!") - (else (tmtex-decode-length len))))) + (else (tmtex-decode-length len)) + ) ;cond + ) ;let* +) ;define (define (tmtex-image-mag len) (let* ((s (force-string len)) (val (and (tm-length? s) (tm-length-value len))) - (unit (and (tm-length? s) (tm-length-unit len)))) + (unit (and (tm-length? s) (tm-length-unit len))) + ) ; (cond ((== s "") 0.0) ((string-ends? s "%") - (with x (string->number (string-drop-right s 1)) - (if x (/ x 100.0) 0))) + (with x (string->number (string-drop-right s 1)) (if x (/ x 100.0) 0)) + ) ; ((in? unit '("w" "h")) (or val 0)) - (else #f)))) + (else #f) + ) ;cond + ) ;let* +) ;define (define (tmtex-image l) (if (nstring? (car l)) - (tmtex-eps (cons 'image l)) - (let* ((fig (tmtex-as-eps (force-string (car l)))) - (hor (tmtex-image-length (cadr l))) - (ver (tmtex-image-length (caddr l))) - (mhor (tmtex-image-mag (cadr l))) - (mver (tmtex-image-mag (caddr l)))) - (cond ((or (not mhor) (not mver)) (list 'resizebox hor ver fig)) - ((and (== mhor 0.0) (== mver 0.0)) fig) - ((or (== mhor 1.0) (== mver 1.0)) fig) - ((== mhor 0.0) (list 'scalebox (number->string mver) fig)) - (else (list 'scalebox (number->string mhor) fig)))))) + (tmtex-eps (cons 'image l)) + (let* ((fig (tmtex-as-eps (force-string (car l)))) + (hor (tmtex-image-length (cadr l))) + (ver (tmtex-image-length (caddr l))) + (mhor (tmtex-image-mag (cadr l))) + (mver (tmtex-image-mag (caddr l))) + ) ; + (cond ((or (not mhor) (not mver)) (list 'resizebox hor ver fig)) + ((and (== mhor 0.0) (== mver 0.0)) fig) + ((or (== mhor 1.0) (== mver 1.0)) fig) + ((== mhor 0.0) (list 'scalebox (number->string mver) fig)) + (else (list 'scalebox (number->string mhor) fig)) + ) ;cond + ) ;let* + ) ;if +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Metadata for documents ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-make-inline t) - (tm-replace t '(new-line) '(next-line))) + (tm-replace t '(new-line) '(next-line)) +) ;define -(tm-define (tmtex-inline t) - (tmtex (tmtex-make-inline t))) +(tm-define (tmtex-inline t) (tmtex (tmtex-make-inline t))) -(tm-define (tmtex-doc-title t) - `(title ,(tmtex-inline (cadr t)))) +(tm-define (tmtex-doc-title t) `(title ,(tmtex-inline (cadr t)))) (tm-define (tmtex-doc-running-title t) - `(tmrunningtitle ,(tmtex-inline (cadr t)))) + `(tmrunningtitle ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-doc-subtitle t) (set! t (tmtex-remove-line-feeds t)) - `(tmsubtitle ,(tmtex-inline (cadr t)))) + `(tmsubtitle ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-doc-note t) (set! t (tmtex-remove-line-feeds t)) - `(tmnote ,(tmtex (cadr t)))) + `(tmnote ,(tmtex (cadr t))) +) ;tm-define (tm-define (tmtex-doc-misc t) (set! t (tmtex-remove-line-feeds t)) - `(tmmisc ,(tmtex (cadr t)))) + `(tmmisc ,(tmtex (cadr t))) +) ;tm-define -(tm-define (tmtex-doc-date t) - `(date ,(tmtex-inline (cadr t)))) +(tm-define (tmtex-doc-date t) `(date ,(tmtex-inline (cadr t)))) (tm-define (tmtex-doc-running-author t) - `(tmrunningauthor ,(tmtex-inline (cadr t)))) + `(tmrunningauthor ,(tmtex-inline (cadr t))) +) ;tm-define -(tm-define (tmtex-author-name t) - `(author ,(tmtex-inline (cadr t)))) +(tm-define (tmtex-author-name t) `(author ,(tmtex-inline (cadr t)))) (tm-define (tmtex-author-affiliation t) - ;;(set! t (tmtex-remove-line-feeds t)) - `(tmaffiliation ,(tmtex (cadr t)))) + ;; (set! t (tmtex-remove-line-feeds t)) + `(tmaffiliation ,(tmtex (cadr t))) +) ;tm-define (tm-define (tmtex-author-email t) (set! t (tmtex-remove-line-feeds t)) - `(tmemail ,(tmtex-inline (cadr t)))) + `(tmemail ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-author-homepage t) (set! t (tmtex-remove-line-feeds t)) - `(tmhomepage ,(tmtex-inline (cadr t)))) + `(tmhomepage ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-author-note t) (set! t (tmtex-remove-line-feeds t)) - `(tmnote ,(tmtex (cadr t)))) + `(tmnote ,(tmtex (cadr t))) +) ;tm-define (tm-define (tmtex-author-misc t) (set! t (tmtex-remove-line-feeds t)) - `(tmmisc ,(tmtex (cadr t)))) + `(tmmisc ,(tmtex (cadr t))) +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Useful macros for metadata presentation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(tm-define (tmtex-select-args-by-func n l) - (filter (lambda (x) (func? x n)) l)) +(tm-define (tmtex-select-args-by-func n l) (filter (lambda (x) (func? x n)) l)) (define (tmtex-get-transform l tag) - (let ((transform (symbol-append 'tmtex- tag)) - (l* (tmtex-select-args-by-func tag l))) - (map tmtex l*))) + (let ((transform (symbol-append 'tmtex- tag)) (l* (tmtex-select-args-by-func tag l))) + (map tmtex l*) + ) ;let +) ;define (tm-define (tmtex-remove-line-feeds t) - (if (npair? t) t - (with (r s) (list (car t) (map tmtex-remove-line-feeds (cdr t))) - (if (== r 'next-line) '(!concat (tmSep) (!linefeed)) `(,r ,@s))))) + (if (npair? t) + t + (with (r s) + (list (car t) (map tmtex-remove-line-feeds (cdr t))) + (if (== r 'next-line) '(!concat (tmSep) (!linefeed)) `(,r ,@s)) + ) ;with + ) ;if +) ;tm-define (tm-define (tmtex-replace-documents t) - (if (npair? t) t - (with (r s) (list (car t) (map tmtex-replace-documents (cdr t))) - (if (!= r 'document) `(,r ,@s) - `(concat ,@(list-intersperse s '(next-line))))))) + (if (npair? t) + t + (with (r s) + (list (car t) (map tmtex-replace-documents (cdr t))) + (if (!= r 'document) `(,r ,@s) `(concat ,@(list-intersperse s + '(next-line)))) + ) ;with + ) ;if +) ;tm-define (tm-define (contains-tags? t l) (cond ((or (nlist? t) (null? t)) #f) ((in? (car t) l) #t) - (else - (with found? #f - (for-each (lambda (x) - (set! found? (or found? (contains-tags? x l)))) - t) - found?)))) + (else (with found? + #f + (for-each (lambda (x) (set! found? (or found? (contains-tags? x l)))) t) + found? + ) ;with + ) ;else + ) ;cond +) ;tm-define (tm-define (contains-stree? t u) (cond ((== t u) #t) ((or (null? t) (nlist? t)) #f) - (else - (with found? #f - (for-each (lambda (x) - (set! found? (or found? (contains-stree? x u)))) - t) - found?)))) + (else (with found? + #f + (for-each (lambda (x) (set! found? (or found? (contains-stree? x u)))) t) + found? + ) ;with + ) ;else + ) ;cond +) ;tm-define ;; Metadata clustering (define (stree-replace l what by) (cond ((or (null? l) (nlist? l)) l) ((== l what) by) - (else - (map (lambda (x) (stree-replace x what by)) l)))) + (else (map (lambda (x) (stree-replace x what by)) l)) + ) ;cond +) ;define (define (next-stree-occurence l tag) (cond ((or (null? l) (nlist? l)) #f) ((== (car l) tag) l) - (else - (with found? #f - (map-in-order - (lambda (x) - (if (not found?) - (set! found? (next-stree-occurence x tag)))) l) - found?)))) + (else (with found? + #f + (map-in-order (lambda (x) (if (not found?) (set! found? (next-stree-occurence x tag)))) + l + ) ;map-in-order + found? + ) ;with + ) ;else + ) ;cond +) ;define (define (add-refs l n tag tr tl global-counter?) - (with streetag (next-stree-occurence (car l) tag) + (with streetag + (next-stree-occurence (car l) tag) (if (not streetag) (begin (if global-counter? (set! tmtex-ref-cnt n)) - l) - (let* ((n* (number->string n)) - (tagref (list tr n*)) + l + ) ;begin + (let* ((n* (number->string n)) + (tagref (list tr n*)) (authors (stree-replace (car l) streetag tagref)) (taglist (if (null? (cdr l)) '() (cadr l))) (taglist `(,@taglist (,tl ,n* ,(cadr streetag)))) - (l* (list authors taglist))) - (add-refs l* (1+ n) tag tr tl global-counter?))))) + (l* (list authors taglist)) + ) ; + (add-refs l* (1+ n) tag tr tl global-counter?) + ) ;let* + ) ;if + ) ;with +) ;define (tm-define (make-references l tag author? global-counter?) - (let* ((tag-ref (symbol-append tag '- 'ref)) - (tag-label (symbol-append tag '- 'label)) - (cnt (if global-counter? tmtex-ref-cnt 1)) - (tmp (add-refs `(,l) cnt tag tag-ref tag-label - global-counter?)) - (data-refs (car tmp)) - (data-labels (if (null? (cdr tmp)) '() (cadr tmp)))) - (if author? - (set! data-labels `((doc-author (author-data ,@data-labels))))) - `(,@data-refs ,@data-labels))) + (let* ((tag-ref (symbol-append tag '- 'ref)) + (tag-label (symbol-append tag '- 'label)) + (cnt (if global-counter? tmtex-ref-cnt 1)) + (tmp (add-refs `(,l) cnt tag tag-ref tag-label global-counter?)) + (data-refs (car tmp)) + (data-labels (if (null? (cdr tmp)) '() (cadr tmp))) + ) ; + (if author? (set! data-labels `((doc-author (author-data ,@data-labels))))) + `(,@data-refs ,@data-labels) + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Author metadata presentation @@ -2042,39 +2704,61 @@ (tm-define (tmtex-prepare-author-data l) l) -(tm-define (tmtex-make-author names affiliations emails urls miscs notes - affs* emails* urls* miscs* notes*) - (let* ((names (tmtex-concat-Sep (map cadr names))) - (result `(,@names ,@notes ,@miscs ,@affiliations ,@emails ,@urls))) - (if (null? result) '() - `(author (!paragraph ,@result))))) +(tm-define (tmtex-make-author names + affiliations + emails + urls + miscs + notes + affs* + emails* + urls* + miscs* + notes* + ) ;tmtex-make-author + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@notes ,@miscs ,@affiliations ,@emails ,@urls)) + ) ; + (if (null? result) '() `(author (!paragraph ,@result))) + ) ;let* +) ;tm-define (tm-define (tmtex-doc-author t) - (if (or (npair? t) (npair? (cdr t)) (not (func? (cadr t) 'author-data))) '() - (let* ((l (tmtex-prepare-author-data (cdadr t))) - (names (tmtex-get-transform l 'author-name)) - (emails (tmtex-get-transform l 'author-email)) - (urls (tmtex-get-transform l 'author-homepage)) - (affs (tmtex-get-transform l 'author-affiliation)) - (miscs (tmtex-get-transform l 'author-misc)) - (notes (tmtex-get-transform l 'author-note)) - (emails* (tmtex-get-transform l 'author-email-ref)) - (urls* (tmtex-get-transform l 'author-homepage-ref)) - (affs* (tmtex-get-transform l 'author-affiliation-ref)) - (miscs* (tmtex-get-transform l 'author-misc-ref)) - (notes* (tmtex-get-transform l 'author-note-ref)) - (affs (append affs (tmtex-get-transform - l 'author-affiliation-label))) - (urls (append urls (tmtex-get-transform - l 'author-homepage-label))) - (miscs (append miscs (tmtex-get-transform - l 'author-misc-label))) - (notes (append notes (tmtex-get-transform - l 'author-note-label))) - (emails (append emails (tmtex-get-transform - l 'author-email-label)))) - (tmtex-make-author names affs emails urls miscs notes - affs* emails* urls* miscs* notes*)))) + (if (or (npair? t) (npair? (cdr t)) (not (func? (cadr t) 'author-data))) + '() + (let* ((l (tmtex-prepare-author-data (cdadr t))) + (names (tmtex-get-transform l 'author-name)) + (emails (tmtex-get-transform l 'author-email)) + (urls (tmtex-get-transform l 'author-homepage)) + (affs (tmtex-get-transform l 'author-affiliation)) + (miscs (tmtex-get-transform l 'author-misc)) + (notes (tmtex-get-transform l 'author-note)) + (emails* (tmtex-get-transform l 'author-email-ref)) + (urls* (tmtex-get-transform l 'author-homepage-ref)) + (affs* (tmtex-get-transform l 'author-affiliation-ref)) + (miscs* (tmtex-get-transform l 'author-misc-ref)) + (notes* (tmtex-get-transform l 'author-note-ref)) + (affs (append affs (tmtex-get-transform l 'author-affiliation-label))) + (urls (append urls (tmtex-get-transform l 'author-homepage-label))) + (miscs (append miscs (tmtex-get-transform l 'author-misc-label))) + (notes (append notes (tmtex-get-transform l 'author-note-label))) + (emails (append emails (tmtex-get-transform l 'author-email-label))) + ) ; + (tmtex-make-author names + affs + emails + urls + miscs + notes + affs* + emails* + urls* + miscs* + notes* + ) ;tmtex-make-author + ) ;let* + ) ;if +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Document metadata presentation @@ -2082,100 +2766,147 @@ (tm-define (tmtex-prepare-doc-data l) (set! l (map tmtex-replace-documents l)) - l) + l +) ;tm-define (define (tmtex-make-title titles subtitles notes miscs tr) (let* ((titles (tmtex-concat-Sep (map cadr titles))) - (content `(,@titles ,@subtitles ,@notes ,@miscs))) - (if (null? content) '() - `((title (!indent (!paragraph ,@content))))))) + (content `(,@titles ,@subtitles ,@notes ,@miscs)) + ) ; + (if (null? content) '() `((title (!indent (!paragraph ,@content))))) + ) ;let* +) ;define (tm-define (tmtex-append-authors l) (set! l (filter nnull? l)) (cond ((null? l) '()) ((== (length l) 1) `((author (!indent (!concat ,@(cdar l)))))) - (else - (with lf '(!concat (!linefeed) (and) (!linefeed)) - `((author - (!indent (!concat ,@(list-intersperse (map cadr l) lf))))))))) - -(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes - subtits-l dates-l miscs-l notes-l tr ar) - `(!document - ,@(tmtex-make-title titles subtitles notes miscs tr) + (else (with lf + '(!concat (!linefeed) (and) (!linefeed)) + `((author (!indent (!concat ,@(list-intersperse (map cadr l) lf))))) + ) ;with + ) ;else + ) ;cond +) ;tm-define + +(tm-define (tmtex-make-doc-data titles + subtitles + authors + dates + miscs + notes + subtits-l + dates-l + miscs-l + notes-l + tr + ar + ) ;tmtex-make-doc-data + `(!document ,@(tmtex-make-title titles subtitles notes miscs tr) ,@(tmtex-append-authors authors) ,@dates - (maketitle))) + (maketitle)) +) ;tm-define (tm-define (tmtex-get-title-option l) - (apply append (map cdr (tmtex-select-args-by-func 'doc-title-options l)))) + (apply append (map cdr (tmtex-select-args-by-func 'doc-title-options l))) +) ;tm-define (tm-define (tmtex-doc-data s l) (set! l (tmtex-prepare-doc-data l)) - (let* ((titles (tmtex-get-transform l 'doc-title)) - (tr (tmtex-get-transform l 'doc-running-title)) - (subtits (tmtex-get-transform l 'doc-subtitle)) - (authors (tmtex-get-transform l 'doc-author)) - (ar (tmtex-get-transform l 'doc-running-author)) - (dates (tmtex-get-transform l 'doc-date)) - (miscs (tmtex-get-transform l 'doc-misc)) - (notes (tmtex-get-transform l 'doc-note)) + (let* ((titles (tmtex-get-transform l 'doc-title)) + (tr (tmtex-get-transform l 'doc-running-title)) + (subtits (tmtex-get-transform l 'doc-subtitle)) + (authors (tmtex-get-transform l 'doc-author)) + (ar (tmtex-get-transform l 'doc-running-author)) + (dates (tmtex-get-transform l 'doc-date)) + (miscs (tmtex-get-transform l 'doc-misc)) + (notes (tmtex-get-transform l 'doc-note)) (subtits-l (tmtex-get-transform l 'doc-subtitle-label)) - (dates-l (tmtex-get-transform l 'doc-date-label)) - (miscs-l (tmtex-get-transform l 'doc-misc-label)) - (notes-l (tmtex-get-transform l 'doc-note-label)) - (subtits (append subtits (tmtex-get-transform l 'doc-subtitle-ref))) - (dates (append dates (tmtex-get-transform l 'doc-date-ref))) - (miscs (append miscs (tmtex-get-transform l 'doc-misc-ref))) - (notes (append notes (tmtex-get-transform l 'doc-note-ref)))) - (tmtex-make-doc-data titles subtits authors dates miscs notes - subtits-l dates-l miscs-l notes-l tr ar))) + (dates-l (tmtex-get-transform l 'doc-date-label)) + (miscs-l (tmtex-get-transform l 'doc-misc-label)) + (notes-l (tmtex-get-transform l 'doc-note-label)) + (subtits (append subtits (tmtex-get-transform l 'doc-subtitle-ref))) + (dates (append dates (tmtex-get-transform l 'doc-date-ref))) + (miscs (append miscs (tmtex-get-transform l 'doc-misc-ref))) + (notes (append notes (tmtex-get-transform l 'doc-note-ref))) + ) ; + (tmtex-make-doc-data titles + subtits + authors + dates + miscs + notes + subtits-l + dates-l + miscs-l + notes-l + tr + ar + ) ;tmtex-make-doc-data + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Abstract metadata presentation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(tm-define (tmtex-abstract t) - (tmtex-std-env "abstract" (cdr t))) +(tm-define (tmtex-abstract t) (tmtex-std-env "abstract" (cdr t))) (tm-define (tmtex-abstract-keywords t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmkeywords) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmkeywords) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-acm t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmacm) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmacm) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-arxiv t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmarxiv) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmarxiv) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-msc t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmmsc) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmmsc) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-pacs t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmpacs) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmpacs) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) - (with result `(,@abstract ,@acm ,@arxiv ,@msc ,@pacs ,@keywords) - (if (null? result) "" `(!document ,@result)))) + (with result + `(,@abstract ,@acm ,@arxiv ,@msc ,@pacs ,@keywords) + (if (null? result) "" `(!document ,@result)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-data s l) - (let* ((acm (map tmtex-abstract-acm - (tmtex-select-args-by-func 'abstract-acm l))) - (arxiv (map tmtex-abstract-arxiv - (tmtex-select-args-by-func 'abstract-arxiv l))) - (msc (map tmtex-abstract-msc - (tmtex-select-args-by-func 'abstract-msc l))) - (pacs (map tmtex-abstract-pacs - (tmtex-select-args-by-func 'abstract-pacs l))) - (keywords (map tmtex-abstract-keywords - (tmtex-select-args-by-func 'abstract-keywords l))) - (abstract (map tmtex-abstract - (tmtex-select-args-by-func 'abstract l)))) - (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract))) + (let* ((acm (map tmtex-abstract-acm (tmtex-select-args-by-func 'abstract-acm l))) + (arxiv (map tmtex-abstract-arxiv (tmtex-select-args-by-func 'abstract-arxiv l))) + (msc (map tmtex-abstract-msc (tmtex-select-args-by-func 'abstract-msc l))) + (pacs (map tmtex-abstract-pacs (tmtex-select-args-by-func 'abstract-pacs l))) + (keywords (map tmtex-abstract-keywords (tmtex-select-args-by-func 'abstract-keywords l)) + ) ;keywords + (abstract (map tmtex-abstract (tmtex-select-args-by-func 'abstract l))) + ) ; + (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TeXmacs style primitives @@ -2183,621 +2914,819 @@ (define (tmtex-std-env s l) (if (== s "quote-env") (set! s "quote")) - (list (list '!begin s) (tmtex (car l)))) + (list (list '!begin s) (tmtex (car l))) +) ;define (define (tmtex-footnote s l) - `(footnote ,(tmtex (car l)))) + `(footnote ,(tmtex (car l))) +) ;define (define (tmtex-footnotemark s l) - `(footnotemark (!option ,(tmtex (car l))))) + `(footnotemark (!option ,(tmtex (car l)))) +) ;define (define (filter-enunciation-due-to l) (cond ((func? l 'dueto) (list l)) ((nlist>0? l) '()) - (else (append-map filter-enunciation-due-to l)))) + (else (append-map filter-enunciation-due-to l)) + ) ;cond +) ;define (define (filter-enunciation-body l) (cond ((func? l 'dueto) '()) ((nlist>0? l) l) - (else (filter nnull? (map filter-enunciation-body l))))) + (else (filter nnull? (map filter-enunciation-body l))) + ) ;cond +) ;define (define (tmtex-enunciation s l) - (let* ((t (car l)) - (option (filter-enunciation-due-to t)) + (let* ((t (car l)) + (option (filter-enunciation-due-to t)) (option* (map (lambda (x) `(!option ,(tmtex (cadr x)))) option)) - (body (filter-enunciation-body t))) - `((!begin ,s ,@option*) ,(tmtex body)))) + (body (filter-enunciation-body t)) + ) ; + `((!begin ,s ,@option*) ,(tmtex body)) + ) ;let* +) ;define (define (find-label x) (cond ((npair? x) #f) ((func? x 'label) x) - (else (or (find-label (car x)) (find-label (cdr x)))))) + (else (or (find-label (car x)) (find-label (cdr x)))) + ) ;cond +) ;define (define (remove-labels x) (cond ((npair? x) x) ((func? x 'label) "") - (else (cons (remove-labels (car x)) (remove-labels (cdr x)))))) + (else (cons (remove-labels (car x)) (remove-labels (cdr x)))) + ) ;cond +) ;define (define (tmtex-sectional s l) + (tmtex-image-increment) (let* ((lab (find-label (car l))) (tit (if lab (remove-labels (car l)) (car l))) - (sec (list (string->symbol s) (tmtex tit)))) - (if lab (list '!concat sec lab) sec))) + (sec (list (string->symbol s) (tmtex tit))) + ) ; + (if lab (list '!concat sec lab) sec) + ) ;let* +) ;define (define (tmtex-appendix s l) - (with app (list (if (latex-book-style?) 'chapter 'section) (tmtex (car l))) - (if tmtex-appendices? app + (with app + (list (if (latex-book-style?) 'chapter 'section) (tmtex (car l))) + (if tmtex-appendices? + app (begin (set! tmtex-appendices? #t) - (list '!concat '(appendix) app))))) + (list '!concat '(appendix) app) + ) ;begin + ) ;if + ) ;with +) ;define (define (tmtex-appendix* s l) - (with app (list (if (latex-book-style?) 'chapter* 'section*) (tmtex (car l))) - (if tmtex-appendices? app + (with app + (list (if (latex-book-style?) 'chapter* 'section*) (tmtex (car l))) + (if tmtex-appendices? + app (begin (set! tmtex-appendices? #t) - (list '!concat '(appendix) app))))) + (list '!concat '(appendix) app) + ) ;begin + ) ;if + ) ;with +) ;define (define (tmtex-tt-document l) (cond ((null? l) "") ((null? (cdr l)) (tmtex-tt (car l))) - (else (string-append (tmtex-tt (car l)) "\n" - (tmtex-tt-document (cdr l)))))) + (else (string-append (tmtex-tt (car l)) "\n" (tmtex-tt-document (cdr l)))) + ) ;cond +) ;define (define (tmtex-tt x) (cond ((string? x) (tmtex-verb-string x)) ((== x '(next-line)) "\n") ((func? x 'document) (tmtex-tt-document (cdr x))) ((func? x 'para) (tmtex-tt-document (cdr x))) - ((func? x 'concat) - (apply string-append (map-in-order tmtex-tt (cdr x)))) + ((func? x 'concat) (apply string-append (map-in-order tmtex-tt (cdr x)))) ((func? x 'mtm 2) (tmtex-tt (cAr x))) ((func? x 'surround 3) - (string-append (tmtex-tt (cadr x)) - (tmtex-tt (cadddr x)) - (tmtex-tt (caddr x)))) - ((or (func? x 'hgroup 1) (func? x 'vgroup 1)) - (tmtex-tt (cadr x))) + (string-append (tmtex-tt (cadr x)) (tmtex-tt (cadddr x)) (tmtex-tt (caddr x))) + ) ; + ((or (func? x 'hgroup 1) (func? x 'vgroup 1)) (tmtex-tt (cadr x))) ((func? x 'with) (begin (display* "TeXmacs] lost in verbatim content: " (cDr x) "\n") - (tmtex-tt (cAr x)))) + (tmtex-tt (cAr x)) + ) ;begin + ) ; ((func? x 'math) (begin (display* "TeXmacs] lost in verbatim content: " (cDr x) "\n") - (tmtex-tt (cAr x)))) - (else - (begin - (display* "TeXmacs] non converted verbatim content: " x "\n") - "")))) + (tmtex-tt (cAr x)) + ) ;begin + ) ; + (else (begin (display* "TeXmacs] non converted verbatim content: " x "\n") "")) + ) ;cond +) ;define (define (unescape-angles l) - (cond ((string? l) - (string-replace (string-replace l "" "<") "" ">")) + (cond ((string? l) (string-replace (string-replace l "" "<") "" ">")) ((symbol? l) l) - (else (map unescape-angles l)))) + (else (map unescape-angles l)) + ) ;cond +) ;define (define (escape-braces l) (cond ((string? l) (string-replace (string-replace l "{" "\\{") "}" "\\}")) ((symbol? l) l) - (else (map escape-braces l)))) + (else (map escape-braces l)) + ) ;cond +) ;define (define (escape-backslashes l) (cond ((string? l) (string-replace l "\\" "\\textbackslash ")) ((symbol? l) l) - (else (map escape-backslashes l)))) + (else (map escape-backslashes l)) + ) ;cond +) ;define (define (tmtex-new-theorem s l) - (with var (tmtex-var-name (car l)) + (with var + (tmtex-var-name (car l)) (ahash-set! tmtex-dynamic (string->symbol (car l)) 'environment) (ahash-set! tmtex-dynamic (string->symbol var) 'environment) - (if (and (logic-in? var latex-texmacs-theorem-environment%)) "" - `(newtheorem ,var (,@(cdr l)))))) + (if (and (logic-in? var latex-texmacs-theorem-environment%)) + "" + `(newtheorem ,var (,@(cdr l))) + ) ;if + ) ;with +) ;define (define (tmtex-verbatim s l) (if (func? (car l) 'document) - (list '!verbatim (tmtex-tt (escape-braces (escape-backslashes (car l))))) - (list 'tmverbatim (tmtex (car l))))) + (list '!verbatim (tmtex-tt (escape-braces (escape-backslashes (car l))))) + (list 'tmverbatim (tmtex (car l))) + ) ;if +) ;define (define (sharp-fix t) (cond ((and (func? t '!document) (nnull? (cdr t))) - `(!document ,(sharp-fix (cadr t)) ,@(cddr t))) + `(!document ,(sharp-fix (cadr t)) ,@(cddr t)) + ) ; ((and (func? t '!concat) (nnull? (cdr t))) - `(!concat ,(sharp-fix (cadr t)) ,@(cddr t))) - ((and (string? t) (string-starts? t "#")) - (string-append "\\" t)) - (else t))) + `(!concat ,(sharp-fix (cadr t)) ,@(cddr t)) + ) ; + ((and (string? t) (string-starts? t "#")) (string-append "\\" t)) + (else t) + ) ;cond +) ;define (define (tmtex-verbatim* s l) (if (func? (car l) 'document) - (list '!verbatim* (sharp-fix (tmtex-tt (car l)))) - (list 'tmverbatim (tmtex (car l))))) + (list '!verbatim* (sharp-fix (tmtex-tt (car l)))) + (list 'tmverbatim (tmtex (car l))) + ) ;if +) ;define (define (tmtex-code-inline s l) - (with lang `((!option ,s)) - `(tmcodeinline ,@lang ,(tmtex (car l))))) + (with lang `((!option ,s)) `(tmcodeinline ,@lang ,(tmtex (car l)))) +) ;define (define (tmtex-code-block s l) (set! l (escape-backslashes l)) (set! l (escape-braces l)) (set! s (car (string-decompose s "-"))) - (with lang (if (or (== s "verbatim") (== s "code")) '() `((!option ,s))) - `((!begin* "tmcode" ,@lang) ,(tmtex-verbatim* "" l)))) + (with lang + (if (or (== s "verbatim") (== s "code")) '() `((!option ,s))) + `((!begin* ,"tmcode" ,@lang) ,(tmtex-verbatim* "" l)) + ) ;with +) ;define (define (tmtex-add-preview-packages x) (cond ((list? x) (for-each tmtex-add-preview-packages x)) ((nstring? x) (noop)) - ((string-occurs? "tikzpicture" x) (latex-add-extra "tikz")))) + ((string-occurs? "tikzpicture" x) (latex-add-extra "tikz")) + ) ;cond +) ;define (define (tmtex-mixed s l) - (if (func? (cadr l) 'text) (set! l `("" ,(cadadr l)))) + (if (func? (cadr l) 'text) (set! l `(,"" ,(cadadr l)))) ;; (set! l (unescape-angles l)) ;; NOTE: instead, we now unescape in tmtex-verb-string (tmtex-env-set "mode" "text") - (with src (list '!verbatim* (tmtex-tt (cadr l))) + (with src + (list '!verbatim* (tmtex-tt (cadr l))) (tmtex-add-preview-packages src) (tmtex-env-reset "mode") - (list '!unindent src))) + (list '!unindent src) + ) ;with +) ;define (define (tmtex-listing s l) - (list (list '!begin "tmlisting") (tmtex (car l)))) - ;;(list (list '!begin "linenumbers") (tmtex (car l)))) + (list (list '!begin "tmlisting") (tmtex (car l))) +) ;define +;; (list (list '!begin "linenumbers") (tmtex (car l)))) (define (tmtex-minipage s l) - (let* - ((pos (car l)) - (opt (if (== pos "f") '() `((!option ,pos)))) - (size (cadr l)) - (body (caddr l))) - `((!begin "minipage" ,@opt ,(tmtex-decode-length size)) ,(tmtex body)))) + (let* ((pos (car l)) + (opt (if (== pos "f") '() `((!option ,pos)))) + (size (cadr l)) + (body (caddr l)) + ) ; + `((!begin ,"minipage" ,@opt ,(tmtex-decode-length size)) ,(tmtex body)) + ) ;let* +) ;define (define (tmtex-number-renderer l) - (let ((r (cond ((string? l) l) - ((list? l) (tmtex-number-renderer (car l))) - (else "")))) - (cond - ((== r "alpha") "alph") - ((== r "Alpha") "Alph") - (else r)))) + (let ((r (cond ((string? l) l) ((list? l) (tmtex-number-renderer (car l))) (else ""))) + ) ; + (cond ((== r "alpha") "alph") + ((== r "Alpha") "Alph") + (else r) + ) ;cond + ) ;let +) ;define (define (tmtex-number-counter l) (cond ((func? l 'value) (tmtex-number-counter (cdr l))) ((and (list? l) (== 1 (length l))) (tmtex-number-counter (car l))) ((symbol? l) (tmtex-number-counter (symbol->string l))) ((string? l) (if (string-ends? l "-nr") (string-drop-right l 3) l)) - (else ""))) + (else "") + ) ;cond +) ;define (define (tmtex-number l) - (tmtex-default - (tmtex-number-renderer (cdr l)) - (list (tmtex-number-counter (car l))))) + (tmtex-default (tmtex-number-renderer (cdr l)) + (list (tmtex-number-counter (car l))) + ) ;tmtex-default +) ;define (define (tmtex-change-case l) - (cond - ((== (cadr l) "UPCASE") (tex-apply 'MakeUppercase (tmtex (car l)))) - ((== (cadr l) "locase") (tex-apply 'MakeLowercase (tmtex (car l)))) - (else (tmtex (car l))))) + (cond ((== (cadr l) "UPCASE") (tex-apply 'MakeUppercase (tmtex (car l)))) + ((== (cadr l) "locase") (tex-apply 'MakeLowercase (tmtex (car l)))) + (else (tmtex (car l))) + ) ;cond +) ;define (define (tmtex-frame s l) - `(fbox ,(car l))) + `(fbox ,(car l)) +) ;define (define (tmtex-colored-frame s l) - `(colorbox ,(tmtex-decode-color (car l)) ,(tmtex (cadr l)))) + `(colorbox ,(tmtex-decode-color (car l)) ,(tmtex (cadr l))) +) ;define (define (tmtex-fcolorbox s l) - `(fcolorbox ,@(map tmtex-decode-color (cDr l)) ,(tmtex (cAr l)))) + `(fcolorbox ,@(map tmtex-decode-color (cDr l)) ,(tmtex (cAr l))) +) ;define (define (tmtex-rotate s l) (let* ((body (tmtex (cadr l))) - (body* (if (tmtex-math-mode?) `(ensuremath ,body) body))) - `(rotatebox (!option "origin=c") ,(tmtex (car l)) ,body*))) + (body* (if (tmtex-math-mode?) `(ensuremath ,body) body)) + ) ; + `(rotatebox (!option "origin=c") ,(tmtex (car l)) ,body*) + ) ;let* +) ;define (define (tmtex-translate s l) - (let ((from (cadr l)) - (to (caddr l)) - (body (car l))) - (tmtex (translate-from-to body from to)))) + (let ((from (cadr l)) (to (caddr l)) (body (car l))) + (tmtex (translate-from-to body from to)) + ) ;let +) ;define (define (tmtex-localize s l) - (with lan (if (list>0? tmtex-languages) (cAr tmtex-languages) "english") - (tmtex `(translate ,(car l) "english" ,lan)))) + (with lan + (if (list>0? tmtex-languages) (cAr tmtex-languages) "english") + (tmtex `(translate ,(car l) ,"english" ,lan)) + ) ;with +) ;define (define (tmtex-render-key s l) - (with body (tmtex (car l)) - (if (func? body '!concat) - (set! body `(!append ,@(cdr body)))) - `(key ,body))) + (with body + (tmtex (car l)) + (if (func? body '!concat) (set! body `(!append ,@(cdr body)))) + `(key ,body) + ) ;with +) ;define (define (tmtex-key s l) - (tmtex (tm->stree (tmdoc-key (car l))))) + (tmtex (tm->stree (tmdoc-key (car l)))) +) ;define (define (tmtex-key* s l) - (tmtex (tm->stree (tmdoc-key* (car l))))) + (tmtex (tm->stree (tmdoc-key* (car l)))) +) ;define (define (tmtex-padded-center s l) - (list (list '!begin "center") (tmtex (car l)))) + (list (list '!begin "center") (tmtex (car l))) +) ;define (define (tmtex-padded-left-aligned s l) - (list (list '!begin "flushleft") (tmtex (car l)))) + (list (list '!begin "flushleft") (tmtex (car l))) +) ;define (define (tmtex-padded-right-aligned s l) - (list (list '!begin "flushright") (tmtex (car l)))) + (list (list '!begin "flushright") (tmtex (car l))) +) ;define (define (tmtex-compact s l) - (list (list '!begin "tmcompact") (tmtex (car l)))) + (list (list '!begin "tmcompact") (tmtex (car l))) +) ;define (define (tmtex-compressed s l) - (list (list '!begin "tmcompressed") (tmtex (car l)))) + (list (list '!begin "tmcompressed") (tmtex (car l))) +) ;define (define (tmtex-amplified s l) - (list (list '!begin "tmamplified") (tmtex (car l)))) + (list (list '!begin "tmamplified") (tmtex (car l))) +) ;define (define (tmtex-indent s l) - (list (list '!begin "tmindent") (tmtex (car l)))) + (list (list '!begin "tmindent") (tmtex (car l))) +) ;define (define (tmtex-jump-in s l) - (list (list '!begin "tmjumpin") (tmtex (car l)))) + (list (list '!begin "tmjumpin") (tmtex (car l))) +) ;define (define (tmtex-script-inout s l) - (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) - (lang (car l)) + (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) + (lang (car l)) (lang* (session-name (car l))) - (in (tmtex (caddr l))) - (out (tmtex (cadddr l)))) - `(,name ,lang ,lang* ,in ,out))) + (in (tmtex (caddr l))) + (out (tmtex (cadddr l))) + ) ; + `(,name ,lang ,lang* ,in ,out) + ) ;let +) ;define (define (tmtex-converter s l) - (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) - (lang (car l)) + (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) + (lang (car l)) (lang* (format-get-name (car l))) - (in (tmtex (cadr l))) - (out (tmtex (caddr l)))) - `(,name ,lang ,lang* ,in ,out))) + (in (tmtex (cadr l))) + (out (tmtex (caddr l))) + ) ; + `(,name ,lang ,lang* ,in ,out) + ) ;let +) ;define (define (tmtex-list-env s l) (let* ((r (string-replace s "-" "")) (t (cond ((== r "enumerateRoman") "enumerateromancap") ((== r "enumerateAlpha") "enumeratealphacap") - (else r)))) - (list (list '!begin t) (tmtex (car l))))) + (else r) + ) ;cond + ) ;t + ) ; + (list (list '!begin t) (tmtex (car l))) + ) ;let* +) ;define (define (tmtex-tiny s l) - (tex-apply 'tiny (tmtex (car l)))) + (tex-apply 'tiny (tmtex (car l))) +) ;define (define (tmtex-scriptsize s l) - (tex-apply 'scriptsize (tmtex (car l)))) + (tex-apply 'scriptsize (tmtex (car l))) +) ;define (define (tmtex-footnotesize s l) - (tex-apply 'footnotesize (tmtex (car l)))) + (tex-apply 'footnotesize (tmtex (car l))) +) ;define (define (tmtex-small s l) - (tex-apply 'small (tmtex (car l)))) + (tex-apply 'small (tmtex (car l))) +) ;define (define (tmtex-normalsize s l) - (tex-apply 'normalsize (tmtex (car l)))) + (tex-apply 'normalsize (tmtex (car l))) +) ;define (define (tmtex-large s l) - (tex-apply 'large (tmtex (car l)))) + (tex-apply 'large (tmtex (car l))) +) ;define (define (tmtex-Large s l) - (tex-apply 'Large (tmtex (car l)))) + (tex-apply 'Large (tmtex (car l))) +) ;define (define (tmtex-LARGE s l) - (tex-apply 'LARGE (tmtex (car l)))) + (tex-apply 'LARGE (tmtex (car l))) +) ;define (define (tmtex-Huge s l) - (list 'Huge (tmtex (car l)))) + (list 'Huge (tmtex (car l))) +) ;define (define (tmtex-specific-language s l) - (tmtex `(with "language" ,s ,(car l)))) + (tmtex `(with ,"language" ,s ,(car l))) +) ;define (tm-define (tmtex-equation s l) + (tmtex-image-increment) (tmtex-env-set "mode" "math") (let ((r (tmtex (car l)))) (tmtex-env-reset "mode") - (if (== s "equation") - (list (list '!begin s) r) - (list '!eqn r)))) + (if (== s "equation") (list (list '!begin s) r) (list '!eqn r)) + ) ;let +) ;tm-define (define (tmtex-eqnarray s l) + (tmtex-image-increment) (tmtex-env-set "mode" "math") (let ((r (tmtex-table-apply (string->symbol s) '() (car l)))) (tmtex-env-reset "mode") - r)) + r + ) ;let +) ;define (define (tmtex-math s l) - (cond ((tm-in? (car l) '(equation equation* eqnarray eqnarray*)) - (tmtex (car l))) - ((not (tm-func? (car l) 'document)) - (tmtex `(with "mode" "math" ,(car l)))) - ((tm-func? (car l) 'document 1) - (tmtex `(math ,(cadr (car l))))) - (else - (with ps (map (lambda (x) `(math ,x)) (cdar l)) - (tmtex `(document ,@ps)))))) + (cond ((tm-in? (car l) '(equation equation* eqnarray eqnarray*)) (tmtex (car l))) + ((not (tm-func? (car l) 'document)) (tmtex `(with ,"mode" + ,"math" + ,(car l)))) + ((tm-func? (car l) 'document 1) (tmtex `(math ,(cadr (car l))))) + (else (with ps (map (lambda (x) `(math ,x)) (cdar l)) (tmtex `(document ,@ps)))) + ) ;cond +) ;define (define (tmtex-textual x) (tmtex-env-set "mode" "text") - (with r (tmtex x) - (tmtex-env-reset "mode") - r)) + (with r (tmtex x) (tmtex-env-reset "mode") r) +) ;define (define (tmtex-text s l) - (list 'text (tmtex-textual (car l)))) + (list 'text (tmtex-textual (car l))) +) ;define (define (tmtex-math-up s l) - (post-process-math-text (list 'mathrm (tmtex-textual (car l))))) + (post-process-math-text (list 'mathrm (tmtex-textual (car l)))) +) ;define (define (tmtex-math-ss s l) - (post-process-math-text (list 'mathsf (tmtex-textual (car l))))) + (post-process-math-text (list 'mathsf (tmtex-textual (car l)))) +) ;define (define (tmtex-math-tt s l) - (post-process-math-text (list 'mathtt (tmtex-textual (car l))))) + (post-process-math-text (list 'mathtt (tmtex-textual (car l)))) +) ;define (define (tmtex-math-bf s l) - (post-process-math-text (list 'mathbf (tmtex-textual (car l))))) + (post-process-math-text (list 'mathbf (tmtex-textual (car l)))) +) ;define (define (tmtex-math-sl s l) - (post-process-math-text (list 'mathsl (tmtex-textual (car l))))) + (post-process-math-text (list 'mathsl (tmtex-textual (car l)))) +) ;define (define (tmtex-math-it s l) - (post-process-math-text (list 'mathit (tmtex-textual (car l))))) + (post-process-math-text (list 'mathit (tmtex-textual (car l)))) +) ;define (define (tmtex-mathord s l) - (list 'mathord (tmtex (car l)))) + (list 'mathord (tmtex (car l))) +) ;define (define (tmtex-mathbin s l) - (list 'mathbin (tmtex (car l)))) + (list 'mathbin (tmtex (car l))) +) ;define (define (tmtex-mathrel s l) - (list 'mathrel (tmtex (car l)))) + (list 'mathrel (tmtex (car l))) +) ;define (define (tmtex-mathopen s l) - (list 'mathopen (tmtex (car l)))) + (list 'mathopen (tmtex (car l))) +) ;define (define (tmtex-mathclose s l) - (list 'mathclose (tmtex (car l)))) + (list 'mathclose (tmtex (car l))) +) ;define (define (tmtex-mathpunct s l) - (list 'mathpunct (tmtex (car l)))) + (list 'mathpunct (tmtex (car l))) +) ;define (define (tmtex-mathop s l) - (list 'mathop (tmtex (car l)))) + (list 'mathop (tmtex (car l))) +) ;define (define (tmtex-syntax l) - (tmtex (car l))) + (tmtex (car l)) +) ;define (define (tmtex-theindex s l) - (list 'printindex)) + (list 'printindex) +) ;define (define (tmtex-toc s l) - (tex-apply 'tableofcontents)) + (tex-apply 'tableofcontents) +) ;define (define (tmtex-bib-sub doc) (cond ((nlist? doc) doc) ((match? doc '(concat (bibitem* :%1) (label :string?) :*)) - (let* ((l (cadr (caddr doc))) - (s (if (string-starts? l "bib-") (string-drop l 4) l))) - (cons* 'concat (list 'bibitem* (cadadr doc) s) (cdddr doc)))) + (let* ((l (cadr (caddr doc))) (s (if (string-starts? l "bib-") (string-drop l 4) l))) + (cons* 'concat (list 'bibitem* (cadadr doc) s) (cdddr doc)) + ) ;let* + ) ; ((func? doc 'bib-list 2) (tmtex-bib-sub (cAr doc))) - (else (map tmtex-bib-sub doc)))) + (else (map tmtex-bib-sub doc)) + ) ;cond +) ;define (define (tmtex-bib-max l) (cond ((npair? l) "") ((match? l '(bibitem* :string? :%1)) (cadr l)) - (else (let* ((s1 (tmtex-bib-max (car l))) - (s2 (tmtex-bib-max (cdr l)))) - (if (< (string-length s1) (string-length s2)) s2 s1))))) + (else (let* ((s1 (tmtex-bib-max (car l))) (s2 (tmtex-bib-max (cdr l)))) + (if (< (string-length s1) (string-length s2)) s2 s1) + ) ;let* + ) ;else + ) ;cond +) ;define (tm-define (tmtex-biblio s l titled?) (if tmtex-indirect-bib? - (tex-concat (list (list 'bibliographystyle (force-string (cadr l))) - (list 'bibliography (force-string (caddr l))))) - (let* ((doc (tmtex-bib-sub (cadddr l))) - (max (tmtex-textual (tmtex-bib-max doc))) - (tls tmtex-languages) - (lan (or (and (pair? tls) (car tls)) "english")) - (txt (translate-from-to "References" "english" lan)) - (bib (tmtex (list 'thebibliography max doc)))) - (if titled? - `(!document (section* ,(tmtex txt)) ,bib) - bib)))) - -(tm-define (tmtex-bib t) - (tmtex-biblio (car t) (cdr t) #f)) + (tex-concat (list (list 'bibliographystyle (force-string (cadr l))) + (list 'bibliography (force-string (caddr l))) + ) ;list + ) ;tex-concat + (let* ((doc (tmtex-bib-sub (cadddr l))) + (max (tmtex-textual (tmtex-bib-max doc))) + (tls tmtex-languages) + (lan (or (and (pair? tls) (car tls)) "english")) + (txt (translate-from-to "References" "english" lan)) + (bib (tmtex (list 'thebibliography max doc))) + ) ; + (if titled? `(!document (section* ,(tmtex txt)) ,bib) bib) + ) ;let* + ) ;if +) ;tm-define + +(tm-define (tmtex-bib t) (tmtex-biblio (car t) (cdr t) #f)) (define (tmtex-thebibliography s l) - (list (list '!begin s (car l)) (tmtex (cadr l)))) + (list (list '!begin s (car l)) (tmtex (cadr l))) +) ;define (define (tmtex-bibitem*-std s l) - (cond ((= (length l) 1) - `(bibitem ,(car l))) - ((= (length l) 2) - `(bibitem (!option ,(tmtex (car l))) ,(cadr l))) - (else - (begin - (display* "TeXmacs] non converted bibitem content: " - (list s l) "\n") - "")))) - -(tm-define (tmtex-bibitem* s l) - (tmtex-bibitem*-std s l)) + (cond ((= (length l) 1) `(bibitem ,(car l))) + ((= (length l) 2) `(bibitem (!option ,(tmtex (car l))) ,(cadr l))) + (else (begin + (display* "TeXmacs] non converted bibitem content: " (list s l) "\n") + "" + ) ;begin + ) ;else + ) ;cond +) ;define + +(tm-define (tmtex-bibitem* s l) (tmtex-bibitem*-std s l)) (define (split-year s pos) (if (and (> pos 0) - (string>=? (substring s (- pos 1) pos) "0") - (string<=? (substring s (- pos 1) pos) "9")) - (split-year s (- pos 1)) - pos)) + (string>=? (substring s (- pos 1) pos) "0") + (string<=? (substring s (- pos 1) pos) "9") + ) ;and + (split-year s (- pos 1)) + pos + ) ;if +) ;define (define (natbibify s) - (let* ((pos (split-year s (string-length s))) + (let* ((pos (split-year s (string-length s))) (auth (substring s 0 pos)) - (year (substring s pos (string-length s)))) + (year (substring s pos (string-length s))) + ) ; (when (== (string-length year) 2) - (set! year (string-append (if (string>=? year "30") "19" "20") year))) - (string-append auth "(" year ")"))) + (set! year (string-append (if (string>=? year "30") "19" "20") year)) + ) ;when + (string-append auth "(" year ")") + ) ;let* +) ;define (tm-define (tmtex-bibitem* s l) (:mode natbib-package?) - (if (and (== (length l) 2) - (string? (cadr l)) - (not (string-occurs? "(" (cadr l)))) - (tmtex-bibitem*-std s (list (natbibify (cadr l)) (cadr l))) - (tmtex-bibitem*-std s l))) + (if (and (== (length l) 2) (string? (cadr l)) (not (string-occurs? "(" (cadr l)))) + (tmtex-bibitem*-std s (list (natbibify (cadr l)) (cadr l))) + (tmtex-bibitem*-std s l) + ) ;if +) ;tm-define (define (tmtex-figure s l) - (tmtex-float-sub #f "h" (cons (string->symbol s) l))) + (tmtex-float-sub #f "h" (cons (string->symbol s) l)) +) ;define (define (tmtex-item s l) - (tex-concat (list (list 'item) " "))) + (tex-concat (list (list 'item) " ")) +) ;define (define (tmtex-item-arg s l) - (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " "))) + (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " ")) +) ;define (define (tmtex-render-proof s l) - (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l)))) + (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l))) +) ;define (define (tmtex-nbsp s l) - '(!nbsp)) + '(!nbsp) +) ;define (define (tmtex-nbhyph s l) - '(!nbhyph)) + '(!nbhyph) +) ;define (define (tmtex-frac* s l) - (tex-concat (list (tmtex (car l)) "/" (tmtex (cadr l))))) + (tex-concat (list (tmtex (car l)) "/" (tmtex (cadr l)))) +) ;define (define (tmtex-ornament-shape s) - (if (== s "rounded") "1.7ex" "0pt")) + (if (== s "rounded") "1.7ex" "0pt") +) ;define (define (assign-ornament-env l) - (let* ((keys* (car l)) - (val (cadr l)) - (keys (cDr keys*)) - (fun (cAr keys*))) + (let* ((keys* (car l)) (val (cadr l)) (keys (cDr keys*)) (fun (cAr keys*))) (apply string-append - (list-intersperse - (map (lambda (key) - (with arg (fun val) - (if (nstring? arg) "" - (string-append key "=" arg)))) keys) ",")))) + (list-intersperse (map (lambda (key) + (with arg (fun val) (if (nstring? arg) "" (string-append key "=" arg))) + ) ;lambda + keys + ) ;map + "," + ) ;list-intersperse + ) ;apply + ) ;let* +) ;define (define (get-ornament-env) - (let* ((l1 (ahash-set->list tmtex-env)) + (let* ((l1 (ahash-set->list tmtex-env)) (l21 (map (cut logic-ref tex-ornament-opts% <>) l1)) (l22 (map (cut tmtex-env-get <>) l1)) - (l3 (map (lambda (x y) (if (and x y) (list x y) '())) l21 l22)) - (l4 (filter nnull? l3)) - (l5 (map assign-ornament-env l4))) - (apply string-append (list-intersperse l5 ",")))) + (l3 (map (lambda (x y) (if (and x y) (list x y) '())) l21 l22)) + (l4 (filter nnull? l3)) + (l5 (map assign-ornament-env l4)) + ) ; + (apply string-append (list-intersperse l5 ",")) + ) ;let* +) ;define (define (tmtex-ornamented s l) - (let* ((env (string-append "tm" s)) - (option (get-ornament-env)) - (option* (if (!= option "") `((!option ,option)) '()))) - `((!begin ,env ,@option*) ,(tmtex (car l))))) + (let* ((env (string-append "tm" s)) + (option (get-ornament-env)) + (option* (if (!= option "") `((!option ,option)) '())) + ) ; + `((!begin ,env ,@option*) ,(tmtex (car l))) + ) ;let* +) ;define (logic-table tex-ornament-opts% - ("padding-above" ("skipabove" ,tmtex-decode-length)) - ("padding-below" ("skipbelow" ,tmtex-decode-length)) - ("overlined-sep" ("innertopmargin" ,tmtex-decode-length)) - ("underlined-sep" ("innerbottommargin" ,tmtex-decode-length)) - ("framed-hsep" ("innerleftmargin" "innerrightmargin" - ,tmtex-decode-length)) - ("framed-vsep" ("innertopmargin" "innerbottommargin" - ,tmtex-decode-length)) - ("ornament-vpadding" ("innertopmargin" "innerbottommargin" - ,tmtex-decode-length)) - ("ornament-hpadding" ("innerleftmargin" "innerrightmargin" - ,tmtex-decode-length)) - ("ornament-color" ("backgroundcolor" ,tmtex-decode-color)) - ("ornament-shape" ("roundcorner" ,tmtex-ornament-shape))) + ("padding-above" ("skipabove" ,tmtex-decode-length)) + ("padding-below" ("skipbelow" ,tmtex-decode-length)) + ("overlined-sep" ("innertopmargin" ,tmtex-decode-length)) + ("underlined-sep" ("innerbottommargin" ,tmtex-decode-length)) + ("framed-hsep" ("innerleftmargin" "innerrightmargin" ,tmtex-decode-length)) + ("framed-vsep" ("innertopmargin" "innerbottommargin" ,tmtex-decode-length)) + ("ornament-vpadding" + ("innertopmargin" "innerbottommargin" ,tmtex-decode-length) + ) ; + ("ornament-hpadding" + ("innerleftmargin" "innerrightmargin" ,tmtex-decode-length) + ) ; + ("ornament-color" ("backgroundcolor" ,tmtex-decode-color)) + ("ornament-shape" ("roundcorner" ,tmtex-ornament-shape)) +) ;logic-table (define (tmtex-tm s l) - (with tag (string->symbol (string-append "tm" (string-replace s "-" ""))) - `(,tag ,@(map tmtex l)))) + (with tag + (string->symbol (string-append "tm" (string-replace s "-" ""))) + `(,tag ,@(map tmtex l)) + ) ;with +) ;define (define (tmtex-input-math s l) (let ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) - (a1 (tmtex (car l))) - (a2 (with r (begin - (tmtex-env-set "mode" "math") - (tmtex (cadr l))) - (tmtex-env-reset "mode") r))) - (list tag a1 a2))) + (a1 (tmtex (car l))) + (a2 (with r + (begin + (tmtex-env-set "mode" "math") + (tmtex (cadr l)) + ) ;begin + (tmtex-env-reset "mode") + r + ) ;with + ) ;a2 + ) ; + (list tag a1 a2) + ) ;let +) ;define (define (tmtex-fold-io-math s l) (let ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) - (a1 (tmtex (car l))) - (a2 (with r (begin - (tmtex-env-set "mode" "math") - (tmtex (cadr l))) - (tmtex-env-reset "mode") r)) - (a3 (tmtex (caddr l)))) - (list tag a1 a2 a3))) + (a1 (tmtex (car l))) + (a2 (with r + (begin + (tmtex-env-set "mode" "math") + (tmtex (cadr l)) + ) ;begin + (tmtex-env-reset "mode") + r + ) ;with + ) ;a2 + (a3 (tmtex (caddr l))) + ) ; + (list tag a1 a2 a3) + ) ;let +) ;define (define (tmtex-session s l) (let* ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) (arg (tmtex (car l))) (lan (tmtex (cadr l))) - (lst (tmtex (caddr l)))) - (if (func? lst '!document) - (set! lst `(!indent (!paragraph ,@(cdr lst))))) - `(!document (,tag ,arg ,lan ,lst)))) + (lst (tmtex (caddr l))) + ) ; + (if (func? lst '!document) (set! lst `(!indent (!paragraph ,@(cdr lst))))) + `(!document (,tag ,arg ,lan ,lst)) + ) ;let* +) ;define (define (escape-hyperref-url l) (cond ((string? l) (let* ((r1 (string-replace l "\\" "\\\\")) (r2 (string-replace r1 "#" "\\#")) - (r3 (string-replace r2 "_" "\\_"))) - r3)) + (r3 (string-replace r2 "_" "\\_")) + ) ; + r3 + ) ;let* + ) ; ((symbol? l) l) - (else (map escape-hyperref-url l)))) + (else (map escape-hyperref-url l)) + ) ;cond +) ;define (define (tmtex-hyperref u) - (tmtex-tt (escape-hyperref-url u))) + (tmtex-tt (escape-hyperref-url u)) +) ;define (define (tmtex-hlink s l) - (let* ((h (cadr l)) - (d (tmtex (car l)))) + (let* ((h (cadr l)) (d (tmtex (car l)))) (if (and (string? h) (string-starts? h "#")) - (list 'hyperref `(!option ,(string-drop h 1)) d) - (list 'href (tmtex-hyperref h) d)))) + (list 'hyperref `(!option ,(string-drop h 1)) d) + (list 'href (tmtex-hyperref h) d) + ) ;if + ) ;let* +) ;define (define (tmtex-href s l) - (list 'url (tmtex-verb-string (car l)))) + (list 'url (tmtex-verb-string (car l))) +) ;define (define (tmtex-action s l) - (list 'tmaction (tmtex (car l)) (tmtex (cadr l)))) + (list 'tmaction (tmtex (car l)) (tmtex (cadr l))) +) ;define (define (tmtex-choose s l) - (list 'binom (tmtex (car l)) (tmtex (cadr l)))) + (list 'binom (tmtex (car l)) (tmtex (cadr l))) +) ;define (define (tmtex-text-tt s l) - (if (tmtex-math-mode?) - (tmtex-math-tt s l) - (tmtex-modifier s l))) + (if (tmtex-math-mode?) (tmtex-math-tt s l) (tmtex-modifier s l)) +) ;define (define (tmtex-modifier s l) - (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l)))) + (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l))) +) ;define (define (tmtex-render-line-number s l) - (list 'tmlinenumber (tmtex (car l)) (tmtex-decode-length (tmtex (cadr l))))) + (list 'tmlinenumber (tmtex (car l)) (tmtex-decode-length (tmtex (cadr l)))) +) ;define (define (tmtex-menu-one x) - (tmtex (list 'samp x))) + (tmtex (list 'samp x)) +) ;define (define (tmtex-menu-list l) - (if (null? l) l - (cons* (list '!math (list 'rightarrow)) - (tmtex-menu-one (car l)) - (tmtex-menu-list (cdr l))))) + (if (null? l) + l + (cons* (list '!math (list 'rightarrow)) + (tmtex-menu-one (car l)) + (tmtex-menu-list (cdr l)) + ) ;cons* + ) ;if +) ;define (define (tmtex-menu s l) - (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l))))) + (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l)))) +) ;define (define ((tmtex-rename into) s l) - (tmtex-apply into (tmtex-list l))) + (tmtex-apply into (tmtex-list l)) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Citations @@ -2807,101 +3736,136 @@ (cond ((null? l) "") ((nstring? (car l)) (display* "TeXmacs] non converted citation: " (car l) "\n") - (tmtex-cite-list (cdr l))) + (tmtex-cite-list (cdr l)) + ) ; ((null? (cdr l)) (car l)) - (else (string-append (car l) "," (tmtex-cite-list (cdr l)))))) + (else (string-append (car l) "," (tmtex-cite-list (cdr l)))) + ) ;cond +) ;define -(tm-define (tmtex-cite s l) - (tex-apply 'cite (tmtex-cite-list l))) +(tm-define (tmtex-cite s l) (tex-apply 'cite (tmtex-cite-list l))) (tm-define (tmtex-cite s l) (:mode natbib-package?) - (tex-apply 'citep (tmtex-cite-list l))) + (tex-apply 'citep (tmtex-cite-list l)) +) ;tm-define (define (tmtex-nocite s l) - (tex-apply 'nocite (tmtex-cite-list l))) + (tex-apply 'nocite (tmtex-cite-list l)) +) ;define (define (tmtex-cite-TeXmacs s l) - (tex-apply 'citetexmacs (tmtex-cite-list l))) + (tex-apply 'citetexmacs (tmtex-cite-list l)) +) ;define (tm-define (tmtex-cite-detail s l) - (with c (tmtex-cite-list (list (car l))) - (tex-apply 'cite `(!option ,(tmtex (cadr l))) c))) + (with c + (tmtex-cite-list (list (car l))) + (tex-apply 'cite `(!option ,(tmtex (cadr l))) c) + ) ;with +) ;tm-define (tm-define (tmtex-cite-detail s l) (:mode natbib-package?) - (with c (tmtex-cite-list (list (car l))) - (tex-apply 'citetext `(!concat (citealp ,c) ", " ,(tmtex (cadr l)))))) + (with c + (tmtex-cite-list (list (car l))) + (tex-apply 'citetext `(!concat (citealp ,c) ,", " ,(tmtex (cadr l)))) + ) ;with +) ;tm-define (tm-define (tmtex-cite-detail-poor s l) - (with c (tmtex-cite-list (list (car l))) - `(!concat ,(tex-apply 'cite c) " (" ,(tmtex (cadr l)) ")"))) + (with c + (tmtex-cite-list (list (car l))) + `(!concat ,(tex-apply 'cite c) ," (" ,(tmtex (cadr l)) ,")") + ) ;with +) ;tm-define (define (tmtex-cite-detail-hook s l) - (tmtex-cite-detail s l)) + (tmtex-cite-detail s l) +) ;define (define (tmtex-cite-raw s l) - (tex-apply 'citealp (tmtex-cite-list l))) + (tex-apply 'citealp (tmtex-cite-list l)) +) ;define (define (tmtex-cite-raw* s l) - (tex-apply 'citealp* (tmtex-cite-list l))) + (tex-apply 'citealp* (tmtex-cite-list l)) +) ;define (define (tmtex-cite-textual s l) - (tex-apply 'citet (tmtex-cite-list l))) + (tex-apply 'citet (tmtex-cite-list l)) +) ;define (define (tmtex-cite-textual* s l) - (tex-apply 'citet* (tmtex-cite-list l))) + (tex-apply 'citet* (tmtex-cite-list l)) +) ;define (define (tmtex-cite-parenthesized s l) - (tex-apply 'citep (tmtex-cite-list l))) + (tex-apply 'citep (tmtex-cite-list l)) +) ;define (define (tmtex-cite-parenthesized* s l) - (tex-apply 'citep* (tmtex-cite-list l))) + (tex-apply 'citep* (tmtex-cite-list l)) +) ;define (define (tmtex-render-cite s l) - (tex-apply 'citetext (tmtex (car l)))) + (tex-apply 'citetext (tmtex (car l))) +) ;define (define (tmtex-cite-author s l) - (tex-apply 'citeauthor (tmtex (car l)))) + (tex-apply 'citeauthor (tmtex (car l))) +) ;define (define (tmtex-cite-author* s l) - (tex-apply 'citeauthor* (tmtex (car l)))) + (tex-apply 'citeauthor* (tmtex (car l))) +) ;define (define (tmtex-cite-year s l) - (tex-apply 'citeyear (tmtex (car l)))) + (tex-apply 'citeyear (tmtex (car l))) +) ;define (define (tmtex-natbib-triple s l) - `(protect (citeauthoryear ,@(map tmtex l)))) + `(protect (citeauthoryear ,@(map tmtex l))) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Glossaries ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-glossary s l) - (with nr (+ tmtex-auto-produce 1) + (with nr + (+ tmtex-auto-produce 1) (set! tmtex-auto-produce nr) - `(label ,(string-append "autolab" (number->string nr))))) + `(label ,(string-append "autolab" (number->string nr))) + ) ;with +) ;define (define (tmtex-glossary-entry s l) - (with nr (+ tmtex-auto-consume 1) - (with lab (string-append "autolab" (number->string nr)) + (with nr + (+ tmtex-auto-consume 1) + (with lab + (string-append "autolab" (number->string nr)) (set! tmtex-auto-consume nr) - `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab))))) + `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab)) + ) ;with + ) ;with +) ;define (define (tmtex-glossary-line t) - (with r (tmtex t) - (if (func? r 'glossaryentry) r - `(listpart ,r)))) + (with r (tmtex t) (if (func? r 'glossaryentry) r `(listpart ,r))) +) ;define (define (tmtex-glossary-body b) (if (not (tm-func? b 'document)) - (tmtex b) - (cons '!document (map-in-order tmtex-glossary-line (cdr b))))) + (tmtex b) + (cons '!document (map-in-order tmtex-glossary-line (cdr b))) + ) ;if +) ;define (define (tmtex-the-glossary s l) - `(!document - (,(if (latex-book-style?) 'chapter* 'section*) "Glossary") - ((!begin "theglossary" ,(car l)) ,(tmtex-glossary-body (cadr l))))) + `(!document (,(if (latex-book-style?) 'chapter* 'section*) ,"Glossary") + ((!begin ,"theglossary" ,(car l)) ,(tmtex-glossary-body (cadr l)))) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The main conversion routines @@ -2909,199 +3873,294 @@ (define (tmtex-apply key args) (let ((n (length args)) - (r (or (ahash-ref tmtex-dynamic key) (logic-ref tmtex-methods% key)))) + (r (or (ahash-ref tmtex-dynamic key) (logic-ref tmtex-methods% key))) + ) ; (if (in? key '(quote quasiquote unquote)) (set! r tmtex-noop)) - (cond ((== r 'environment) - (tmtex-std-env (symbol->string key) args)) + (cond ((== r 'environment) (tmtex-std-env (symbol->string key) args)) (r (r args)) - (else - (let ((p (logic-ref tmtex-tmstyle% key))) - (cond ((and p (or (= (cadr p) -1) (= (cadr p) n))) - ((car p) (symbol->string key) args)) - ((and p (= (cadr p) -2)) ((car p) `(,key ,@args))) - ((and (= n 1) - (or (func? (car args) 'tformat) - (func? (car args) 'table))) - (tmtex-table-apply key '() (car args))) - ((and (= n 2) - (or (func? (cAr args) 'tformat) - (func? (cAr args) 'table))) - (tmtex-table-apply key (cDr args) (cAr args))) - (else (tmtex-function key args)))))))) + (else (let ((p (logic-ref tmtex-tmstyle% key))) + (cond ((and p (or (= (cadr p) -1) (= (cadr p) n))) + ((car p) (symbol->string key) args) + ) ; + ((and p (= (cadr p) -2)) ((car p) `(,key ,@args))) + ((and (= n 1) (or (func? (car args) 'tformat) (func? (car args) 'table))) + (tmtex-table-apply key '() (car args)) + ) ; + ((and (= n 2) (or (func? (cAr args) 'tformat) (func? (cAr args) 'table))) + (tmtex-table-apply key (cDr args) (cAr args)) + ) ; + (else (tmtex-function key args)) + ) ;cond + ) ;let + ) ;else + ) ;cond + ) ;let +) ;define (define (tmtex-function f l) (if (== (string-ref (symbol->string f) 0) #\!) - (cons f (map-in-order tmtex l)) - (let ((v (tmtex-var-name (symbol->string f)))) - (if (== v "") "" - (apply tex-apply - (cons (string->symbol v) - (map-in-order tmtex l))))))) + (cons f (map-in-order tmtex l)) + (let ((v (tmtex-var-name (symbol->string f)))) + (if (== v "") + "" + (apply tex-apply (cons (string->symbol v) (map-in-order tmtex l))) + ) ;if + ) ;let + ) ;if +) ;define (define (tmtex-compound l) - (if (string? (car l)) - (tmtex-apply (string->symbol (car l)) (cdr l)) - "")) + (if (string? (car l)) (tmtex-apply (string->symbol (car l)) (cdr l)) "") +) ;define (define (tmtex-list l) - (map-in-order tmtex l)) + (map-in-order tmtex l) +) ;define (tm-define (tmtex x) (cond ((string? x) (tmtex-string x)) ((list>0? x) (tmtex-apply (car x) (cdr x))) - (else ""))) + (else "") + ) ;cond +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Dispatching ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (logic-dispatcher tmtex-primitives% - ((:or unknown uninit error raw-data) tmtex-error) - (document tmtex-document) - (para tmtex-para) - (surround tmtex-surround) - (concat tmtex-concat) - (rigid tmtex-rigid) - (hgroup tmtex-rigid) - (vgroup tmtex-id) - (hidden tmtex-noop) - (hspace tmtex-hspace) - (vspace* tmtex-noop) - (vspace tmtex-vspace) - (space tmtex-space) - (htab tmtex-htab) - (move tmtex-first) - (shift tmtex-first) - (resize tmtex-first) - (clipped tmtex-first) - (repeat tmtex-noop) - (float tmtex-float) - (datoms tmtex-second) - ((:or dlines dpages dbox) tmtex-noop) - (line-note tmtex-line-note) - - (with-limits tmtex-noop) - (line-break tmtex-line-break) - (new-line tmtex-new-line) - (next-line tmtex-next-line) - (emdash tmtex-emdash) - (no-break tmtex-no-break) - (no-indent tmtex-no-first-indentation) - (yes-indent tmtex-noop) - (no-indent* tmtex-noop) - (yes-indent* tmtex-noop) - (page-break* tmtex-noop) - (page-break tmtex-page-break) - (no-page-break* tmtex-noop) - (no-page-break tmtex-no-page-break) - (no-break-here* tmtex-noop) - (no-break-here tmtex-no-page-break) - (no-break-start tmtex-no-page-break) - (no-break-end tmtex-noop) - (new-page* tmtex-noop) - (new-page tmtex-new-page) - (new-dpage* tmtex-noop) - (new-dpage tmtex-noop) - - (around tmtex-around) - (around* tmtex-around*) - (big-around tmtex-big-around) - (left tmtex-left) - (mid tmtex-mid) - (right tmtex-right) - (big tmtex-big) - (long-arrow tmtex-long-arrow) - (lprime tmtex-lsup) - (rprime tmtex-rsup) - (below tmtex-below) - (above tmtex-above) - (lsub tmtex-lsub) - (lsup tmtex-lsup) - (rsub tmtex-rsub) - (rsup tmtex-rsup) - (modulo tmtex-modulo) - (frac tmtex-frac) - (sqrt tmtex-sqrt) - (wide tmtex-wide) - (neg tmtex-neg) - (wide* tmtex-wide-star) - ;;(tree tmtex-tree) - (tree tmtex-tree-eps) - - (tformat tmtex-tformat) - ((:or twith cwith tmarker) tmtex-noop) - (table tmtex-table) - ((:or row cell subtable) tmtex-noop) - - (assign tmtex-assign) - (with tmtex-with-wrapped) - (provides tmtex-noop) - (value tmtex-compound) - (quote-value tmtex-noop) - ((:or quote-value drd-props arg quote-arg) tmtex-noop) - (compound tmtex-compound) - ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop) - ;; quote missing - (quasi tmtex-noop) - ;; quasiquote missing - ;; unquote missing - ((:or unquote* copy - if if* case while for-each - extern include use-package) tmtex-noop) - (syntax tmtex-syntax) - - ((:or or xor and not plus minus times over div mod - merge length range find-file - is-tuple look-up - equal unequal less lesseq greater greatereq) tmtex-noop) - - (number tmtex-number) - (change-case tmtex-change-case) - (date tmtex-date) - - ((:or cm-length mm-length in-length pt-length - bp-length dd-length pc-length cc-length - fs-length fbs-length em-length - ln-length sep-length yfrac-length ex-length - fn-length fns-length bls-length - spc-length xspc-length par-length pag-length - gm-length gh-length) tmtex-noop) - - ((:or style-with style-with* style-only style-only* - active active* inactive inactive* - rewrite-inactive inline-tag open-tag middle-tag close-tag - symbol latex hybrid) tmtex-noop) - - ((:or tuple attr tmlen collection associate backup) tmtex-noop) - (set-binding tmtex-noop) - (get-binding tmtex-noop) - (hidden-binding tmtex-hidden-binding) - (label tmtex-label) - (reference tmtex-reference) - (pageref tmtex-pageref) - (write tmtex-noop) - (specific tmtex-specific) - ((:or tag meaning flag) tmtex-noop) - - ((:or anim-compose anim-repeat anim-constant - anim-translate anim-progressive video sound) tmtex-noop) - - (graphics tmtex-graphics) - (superpose tmtex-noop) - ((:or gr-group gr-transform - text-at cline arc carc spline spine* cspline fill) tmtex-noop) - (image tmtex-image) - ((:or box-info frame-direct frame-inverse) tmtex-noop) - - ((:or format line-sep split delay hold release - old-matrix old-table old-mosaic old-mosaic-item - set reset expand expand* hide-expand display-baloon - apply begin end func env) tmtex-noop) - - (shown tmtex-id) - (mtm tmtex-mtm) - (!file tmtex-file) - (!arg tmtex-tex-arg)) + ((:or unknown uninit error raw-data) tmtex-error) + (document tmtex-document) + (para tmtex-para) + (surround tmtex-surround) + (concat tmtex-concat) + (rigid tmtex-rigid) + (hgroup tmtex-rigid) + (vgroup tmtex-id) + (hidden tmtex-noop) + (hspace tmtex-hspace) + (vspace* tmtex-noop) + (vspace tmtex-vspace) + (space tmtex-space) + (htab tmtex-htab) + (move tmtex-first) + (shift tmtex-first) + (resize tmtex-first) + (clipped tmtex-first) + (repeat tmtex-noop) + (float tmtex-float) + (datoms tmtex-second) + ((:or dlines dpages dbox) tmtex-noop) + (line-note tmtex-line-note) + + (with-limits tmtex-noop) + (line-break tmtex-line-break) + (new-line tmtex-new-line) + (next-line tmtex-next-line) + (emdash tmtex-emdash) + (no-break tmtex-no-break) + (no-indent tmtex-no-first-indentation) + (yes-indent tmtex-noop) + (no-indent* tmtex-noop) + (yes-indent* tmtex-noop) + (page-break* tmtex-noop) + (page-break tmtex-page-break) + (no-page-break* tmtex-noop) + (no-page-break tmtex-no-page-break) + (no-break-here* tmtex-noop) + (no-break-here tmtex-no-page-break) + (no-break-start tmtex-no-page-break) + (no-break-end tmtex-noop) + (new-page* tmtex-noop) + (new-page tmtex-new-page) + (new-dpage* tmtex-noop) + (new-dpage tmtex-noop) + + (around tmtex-around) + (around* tmtex-around*) + (big-around tmtex-big-around) + (left tmtex-left) + (mid tmtex-mid) + (right tmtex-right) + (big tmtex-big) + (long-arrow tmtex-long-arrow) + (lprime tmtex-lsup) + (rprime tmtex-rsup) + (below tmtex-below) + (above tmtex-above) + (lsub tmtex-lsub) + (lsup tmtex-lsup) + (rsub tmtex-rsub) + (rsup tmtex-rsup) + (modulo tmtex-modulo) + (frac tmtex-frac) + (sqrt tmtex-sqrt) + (wide tmtex-wide) + (neg tmtex-neg) + (wide* tmtex-wide-star) + ;; (tree tmtex-tree) + (tree tmtex-tree-eps) + + (tformat tmtex-tformat) + ((:or twith cwith tmarker) tmtex-noop) + (table tmtex-table) + ((:or row cell subtable) tmtex-noop) + + (assign tmtex-assign) + (with tmtex-with-wrapped) + (provides tmtex-noop) + (value tmtex-compound) + (quote-value tmtex-noop) + ((:or quote-value drd-props arg quote-arg) tmtex-noop) + (compound tmtex-compound) + ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop) + ;; quote missing + (quasi tmtex-noop) + ;; quasiquote missing + ;; unquote missing + ((:or unquote* copy if if* case while for-each extern include use-package) + tmtex-noop + ) ; + (syntax tmtex-syntax) + + ((:or or + xor + and + not + plus + minus + times + over + div + mod + merge + length + range + find-file + is-tuple + look-up + equal + unequal + less + lesseq + greater + greatereq + ) ;:or + tmtex-noop + ) ; + + (number tmtex-number) + (change-case tmtex-change-case) + (date tmtex-date) + + ((:or cm-length + mm-length + in-length + pt-length + bp-length + dd-length + pc-length + cc-length + fs-length + fbs-length + em-length + ln-length + sep-length + yfrac-length + ex-length + fn-length + fns-length + bls-length + spc-length + xspc-length + par-length + pag-length + gm-length + gh-length + ) ;:or + tmtex-noop + ) ; + + ((:or style-with + style-with* + style-only + style-only* + active + active* + inactive + inactive* + rewrite-inactive + inline-tag + open-tag + middle-tag + close-tag + symbol + latex + hybrid + ) ;:or + tmtex-noop + ) ; + + ((:or tuple attr tmlen collection associate backup) tmtex-noop) + (set-binding tmtex-noop) + (get-binding tmtex-noop) + (hidden-binding tmtex-hidden-binding) + (label tmtex-label) + (reference tmtex-reference) + (pageref tmtex-pageref) + (write tmtex-noop) + (specific tmtex-specific) + ((:or tag meaning flag) tmtex-noop) + + ((:or anim-compose + anim-repeat + anim-constant + anim-translate + anim-progressive + video + sound + ) ;:or + tmtex-noop + ) ; + + (graphics tmtex-graphics) + (superpose tmtex-noop) + ((:or gr-group gr-transform text-at cline arc carc spline spine* cspline fill) + tmtex-noop + ) ; + (image tmtex-image) + ((:or box-info frame-direct frame-inverse) tmtex-noop) + + ((:or format + line-sep + split + delay + hold + release + old-matrix + old-table + old-mosaic + old-mosaic-item + set + reset + expand + expand* + hide-expand + display-baloon + apply + begin + end + func + env + ) ;:or + tmtex-noop + ) ; + + (shown tmtex-id) + (mtm tmtex-mtm) + (!file tmtex-file) + (!arg tmtex-tex-arg) +) ;logic-dispatcher (logic-dispatcher tmtex-extra-methods% (stack tmtex-stack) @@ -3109,319 +4168,525 @@ (phantom-float tmtex-noop) ((:or marginal-note marginal-normal-note) tmtex-marginal-note) ((:or marginal-left-note marginal-even-left-note) tmtex-marginal-left-note) - ((:or marginal-right-note marginal-even-right-note)tmtex-marginal-right-note) - (!ilx tmtex-ilx)) + ((:or marginal-right-note marginal-even-right-note) tmtex-marginal-right-note) + (!ilx tmtex-ilx) +) ;logic-dispatcher -(logic-rules - ((tmtex-methods% 'x 'y) (tmtex-primitives% 'x 'y)) - ((tmtex-methods% 'x 'y) (tmtex-extra-methods% 'x 'y))) +(logic-rules ((tmtex-methods% 'x 'y) (tmtex-primitives% 'x 'y)) + ((tmtex-methods% 'x 'y) (tmtex-extra-methods% 'x 'y)) +) ;logic-rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Expansion of all macros which are not recognized by LaTeX ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (logic-table tmtex-tmstyle% - ((:or section subsection subsubsection paragraph subparagraph part chapter) - (,tmtex-sectional 1)) - ((:or hide-preamble show-preamble) (,tmtex-default -1)) - (hide-part (,tmtex-hide-part -1)) - (show-part (,tmtex-show-part -1)) - ((:or doc-title-options author-data) (,tmtex-default -1)) - (appendix (,tmtex-appendix 1)) - (appendix* (,tmtex-appendix* 1)) - ((:or theorem proposition lemma corollary proof axiom definition - notation conjecture remark note example convention warning - acknowledgments - exercise problem question solution answer - quote-env quotation verse - theorem* proposition* lemma* corollary* axiom* definition* - notation* conjecture* remark* note* example* convention* warning* - acknowledgments* - exercise* problem* question* solution* answer*) - (,tmtex-enunciation 1)) - (new-theorem (,tmtex-new-theorem 2)) - (new-remark (,tmtex-new-theorem 2)) - (new-exercise (,tmtex-new-theorem 2)) - (verbatim (,tmtex-verbatim 1)) - (padded-center (,tmtex-padded-center 1)) - (padded-left-aligned (,tmtex-padded-left-aligned 1)) - (padded-right-aligned (,tmtex-padded-right-aligned 1)) - (compact (,tmtex-compact 1)) - (compressed (,tmtex-compressed 1)) - (amplified (,tmtex-amplified 1)) - (indent (,tmtex-indent 1)) - (jump-in (,tmtex-jump-in 1)) - (algorithm-indent (,tmtex-indent 1)) - ((:or footnote wide-footnote) (,tmtex-footnote 1)) - (footnotemark (,tmtex-default 0)) - (footnotemark* (,tmtex-footnotemark 1)) - ((:or description description-compact description-aligned - description-dash description-long description-paragraphs - itemize itemize-minus itemize-dot itemize-arrow - enumerate enumerate-numeric enumerate-numeric-bracket - enumerate-roman enumerate-roman-bracket enumerate-roman-paren - enumerate-Roman - enumerate-alpha enumerate-alpha-bracket - enumerate-alpha-full-paren enumerate-Alpha enumerate-hanzi) - (,tmtex-list-env 1)) - ((:or folded unfolded folded-plain unfolded-plain folded-std unfolded-std - folded-explain unfolded-explain folded-env unfolded-env - folded-documentation unfolded-documentation folded-grouped - unfolded-grouped summarized detailed summarized-plain summarized-std - summarized-env summarized-documentation summarized-grouped - summarized-raw summarized-tiny detailed-plain detailed-std detailed-env - detailed-documentation detailed-grouped detailed-raw detailed-tiny - unfolded-subsession folded-subsession folded-io unfolded-io - input output errput timing) - (,tmtex-tm -1)) - ((:or padded underlined overlined bothlined framed ornamented) - (,tmtex-ornamented 1)) - ((:or folded-io-math unfolded-io-math) (,tmtex-fold-io-math 3)) - (input-math (,tmtex-input-math 2)) - (session (,tmtex-session 3)) - ((:or converter-input converter-output) (,tmtex-converter 3)) - ((:or script-input script-output) (,tmtex-script-inout 4)) - (really-tiny (,tmtex-tiny 1)) - (very-tiny (,tmtex-tiny 1)) - (tiny (,tmtex-tiny 1)) - (really-small (,tmtex-scriptsize 1)) - (very-small (,tmtex-scriptsize 1)) - (smaller (,tmtex-footnotesize 1)) - (small (,tmtex-small 1)) - (flat-size (,tmtex-small 1)) - (normal-size (,tmtex-normalsize 1)) - (sharp-size (,tmtex-large 1)) - (large (,tmtex-large 1)) - (larger (,tmtex-Large 1)) - (very-large (,tmtex-LARGE 1)) - (really-large (,tmtex-LARGE 1)) - (really-huge (,tmtex-Huge 1)) - ((:or british bulgarian chinese croatian czech danish dutch english - esperanto finnish french german greek hungarian italian japanese - korean polish portuguese romanian russian slovak slovene spanish - swedish chineset ukrainian) - (,tmtex-specific-language 1)) - - (math (,tmtex-math 1)) - (text (,tmtex-text 1)) - (math-up (,tmtex-math-up 1)) - (math-ss (,tmtex-math-ss 1)) - (math-tt (,tmtex-math-tt 1)) - (math-bf (,tmtex-math-bf 1)) - (math-sl (,tmtex-math-sl 1)) - (math-it (,tmtex-math-it 1)) - (math-separator (,tmtex-mathpunct 1)) - (math-quantifier (,tmtex-mathord 1)) - (math-imply (,tmtex-mathbin 1)) - (math-or (,tmtex-mathbin 1)) - (math-and (,tmtex-mathbin 1)) - (math-not (,tmtex-mathord 1)) - (math-relation (,tmtex-mathrel 1)) - (math-union (,tmtex-mathbin 1)) - (math-intersection (,tmtex-mathbin 1)) - (math-exclude (,tmtex-mathbin 1)) - (math-plus (,tmtex-mathbin 1)) - (math-minus (,tmtex-mathbin 1)) - (math-times (,tmtex-mathbin 1)) - (math-over (,tmtex-mathbin 1)) - (math-big (,tmtex-mathop 1)) - (math-prefix (,tmtex-mathord 1)) - (math-postfix (,tmtex-mathord 1)) - (math-open (,tmtex-mathopen 1)) - (math-close (,tmtex-mathclose 1)) - (math-ordinary (,tmtex-mathord 1)) - (math-ignore (,tmtex-mathord 1)) - ((:or eqnarray eqnarray* leqnarray* - gather multline gather* multline* align - flalign alignat align* flalign* alignat*) (,tmtex-eqnarray 1)) - - (eq-number (,tmtex-default -1)) - (separating-space (,tmtex-hspace* 1)) - (application-space (,tmtex-hspace* 1)) - - ((:or code cpp-code mmx-code scm-code shell-code scilab-code verbatim-code) - (,tmtex-code-block 1)) - ((:or mmx cpp scm shell scilab) (,tmtex-code-inline 1)) - - (frame (,tmtex-frame 1)) - (colored-frame (,tmtex-colored-frame 2)) - (fcolorbox (,tmtex-fcolorbox 3)) - (rotate (,tmtex-rotate 2)) - (condensed (,tmtex-style-first 1)) - (translate (,tmtex-translate 3)) - (localize (,tmtex-localize 1)) - (render-key (,tmtex-render-key 1)) - (key (,tmtex-key 1)) - (key* (,tmtex-key* 1)) - (minipage (,tmtex-minipage 3)) - (latex_preview (,tmtex-mixed 2)) - (picture-mixed (,tmtex-mixed 2)) - (source-mixed (,tmtex-mixed 2)) - (listing (,tmtex-listing 1)) - (draw-over (,tmtex-make-eps 3)) - (draw-under (,tmtex-make-eps 3)) - (version-old (,tmtex-style-first 2)) - (version-both (,tmtex-style-second 2)) - (version-new (,tmtex-style-second 2)) - (the-index (,tmtex-theindex -1)) - (glossary (,tmtex-glossary 1)) - (glossary-explain (,tmtex-glossary 2)) - (glossary-2 (,tmtex-glossary-entry 3)) - (the-glossary (,tmtex-the-glossary 2)) - ((:or table-of-contents) (,tmtex-toc 2)) - (thebibliography (,tmtex-thebibliography 2)) - (bib-list (,tmtex-style-second 2)) - (bibitem* (,tmtex-bibitem* -1)) - ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2)) - (item (,tmtex-item 0)) - (item* (,tmtex-item-arg 1)) - (render-proof (,tmtex-render-proof 2)) - (nbsp (,tmtex-nbsp 0)) - (nbhyph (,tmtex-nbhyph 0)) - (hrule (,tmtex-hrule 0)) - (frac* (,tmtex-frac* 2)) - (hlink (,tmtex-hlink 2)) - (action (,tmtex-action -1)) - (href (,tmtex-href 1)) - (slink (,tmtex-href 1)) - (eqref (,tmtex-eqref 1)) - (smart-ref (,tmtex-smart-ref -1)) - (choose (,tmtex-choose 2)) - (tt (,tmtex-text-tt 1)) - ((:or strong em name samp abbr dfn kbd var acronym person) - (,tmtex-modifier 1)) - (render-line-number (,tmtex-render-line-number 2)) - (menu (,tmtex-menu -1)) - (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0)) - (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0)) - (cite-website (,(tmtex-rename 'citewebsite) 0)) - (tm-made (,(tmtex-rename 'tmmade) 0)) - (cite (,tmtex-cite -1)) - (nocite (,tmtex-nocite -1)) - (cite-TeXmacs (,tmtex-cite-TeXmacs -1)) - (cite-detail (,tmtex-cite-detail-hook 2)) - (cite-raw (,tmtex-cite-raw -1)) - (cite-raw* (,tmtex-cite-raw* -1)) - (cite-textual (,tmtex-cite-textual -1)) - (cite-textual* (,tmtex-cite-textual* -1)) - (cite-parenthesized (,tmtex-cite-parenthesized -1)) - (cite-parenthesized* (,tmtex-cite-parenthesized* -1)) - (citet (,tmtex-cite-textual -1)) - (citet* (,tmtex-cite-textual* -1)) - (citep (,tmtex-cite-parenthesized -1)) - (citep* (,tmtex-cite-parenthesized* -1)) - (render-cite (,tmtex-render-cite 1)) - ((:or cite-author cite-author-link) (,tmtex-cite-author 1)) - ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1)) - ((:or cite-year cite-year-link) (,tmtex-cite-year 1)) - (natbib-triple (,tmtex-natbib-triple 3)) - (natexlab (,tmtex-noop -1)) - - ;; FIXME: we should do something more useful with this information - (set-header (,tmtex-noop -1)) - (set-footer (,tmtex-noop -1)) - (set-this-page-header (,tmtex-noop -1)) - (set-this-page-footer (,tmtex-noop -1))) + ((:or section subsection subsubsection paragraph subparagraph part chapter) + (,tmtex-sectional 1) + ) ; + ((:or hide-preamble show-preamble) (,tmtex-default -1)) + (hide-part (,tmtex-hide-part -1)) + (show-part (,tmtex-show-part -1)) + ((:or doc-title-options author-data) (,tmtex-default -1)) + (appendix (,tmtex-appendix 1)) + (appendix* (,tmtex-appendix* 1)) + ((:or theorem + proposition + lemma + corollary + proof + axiom + definition + notation + conjecture + remark + note + example + convention + warning + acknowledgments + exercise + problem + question + solution + answer + quote-env + quotation + verse + theorem* + proposition* + lemma* + corollary* + axiom* + definition* + notation* + conjecture* + remark* + note* + example* + convention* + warning* + acknowledgments* + exercise* + problem* + question* + solution* + answer* + ) ;:or + (,tmtex-enunciation 1) + ) ; + (new-theorem (,tmtex-new-theorem 2)) + (new-remark (,tmtex-new-theorem 2)) + (new-exercise (,tmtex-new-theorem 2)) + (verbatim (,tmtex-verbatim 1)) + (padded-center (,tmtex-padded-center 1)) + (padded-left-aligned (,tmtex-padded-left-aligned 1)) + (padded-right-aligned (,tmtex-padded-right-aligned 1)) + (compact (,tmtex-compact 1)) + (compressed (,tmtex-compressed 1)) + (amplified (,tmtex-amplified 1)) + (indent (,tmtex-indent 1)) + (jump-in (,tmtex-jump-in 1)) + (algorithm-indent (,tmtex-indent 1)) + ((:or footnote wide-footnote) (,tmtex-footnote 1)) + (footnotemark (,tmtex-default 0)) + (footnotemark* (,tmtex-footnotemark 1)) + ((:or description + description-compact + description-aligned + description-dash + description-long + description-paragraphs + itemize + itemize-minus + itemize-dot + itemize-arrow + enumerate + enumerate-numeric + enumerate-numeric-bracket + enumerate-roman + enumerate-roman-bracket + enumerate-roman-paren + enumerate-Roman + enumerate-alpha + enumerate-alpha-bracket + enumerate-alpha-full-paren + enumerate-Alpha + enumerate-hanzi + ) ;:or + (,tmtex-list-env 1) + ) ; + ((:or folded + unfolded + folded-plain + unfolded-plain + folded-std + unfolded-std + folded-explain + unfolded-explain + folded-env + unfolded-env + folded-documentation + unfolded-documentation + folded-grouped + unfolded-grouped + summarized + detailed + summarized-plain + summarized-std + summarized-env + summarized-documentation + summarized-grouped + summarized-raw + summarized-tiny + detailed-plain + detailed-std + detailed-env + detailed-documentation + detailed-grouped + detailed-raw + detailed-tiny + unfolded-subsession + folded-subsession + folded-io + unfolded-io + input + output + errput + timing + ) ;:or + (,tmtex-tm -1) + ) ; + ((:or padded underlined overlined bothlined framed ornamented) + (,tmtex-ornamented 1) + ) ; + ((:or folded-io-math unfolded-io-math) (,tmtex-fold-io-math 3)) + (input-math (,tmtex-input-math 2)) + (session (,tmtex-session 3)) + ((:or converter-input converter-output) (,tmtex-converter 3)) + ((:or script-input script-output) (,tmtex-script-inout 4)) + (really-tiny (,tmtex-tiny 1)) + (very-tiny (,tmtex-tiny 1)) + (tiny (,tmtex-tiny 1)) + (really-small (,tmtex-scriptsize 1)) + (very-small (,tmtex-scriptsize 1)) + (smaller (,tmtex-footnotesize 1)) + (small (,tmtex-small 1)) + (flat-size (,tmtex-small 1)) + (normal-size (,tmtex-normalsize 1)) + (sharp-size (,tmtex-large 1)) + (large (,tmtex-large 1)) + (larger (,tmtex-Large 1)) + (very-large (,tmtex-LARGE 1)) + (really-large (,tmtex-LARGE 1)) + (really-huge (,tmtex-Huge 1)) + ((:or british + bulgarian + chinese + croatian + czech + danish + dutch + english + esperanto + finnish + french + german + greek + hungarian + italian + japanese + korean + polish + portuguese + romanian + russian + slovak + slovene + spanish + swedish + chineset + ukrainian + ) ;:or + (,tmtex-specific-language 1) + ) ; + + (math (,tmtex-math 1)) + (text (,tmtex-text 1)) + (math-up (,tmtex-math-up 1)) + (math-ss (,tmtex-math-ss 1)) + (math-tt (,tmtex-math-tt 1)) + (math-bf (,tmtex-math-bf 1)) + (math-sl (,tmtex-math-sl 1)) + (math-it (,tmtex-math-it 1)) + (math-separator (,tmtex-mathpunct 1)) + (math-quantifier (,tmtex-mathord 1)) + (math-imply (,tmtex-mathbin 1)) + (math-or (,tmtex-mathbin 1)) + (math-and (,tmtex-mathbin 1)) + (math-not (,tmtex-mathord 1)) + (math-relation (,tmtex-mathrel 1)) + (math-union (,tmtex-mathbin 1)) + (math-intersection (,tmtex-mathbin 1)) + (math-exclude (,tmtex-mathbin 1)) + (math-plus (,tmtex-mathbin 1)) + (math-minus (,tmtex-mathbin 1)) + (math-times (,tmtex-mathbin 1)) + (math-over (,tmtex-mathbin 1)) + (math-big (,tmtex-mathop 1)) + (math-prefix (,tmtex-mathord 1)) + (math-postfix (,tmtex-mathord 1)) + (math-open (,tmtex-mathopen 1)) + (math-close (,tmtex-mathclose 1)) + (math-ordinary (,tmtex-mathord 1)) + (math-ignore (,tmtex-mathord 1)) + ((:or eqnarray + eqnarray* + leqnarray* + gather + multline + gather* + multline* + align + flalign + alignat + align* + flalign* + alignat* + ) ;:or + (,tmtex-eqnarray 1) + ) ; + + (eq-number (,tmtex-default -1)) + (separating-space (,tmtex-hspace* 1)) + (application-space (,tmtex-hspace* 1)) + + ((:or code cpp-code mmx-code scm-code shell-code scilab-code verbatim-code) + (,tmtex-code-block 1) + ) ; + ((:or mmx cpp scm shell scilab) (,tmtex-code-inline 1)) + + (frame (,tmtex-frame 1)) + (colored-frame (,tmtex-colored-frame 2)) + (fcolorbox (,tmtex-fcolorbox 3)) + (rotate (,tmtex-rotate 2)) + (condensed (,tmtex-style-first 1)) + (translate (,tmtex-translate 3)) + (localize (,tmtex-localize 1)) + (render-key (,tmtex-render-key 1)) + (key (,tmtex-key 1)) + (key* (,tmtex-key* 1)) + (minipage (,tmtex-minipage 3)) + (latex_preview (,tmtex-mixed 2)) + (picture-mixed (,tmtex-mixed 2)) + (source-mixed (,tmtex-mixed 2)) + (listing (,tmtex-listing 1)) + (draw-over (,tmtex-make-eps 3)) + (draw-under (,tmtex-make-eps 3)) + (version-old (,tmtex-style-first 2)) + (version-both (,tmtex-style-second 2)) + (version-new (,tmtex-style-second 2)) + (the-index (,tmtex-theindex -1)) + (glossary (,tmtex-glossary 1)) + (glossary-explain (,tmtex-glossary 2)) + (glossary-2 (,tmtex-glossary-entry 3)) + (the-glossary (,tmtex-the-glossary 2)) + ((:or table-of-contents) (,tmtex-toc 2)) + (thebibliography (,tmtex-thebibliography 2)) + (bib-list (,tmtex-style-second 2)) + (bibitem* (,tmtex-bibitem* -1)) + ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2)) + (item (,tmtex-item 0)) + (item* (,tmtex-item-arg 1)) + (render-proof (,tmtex-render-proof 2)) + (nbsp (,tmtex-nbsp 0)) + (nbhyph (,tmtex-nbhyph 0)) + (hrule (,tmtex-hrule 0)) + (frac* (,tmtex-frac* 2)) + (hlink (,tmtex-hlink 2)) + (action (,tmtex-action -1)) + (href (,tmtex-href 1)) + (slink (,tmtex-href 1)) + (eqref (,tmtex-eqref 1)) + (smart-ref (,tmtex-smart-ref -1)) + (choose (,tmtex-choose 2)) + (tt (,tmtex-text-tt 1)) + ((:or strong em name samp abbr dfn kbd var acronym person) (,tmtex-modifier 1)) + (render-line-number (,tmtex-render-line-number 2)) + (menu (,tmtex-menu -1)) + (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0)) + (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0)) + (cite-website (,(tmtex-rename 'citewebsite) 0)) + (tm-made (,(tmtex-rename 'tmmade) 0)) + (cite (,tmtex-cite -1)) + (nocite (,tmtex-nocite -1)) + (cite-TeXmacs (,tmtex-cite-TeXmacs -1)) + (cite-detail (,tmtex-cite-detail-hook 2)) + (cite-raw (,tmtex-cite-raw -1)) + (cite-raw* (,tmtex-cite-raw* -1)) + (cite-textual (,tmtex-cite-textual -1)) + (cite-textual* (,tmtex-cite-textual* -1)) + (cite-parenthesized (,tmtex-cite-parenthesized -1)) + (cite-parenthesized* (,tmtex-cite-parenthesized* -1)) + (citet (,tmtex-cite-textual -1)) + (citet* (,tmtex-cite-textual* -1)) + (citep (,tmtex-cite-parenthesized -1)) + (citep* (,tmtex-cite-parenthesized* -1)) + (render-cite (,tmtex-render-cite 1)) + ((:or cite-author cite-author-link) (,tmtex-cite-author 1)) + ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1)) + ((:or cite-year cite-year-link) (,tmtex-cite-year 1)) + (natbib-triple (,tmtex-natbib-triple 3)) + (natexlab (,tmtex-noop -1)) + + ;; FIXME: we should do something more useful with this information + (set-header (,tmtex-noop -1)) + (set-footer (,tmtex-noop -1)) + (set-this-page-header (,tmtex-noop -1)) + (set-this-page-footer (,tmtex-noop -1)) +) ;logic-table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tags which are customized in particular style files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (tm-define (style-dependent-declare x) - (with (tag fun narg) x - (with fun+bis (symbol-append fun '+bis) + (with (tag fun narg) + x + (with fun+bis + (symbol-append fun '+bis) (if (== narg 2) `(begin - (when (not (defined? ',fun)) + (when (not (defined? (quote ,fun))) (tm-define (,fun s l) (tmtex-function (string->symbol s) l))) - (when (not (defined? ',fun+bis)) + (when (not (defined? (quote ,fun+bis))) (tm-define (,fun+bis s l) (,fun s l)))) `(begin - (when (not (defined? ',fun)) + (when (not (defined? (quote ,fun))) (tm-define (,fun t) (tmtex-function (string->symbol (car t)) (cdr t)))) - (when (not (defined? ',fun+bis)) + (when (not (defined? (quote ,fun+bis))) (tm-define (,fun+bis s l) - (,fun (append (list (string->symbol s)) l))))))))) + (,fun (append (list (string->symbol s)) l))))) + ) ;if + ) ;with + ) ;with +) ;tm-define (tm-define (style-dependent-transform x) - (with (tag fun narg) x - (with fun+bis (symbol-append fun '+bis) - `(,tag (,(list 'unquote fun+bis) -1))))) + (with (tag fun narg) + x + (with fun+bis (symbol-append fun '+bis) `(,tag + (,(list 'unquote fun+bis) ,-1))) + ) ;with +) ;tm-define (define-macro (tmtex-style-dependent . l) `(begin ,@(map style-dependent-declare l) - (logic-table tmtex-tmstyle% ,@(map style-dependent-transform l)))) + (logic-table tmtex-tmstyle% ,@(map style-dependent-transform l))) +) ;define-macro (tmtex-style-dependent ;; to be removed - (doc-data tmtex-doc-data 2) - (abstract-data tmtex-abstract-data 2) + (doc-data tmtex-doc-data 2) + (abstract-data tmtex-abstract-data 2) ;; abstract markup - (abstract tmtex-abstract 1) - (abstract-acm tmtex-abstract-acm 1) - (abstract-arxiv tmtex-abstract-arxiv 1) - (abstract-msc tmtex-abstract-msc 1) - (abstract-pacs tmtex-abstract-pacs 1) - (abstract-keywords tmtex-abstract-keywords 1) + (abstract tmtex-abstract 1) + (abstract-acm tmtex-abstract-acm 1) + (abstract-arxiv tmtex-abstract-arxiv 1) + (abstract-msc tmtex-abstract-msc 1) + (abstract-pacs tmtex-abstract-pacs 1) + (abstract-keywords tmtex-abstract-keywords 1) ;; metadata markup - (doc-title tmtex-doc-title 1) - (doc-running-title tmtex-doc-running-title 1) - (doc-subtitle tmtex-doc-subtitle 1) - (doc-note tmtex-doc-note 1) - (doc-misc tmtex-doc-misc 1) - (doc-date tmtex-doc-date 1) - (doc-running-author tmtex-doc-running-author 1) - (doc-author tmtex-doc-author 1) - (author-name tmtex-author-name 1) - (author-affiliation tmtex-author-affiliation 1) - (author-misc tmtex-author-misc 1) - (author-note tmtex-author-note 1) - (author-email tmtex-author-email 1) - (author-homepage tmtex-author-homepage 1) + (doc-title tmtex-doc-title 1) + (doc-running-title tmtex-doc-running-title 1) + (doc-subtitle tmtex-doc-subtitle 1) + (doc-note tmtex-doc-note 1) + (doc-misc tmtex-doc-misc 1) + (doc-date tmtex-doc-date 1) + (doc-running-author tmtex-doc-running-author 1) + (doc-author tmtex-doc-author 1) + (author-name tmtex-author-name 1) + (author-affiliation tmtex-author-affiliation 1) + (author-misc tmtex-author-misc 1) + (author-note tmtex-author-note 1) + (author-email tmtex-author-email 1) + (author-homepage tmtex-author-homepage 1) ;; references - (doc-subtitle-ref tmtex-doc-subtitle-ref 2) - (doc-date-ref tmtex-doc-date-ref 2) - (doc-note-ref tmtex-doc-note-ref 2) - (doc-misc-ref tmtex-doc-misc-ref 2) - (author-affiliation-ref tmtex-author-affiliation-ref 2) - (author-email-ref tmtex-author-email-ref 2) - (author-homepage-ref tmtex-author-homepage-ref 2) - (author-note-ref tmtex-author-note-ref 2) - (author-misc-ref tmtex-author-misc-ref 2) + (doc-subtitle-ref tmtex-doc-subtitle-ref 2) + (doc-date-ref tmtex-doc-date-ref 2) + (doc-note-ref tmtex-doc-note-ref 2) + (doc-misc-ref tmtex-doc-misc-ref 2) + (author-affiliation-ref tmtex-author-affiliation-ref 2) + (author-email-ref tmtex-author-email-ref 2) + (author-homepage-ref tmtex-author-homepage-ref 2) + (author-note-ref tmtex-author-note-ref 2) + (author-misc-ref tmtex-author-misc-ref 2) ;; labels - (doc-subtitle-label tmtex-doc-subtitle-label 2) - (doc-date-label tmtex-doc-date-label 2) - (doc-note-label tmtex-doc-note-label 2) - (doc-misc-label tmtex-doc-misc-label 2) + (doc-subtitle-label tmtex-doc-subtitle-label 2) + (doc-date-label tmtex-doc-date-label 2) + (doc-note-label tmtex-doc-note-label 2) + (doc-misc-label tmtex-doc-misc-label 2) (author-affiliation-label tmtex-author-affiliation-label 2) - (author-email-label tmtex-author-email-label 2) - (author-homepage-label tmtex-author-homepage-label 2) - (author-note-label tmtex-author-note-label 2) - (author-misc-label tmtex-author-misc-label 2) + (author-email-label tmtex-author-email-label 2) + (author-homepage-label tmtex-author-homepage-label 2) + (author-note-label tmtex-author-note-label 2) + (author-misc-label tmtex-author-misc-label 2) ;; misc ((:or equation equation*) tmtex-equation 2) - (bibliography tmtex-bib 4) - (elsevier-frontmatter tmtex-elsevier-frontmatter 2) - (conferenceinfo tmtex-acm-conferenceinfo 2) - (CopyrightYear tmtex-acm-copyright-year 2) - (slide tmtex-beamer-slide 2) - (tit tmtex-beamer-tit 2) - (crdata tmtex-acm-crdata 2)) + (bibliography tmtex-bib 4) + (elsevier-frontmatter tmtex-elsevier-frontmatter 2) + (conferenceinfo tmtex-acm-conferenceinfo 2) + (CopyrightYear tmtex-acm-copyright-year 2) + (slide tmtex-beamer-slide 2) + (tit tmtex-beamer-tit 2) + (crdata tmtex-acm-crdata 2) +) ;tmtex-style-dependent ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Protected tags ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (logic-group tmtex-protected% - a b c d i j k l o r t u v H L O P S - aa ae bf cr dh dj dp em fi ge gg ht if in it le lg ll lu lq mp mu - ne ng ni nu oe or pi pm rm rq sb sc sf sl sp ss th tt wd wp wr xi - AA AE DH DJ Im NG OE Pi Pr Re SS TH Xi) - -(logic-group tmtex-protected-symbol% - space) + a + b + c + d + i + j + k + l + o + r + t + u + v + H + L + O + P + S + aa + ae + bf + cr + dh + dj + dp + em + fi + ge + gg + ht + if + in + it + le + lg + ll + lu + lq + mp + mu + ne + ng + ni + nu + oe + or + pi + pm + rm + rq + sb + sc + sf + sl + sp + ss + th + tt + wd + wp + wr + xi + AA + AE + DH + DJ + Im + NG + OE + Pi + Pr + Re + SS + TH + Xi +) ;logic-group + +(logic-group tmtex-protected-symbol% space) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Expansion of all macros which are not recognized by LaTeX @@ -3431,81 +4696,171 @@ (define (user-definition? x) (or (and (func? x 'new-theorem 2) (string? (cadr x))) - (and (func? x 'assign 2) (string? (cadr x))))) + (and (func? x 'assign 2) (string? (cadr x))) + ) ;or +) ;define (define (collect-user-defs-sub t) (cond ((npair? t) (noop)) ((user-definition? t) - (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t)) - (else (for-each collect-user-defs-sub (cdr t))))) + (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t) + ) ; + (else (for-each collect-user-defs-sub (cdr t))) + ) ;cond +) ;define (define (collect-user-defs t) (set! tmtex-user-defs-table (make-ahash-table)) (collect-user-defs-sub (cons 'document (tmtex-filter-preamble t))) - (ahash-set->list tmtex-user-defs-table)) + (ahash-set->list tmtex-user-defs-table) +) ;define (define (as-string sym) - (with s (symbol->string sym) - (if (string-starts? s "begin-") - (substring s 6 (string-length s)) - s))) + (with s + (symbol->string sym) + (if (string-starts? s "begin-") (substring s 6 (string-length s)) s) + ) ;with +) ;define (define (logic-first-list name) (let* ((l1 (query (cons name '('first 'second)))) - (l2 (map (cut assoc-ref <> 'first) l1))) - (map as-string l2))) + (l2 (map (cut assoc-ref <> 'first) l1)) + ) ; + (map as-string l2) + ) ;let* +) ;define (define (collect-user-macros-in t h) (when (tm-compound? t) (when (tree-label-extension? (tm-label t)) - (ahash-set! h (symbol->string (tm-label t)) #t)) - (for-each (cut collect-user-macros-in <> h) (tm-children t)))) + (ahash-set! h (symbol->string (tm-label t)) #t) + ) ;when + (for-each (cut collect-user-macros-in <> h) (tm-children t)) + ) ;when +) ;define (define (collect-user-macros t) - (with h (make-ahash-table) - (collect-user-macros-in t h) - (ahash-set->list h))) + (with h (make-ahash-table) (collect-user-macros-in t h) (ahash-set->list h)) +) ;define (define (tmtex-env-macro name) - `(associate ,name (xmacro "x" (eval-args "x")))) + `(associate ,name (xmacro "x" (eval-args "x"))) +) ;define (define tmtex-always-expand ;; FIXME: find a cleaner way to handle these environments - (list "render-theorem" "render-remark" "render-exercise" "render-proof" - "algorithm" "algorithm*" "named-algorithm" "named-algorithm-old" - "specified-algorithm" "specified-algorithm*" - "named-specified-algorithm" "algorithm-body" "numbered" - - "short-item" "short-question" - "question-arabic" "question-alpha" "question-Alpha" - "question-roman" "question-Roman" "question-item" - "answer-arabic" "answer-alpha" "answer-Alpha" - "answer-roman" "answer-Roman" "answer-item" - - "gap" "gap-dots" "gap-underlined" "gap-box" - "gap-wide" "gap-dots-wide" "gap-underlined-wide" "gap-box-wide" - "gap-long" "gap-dots-long" "gap-underlined-long" "gap-box-long" - - "with-button-box" "with-button-box*" - "with-button-circle" "with-button-circle*" - "with-button-arabic" "with-button-alpha" "with-button-Alpha" - "with-button-roman" "with-button-Roman" - "mc-field" "mc-wide-field" "show-reply" "hide-reply" - "mc" "mc-monospaced" "mc-horizontal" "mc-vertical" - - "textual-table" "numeric-dot-table" - "calc-table" "calc-inert" "calc-input" "calc-output" "calc-ref" - "cell-inert" "cell-input" "cell-output" "cell-ref" - "cell-range" "cell-sum" "cell-plusses" "cell-commas" - - "tmdoc-title" "icon" "shortcut" "key" "prefix" - "menu" "render-menu" "submenu" "subsubmenu" "subsubsubmenu" - "markup" "tmstyle" "tmpackage" "tmdtd" "def-index" - "src-arg" "src-var" "scm-arg" "scm-args" - "descriptive-table" "tm-fragment" "framed-fragment" - "explain" "explain-synopsis" "explain-macro" - "small-envbox" "big-envbox" "small-focus" "big-focus" - "cursor" "math-cursor" "TeXmacs-version" "c++" "BibTeX")) + (list "render-theorem" + "render-remark" + "render-exercise" + "render-proof" + "algorithm" + "algorithm*" + "named-algorithm" + "named-algorithm-old" + "specified-algorithm" + "specified-algorithm*" + "named-specified-algorithm" + "algorithm-body" + "numbered" + + "short-item" + "short-question" + "question-arabic" + "question-alpha" + "question-Alpha" + "question-roman" + "question-Roman" + "question-item" + "answer-arabic" + "answer-alpha" + "answer-Alpha" + "answer-roman" + "answer-Roman" + "answer-item" + + "gap" + "gap-dots" + "gap-underlined" + "gap-box" + "gap-wide" + "gap-dots-wide" + "gap-underlined-wide" + "gap-box-wide" + "gap-long" + "gap-dots-long" + "gap-underlined-long" + "gap-box-long" + + "with-button-box" + "with-button-box*" + "with-button-circle" + "with-button-circle*" + "with-button-arabic" + "with-button-alpha" + "with-button-Alpha" + "with-button-roman" + "with-button-Roman" + "mc-field" + "mc-wide-field" + "show-reply" + "hide-reply" + "mc" + "mc-monospaced" + "mc-horizontal" + "mc-vertical" + + "textual-table" + "numeric-dot-table" + "calc-table" + "calc-inert" + "calc-input" + "calc-output" + "calc-ref" + "cell-inert" + "cell-input" + "cell-output" + "cell-ref" + "cell-range" + "cell-sum" + "cell-plusses" + "cell-commas" + + "tmdoc-title" + "icon" + "shortcut" + "key" + "prefix" + "menu" + "render-menu" + "submenu" + "subsubmenu" + "subsubsubmenu" + "markup" + "tmstyle" + "tmpackage" + "tmdtd" + "def-index" + "src-arg" + "src-var" + "scm-arg" + "scm-args" + "descriptive-table" + "tm-fragment" + "framed-fragment" + "explain" + "explain-synopsis" + "explain-macro" + "small-envbox" + "big-envbox" + "small-focus" + "big-focus" + "cursor" + "math-cursor" + "TeXmacs-version" + "c++" + "BibTeX" + ) ;list +) ;define (tm-define (tmtex-env-patch t l0) (let* ((st (tree->stree t)) @@ -3518,13 +4873,17 @@ (l6 (map as-string (collect-user-defs st))) (l7 (if (preference-on? "texmacs->latex:expand-user-macros") '() l6)) (l8 (list-difference (collect-user-macros st) - (list-union l0 l6 tmtex-always-expand))) + (list-union l0 l6 tmtex-always-expand) + ) ;list-difference + ) ;l8 (l9 (list-difference (list-union l1 l2 l5 l7 l8) l0)) - (l10 (list-filter l0 (lambda (s) (and (string? s) - (<= (string-length s) 2))))) + (l10 (list-filter l0 (lambda (s) (and (string? s) (<= (string-length s) 2))))) (l11 (list-difference l10 (list "tt" "em" "op"))) - (l12 (list-difference l9 l11))) - `(collection ,@(map tmtex-env-macro l12)))) + (l12 (list-difference l9 l11)) + ) ; + `(collection ,@(map tmtex-env-macro l12)) + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interface @@ -3534,48 +4893,65 @@ (cond ((not sty) (set! sty (list "article"))) ((string? sty) (set! sty (list sty))) ((func? sty 'tuple) (set! sty (cdr sty))) - ((null? sty) (set! sty '("article")))) - sty) + ((null? sty) (set! sty '("article"))) + ) ;cond + sty +) ;define (tm-define (tmtex-postprocess x) x) (tm-define (tmtex-postprocess-body x) x) (tm-define (texmacs->latex x opts) - ;;(display* "texmacs->latex [" opts "], " x "\n") + ;; (display* "texmacs->latex [" opts "], " x "\n") (if (tmfile? x) - (let* ((body (tmfile-extract x 'body)) - (style (tmtex-get-style (tmfile-extract x 'style))) - (main-style (or (tmtex-transform-style (car style)) "article")) - (lan (tmfile-language x)) - (init (tmfile-extract x 'initial)) - (att (tmfile-extract x 'attachments)) - (doc (list '!file body style lan init att - (url->string (get-texmacs-path))))) - (set! tmtex-cjk-document? - (in? lan '("chinese" "chineset" "japanese" "korean"))) - (latex-set-style main-style) - (latex-set-packages '()) - (latex-set-extra '()) - (set! tmtex-style (car style)) - (set! tmtex-packages (cdr style)) - (set! tmtex-languages (list lan)) - (set! tmtex-colors '()) - (set! tmtex-colormaps '()) - (import-tmtex-styles) - (tmtex-style-init body) - (set! doc (tmtex-style-preprocess doc)) - (with result (tmtex-postprocess (texmacs->latex doc opts)) - (set! tmtex-style "generic") - (set! tmtex-packages '()) - result)) - (let* ((x2 (tree->stree (tmtm-eqnumber->nonumber (stree->tree x)))) - (x3 (tmtm-match-brackets x2))) - (tmtex-initialize opts) - (with r (tmtex (tmpre-produce x3)) - (if tmtex-mathjax? - (set! r (latex-mathjax-pre r))) - (if (not tmtex-use-macros?) - (set! r (latex-expand-macros r))) - (if tmtex-mathjax? - (set! r (latex-mathjax r))) - r)))) + (let* ((body (tmfile-extract x 'body)) + (style (tmtex-get-style (tmfile-extract x 'style))) + (main-style (or (tmtex-transform-style (car style)) "article")) + (lan (tmfile-language x)) + (init (tmfile-extract x 'initial)) + (att (tmfile-extract x 'attachments)) + (doc (list '!file body style lan init att (url->string (get-texmacs-path)))) + ) ; + (set! tmtex-cjk-document? (in? lan '("chinese" + "chineset" + "japanese" + "korean"))) + (latex-set-style main-style) + (latex-set-packages '()) + (latex-set-extra '()) + (set! tmtex-style (car style)) + (set! tmtex-packages (cdr style)) + (set! tmtex-languages (list lan)) + (set! tmtex-colors '()) + (set! tmtex-colormaps '()) + (import-tmtex-styles) + (tmtex-style-init body) + (set! doc (tmtex-style-preprocess doc)) + (with result + (tmtex-postprocess (texmacs->latex doc opts)) + (set! tmtex-style "generic") + (set! tmtex-packages '()) + result + ) ;with + ) ;let* + (let* ((x2 (tree->stree (tmtm-eqnumber->nonumber (stree->tree x)))) + (x3 (tmtm-match-brackets x2)) + ) ; + (tmtex-initialize opts) + (set! tmtex-image-total (tmtex-count-images x3)) + (when (and (qt-gui?) (> tmtex-image-total 0)) + (latex-progress-start tmtex-image-total) + ) ;when + (with r + (tmtex (tmpre-produce x3)) + (if tmtex-mathjax? (set! r (latex-mathjax-pre r))) + (if (not tmtex-use-macros?) (set! r (latex-expand-macros r))) + (if tmtex-mathjax? (set! r (latex-mathjax r))) + (when (and (qt-gui?) (> tmtex-image-total 0)) + (latex-progress-end) + ) ;when + r + ) ;with + ) ;let* + ) ;if +) ;tm-define diff --git a/TeXmacs/progs/convert/latex/tmtex.scm b/TeXmacs/progs/convert/latex/tmtex.scm index 003199c464..6398916447 100644 --- a/TeXmacs/progs/convert/latex/tmtex.scm +++ b/TeXmacs/progs/convert/latex/tmtex.scm @@ -13,14 +13,15 @@ (texmacs-module (convert latex tmtex) (:use (convert tools tmpre) - (convert tools old-tmtable) - (convert tools tmlength) - (convert rewrite tmtm-brackets) - (convert latex texout) - (doc tmdoc-markup) - (convert latex latex-tools))) + (convert tools old-tmtable) + (convert tools tmlength) + (convert rewrite tmtm-brackets) + (convert latex texout) + (doc tmdoc-markup) + (convert latex latex-tools) + ) ;:use +) ;texmacs-module -;(use-modules (ice-9 format)) (tm-define tmtex-debug-mode? #f) @@ -31,96 +32,174 @@ (tm-define tmtex-style "generic") (tm-define tmtex-packages '()) (tm-define tmtex-replace-style? #t) + (define tmtex-languages '()) + (define tmtex-colors '()) + (define tmtex-colormaps '()) + (define tmtex-env (make-ahash-table)) + (define tmtex-macros (make-ahash-table)) + (define tmtex-dynamic (make-ahash-table)) + (define tmtex-serial 0) + (define tmtex-ref-cnt 1) + (define tmtex-auto-produce 0) + (define tmtex-auto-consume 0) + (define tmtex-image-root-url (unix->url "image")) + (define tmtex-image-root-string "image") + (define tmtex-appendices? #f) + (define tmtex-indirect-bib? #f) + (define tmtex-mathjax? #f) +(define tmtex-image-progress 0) + +(define tmtex-image-total 0) + +(define (tmtex-count-images t) + (cond ((null? t) 0) + ((npair? t) 0) + ((in? (car t) + '(image graphics + draw-over + draw-under + para + table + tformat + equation + equation* + eqnarray + eqnarray* + section + subsection + subsubsection) + ) ;in? + 1 + ) ; + (else (let loop + ((lst t) (sum 0)) + (if (null? lst) + sum + (if (pair? lst) + (loop (cdr lst) (+ sum (tmtex-count-images (car lst)))) + (+ sum (tmtex-count-images lst)) + ) ;if + ) ;if + ) ;let + ) ;else + ) ;cond +) ;define + +(define (tmtex-image-increment) + (set! tmtex-image-progress (+ tmtex-image-progress 1)) + (when (and (qt-gui?) (> tmtex-image-total 0)) + (latex-progress-update tmtex-image-progress) + ) ;when +) ;define + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Style ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (texmacs-modes ;;; Elsevier styles - (elsevier-style% (in? tmtex-style '("elsart" "jsc" "elsarticle" - "ifac"))) - (jsc-style% (in? tmtex-style '("jsc")) elsevier-style%) - (elsarticle-style% (in? tmtex-style '("elsarticle")) elsevier-style%) - (elsart-style% (in? tmtex-style '("elsart")) elsevier-style%) - (ifac-style% (in? tmtex-style '("ifac")) elsevier-style%) + (elsevier-style% (in? tmtex-style '("elsart" "jsc" "elsarticle" "ifac"))) + (jsc-style% (in? tmtex-style '("jsc")) elsevier-style%) + (elsarticle-style% (in? tmtex-style '("elsarticle")) elsevier-style%) + (elsart-style% (in? tmtex-style '("elsart")) elsevier-style%) + (ifac-style% (in? tmtex-style '("ifac")) elsevier-style%) ;;; ACM styles - (acm-style% (in? tmtex-style '("acmconf" "sig-alternate" - "acm_proc_article-sp" - "acmsmall" "acmlarge" "acmtog" - "sigconf" "sigchi" "sigplan" - "acmart"))) - (acm-art-style% (in? tmtex-style '("acmsmall" "acmlarge" "acmtog" - "sigconf" "sigchi" "sigplan" - "acmart")) acm-style%) + (acm-style% (in? tmtex-style + '("acmconf" + "sig-alternate" + "acm_proc_article-sp" + "acmsmall" + "acmlarge" + "acmtog" + "sigconf" + "sigchi" + "sigplan" + "acmart") + ) ;in? + ) ;acm-style% + (acm-art-style% (in? tmtex-style + '("acmsmall" + "acmlarge" + "acmtog" + "sigconf" + "sigchi" + "sigplan" + "acmart") + ) ;in? + acm-style% + ) ;acm-art-style% (sig-alternate-style% (in? tmtex-style '("sig-alternate")) acm-style%) - (acm-conf-style% (in? tmtex-style '("acmconf" "sig-alternate" - "acm_proc_article-sp")) acm-style%) - (acm-small-style% (in? tmtex-style '("acmsmall")) acm-art-style%) - (acm-large-style% (in? tmtex-style '("acmlarge")) acm-art-style%) - (acm-tog-style% (in? tmtex-style '("acmtog")) acm-art-style%) - (acm-sigconf-style% (in? tmtex-style '("sigconf")) acm-art-style%) - (acm-sigchi-style% (in? tmtex-style '("sigchi")) acm-art-style%) - (acm-sigplan-style% (in? tmtex-style '("sigplan")) acm-art-style%) + (acm-conf-style% (in? tmtex-style '("acmconf" + "sig-alternate" + "acm_proc_article-sp")) + acm-style% + ) ;acm-conf-style% + (acm-small-style% (in? tmtex-style '("acmsmall")) acm-art-style%) + (acm-large-style% (in? tmtex-style '("acmlarge")) acm-art-style%) + (acm-tog-style% (in? tmtex-style '("acmtog")) acm-art-style%) + (acm-sigconf-style% (in? tmtex-style '("sigconf")) acm-art-style%) + (acm-sigchi-style% (in? tmtex-style '("sigchi")) acm-art-style%) + (acm-sigplan-style% (in? tmtex-style '("sigplan")) acm-art-style%) ;; AMS styles - (ams-style% (in? tmtex-style '("amsart"))) + (ams-style% (in? tmtex-style '("amsart"))) ;; Revtex styles - (revtex-style% (in? tmtex-style '("aip" "aps"))) - (aip-style% (in? tmtex-style '("aip")) revtex-style%) - (aps-style% (in? tmtex-style '("aps")) revtex-style%) - (sv-style% (in? tmtex-style '("svjour" "svjour3" - "llncs" "svmono"))) + (revtex-style% (in? tmtex-style '("aip" "aps"))) + (aip-style% (in? tmtex-style '("aip")) revtex-style%) + (aps-style% (in? tmtex-style '("aps")) revtex-style%) + (sv-style% (in? tmtex-style '("svjour" "svjour3" "llncs" "svmono"))) ;; Springer styles - (springer-style% (in? tmtex-style '("svjour" "svjour3" - "llncs" sv-style%))) - (svjour-style% (in? tmtex-style '("svjour" - "svjour3")) springer-style%) - (llncs-style% (in? tmtex-style '("llncs")) springer-style%) - (svmono-style% (in? tmtex-style '("svmono")) sv-style%) + (springer-style% (in? tmtex-style '("svjour" "svjour3" "llncs" sv-style%))) + (svjour-style% (in? tmtex-style '("svjour" "svjour3")) springer-style%) + (llncs-style% (in? tmtex-style '("llncs")) springer-style%) + (svmono-style% (in? tmtex-style '("svmono")) sv-style%) ;; IEEE styles - (ieee-style% (in? tmtex-style '("ieeeconf" "ieeetran"))) - (ieee-conf-style% (in? tmtex-style '("ieeeconf")) ieee-style%) - (ieee-tran-style% (in? tmtex-style '("ieeetran")) ieee-style%) + (ieee-style% (in? tmtex-style '("ieeeconf" "ieeetran"))) + (ieee-conf-style% (in? tmtex-style '("ieeeconf")) ieee-style%) + (ieee-tran-style% (in? tmtex-style '("ieeetran")) ieee-style%) ;; Other styles - (beamer-style% (in? tmtex-style '("beamer" "old-beamer"))) - (natbib-package% (in? "cite-author-year" tmtex-packages))) + (beamer-style% (in? tmtex-style '("beamer" "old-beamer"))) + (natbib-package% (in? "cite-author-year" tmtex-packages)) +) ;texmacs-modes -(tm-define (tmtex-style-init body) - (noop)) +(tm-define (tmtex-style-init body) (noop)) (tm-define (tmtex-style-preprocess doc) doc) (define (import-tmtex-styles) (cond ((elsevier-style?) (import-from (convert latex tmtex-elsevier))) - ((acm-style?) (import-from (convert latex tmtex-acm))) - ((ams-style?) (import-from (convert latex tmtex-ams))) - ((revtex-style?) (import-from (convert latex tmtex-revtex))) - ((ieee-style?) (import-from (convert latex tmtex-ieee))) - ((beamer-style?) (import-from (convert latex tmtex-beamer))) + ((acm-style?) (import-from (convert latex tmtex-acm))) + ((ams-style?) (import-from (convert latex tmtex-ams))) + ((revtex-style?) (import-from (convert latex tmtex-revtex))) + ((ieee-style?) (import-from (convert latex tmtex-ieee))) + ((beamer-style?) (import-from (convert latex tmtex-beamer))) ((or (springer-style?) (svmono-style?)) - (import-from (convert latex tmtex-springer))) - (else (noop)))) + (import-from (convert latex tmtex-springer)) + ) ; + (else (noop)) + ) ;cond +) ;define (tm-define (tmtex-provided-packages) '()) @@ -129,6 +208,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-initialize opts) + (set! tmtex-image-progress 0) (set! tmtex-ref-cnt 1) (set! tmtex-env (make-ahash-table)) (set! tmtex-macros (make-ahash-table)) @@ -138,114 +218,157 @@ (set! tmtex-auto-consume 0) (set! tmtex-mathjax? #f) (if (== (url-suffix current-save-target) "tex") - (begin - (set! tmtex-image-root-url (url-unglue current-save-target 4)) - (with suf (url-suffix tmtex-image-root-url) - (when (!= suf "") - (set! tmtex-image-root-url - (url-unglue tmtex-image-root-url - (+ (string-length suf) 1))))) - (set! tmtex-image-root-string - (url->unix (url-tail tmtex-image-root-url)))) - (begin - (set! tmtex-image-root-url (unix->url "image")) - (set! tmtex-image-root-string "image"))) + (begin + (set! tmtex-image-root-url (url-unglue current-save-target 4)) + (with suf + (url-suffix tmtex-image-root-url) + (when (!= suf "") + (set! tmtex-image-root-url + (url-unglue tmtex-image-root-url (+ (string-length suf) 1)) + ) ;set! + ) ;when + ) ;with + (set! tmtex-image-root-string (url->unix (url-tail tmtex-image-root-url))) + ) ;begin + (begin + (set! tmtex-image-root-url (unix->url "image")) + (set! tmtex-image-root-string "image") + ) ;begin + ) ;if (set! tmtex-appendices? #f) (set! tmtex-replace-style? - (== (assoc-ref opts "texmacs->latex:replace-style") "on")) + (== (assoc-ref opts "texmacs->latex:replace-style") "on") + ) ;set! (set! tmtex-indirect-bib? - (== (assoc-ref opts "texmacs->latex:indirect-bib") "on")) - (set! tmtex-use-macros? - (== (assoc-ref opts "texmacs->latex:use-macros") "on")) + (== (assoc-ref opts "texmacs->latex:indirect-bib") "on") + ) ;set! + (set! tmtex-use-macros? (== (assoc-ref opts "texmacs->latex:use-macros") "on")) (when (== (assoc-ref opts "texmacs->latex:mathjax") "on") (tmtex-env-set "mode" "math") - (set! tmtex-mathjax? #t)) - (with charset (assoc-ref opts "texmacs->latex:encoding") + (set! tmtex-mathjax? #t) + ) ;when + (with charset + (assoc-ref opts "texmacs->latex:encoding") (if tmtex-cjk-document? (set! charset "utf-8")) (cond ((== charset "utf-8") (set! tmtex-use-catcodes? #f) - (set! tmtex-use-ascii? #f) - (set! tmtex-use-unicode? #t)) + (set! tmtex-use-ascii? #f) + (set! tmtex-use-unicode? #t) + ) ; ((== charset "cork") (set! tmtex-use-catcodes? #t) - (set! tmtex-use-ascii? #f) - (set! tmtex-use-unicode? #f)) + (set! tmtex-use-ascii? #f) + (set! tmtex-use-unicode? #f) + ) ; ((== charset "ascii") (set! tmtex-use-catcodes? #f) - (set! tmtex-use-ascii? #t) - (set! tmtex-use-unicode? #f))))) + (set! tmtex-use-ascii? #t) + (set! tmtex-use-unicode? #f) + ) ; + ) ;cond + ) ;with +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Determination of the mode in which commands are used ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define command-text-uses (make-ahash-table)) + (define command-math-uses (make-ahash-table)) (define (compute-mode-stats t mode) (when (tree-compound? t) - (let* ((h (if (== mode (tree "math")) - command-math-uses - command-text-uses)) - (n (or (ahash-ref h (tree-label t)) 0))) + (let* ((h (if (== mode (tree "math")) command-math-uses command-text-uses)) + (n (or (ahash-ref h (tree-label t)) 0)) + ) ; (ahash-set! h (tree-label t) (+ n 1)) (for-each (lambda (i) - (with nmode (tree-child-env t i "mode" mode) - (compute-mode-stats (tree-ref t i) nmode))) - (.. 0 (tree-arity t)))))) + (with nmode + (tree-child-env t i "mode" mode) + (compute-mode-stats (tree-ref t i) nmode) + ) ;with + ) ;lambda + (.. 0 (tree-arity t)) + ) ;for-each + ) ;let* + ) ;when +) ;define (define (init-mode-stats t) (set! command-text-uses (make-ahash-table)) (set! command-math-uses (make-ahash-table)) - (compute-mode-stats (tm->tree t) "text")) + (compute-mode-stats (tm->tree t) "text") +) ;define (define (mode-protect t) - (cond ((and (pair? t) (symbol? (car t)) - (string-starts? (symbol->string (car t)) "tmtext")) - `(text ,t)) - ((and (pair? t) (symbol? (car t)) - (or (string-starts? (symbol->string (car t)) "tmmath") - (string-starts? (symbol->string (car t)) "math"))) - `(ensuremath ,t)) - ((func? t '!concat) - `(!concat ,@(map mode-protect (cdr t)))) - (else t))) + (cond ((and (pair? t) + (symbol? (car t)) + (string-starts? (symbol->string (car t)) "tmtext") + ) ;and + `(text ,t) + ) ; + ((and (pair? t) + (symbol? (car t)) + (or (string-starts? (symbol->string (car t)) "tmmath") + (string-starts? (symbol->string (car t)) "math") + ) ;or + ) ;and + `(ensuremath ,t) + ) ; + ((func? t '!concat) `(!concat ,@(map mode-protect (cdr t)))) + (else t) + ) ;cond +) ;define (define (tmtex-pre t) - (cond ((tm-func? t 'para) - (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) + (cond ((tm-func? t 'para) (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) ((tm-func? t 'concat) - (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) - ((tm-func? t 'mtm 2) - `(mtm ,(cadr t) ,(tmtex-pre (caddr t)))) + (cons '!paragraph (map-in-order tmtex-pre (tm-children t))) + ) ; + ((tm-func? t 'mtm 2) `(mtm ,(cadr t) ,(tmtex-pre (caddr t)))) ((and (tm-func? t 'assign 2) (tm-atomic? (tm-ref t 0))) (let* ((name (tm-ref t 0)) (tag (string->symbol name)) (tnr (or (ahash-ref command-text-uses tag) 0)) - (mnr (or (ahash-ref command-math-uses tag) 0))) - ;;(display* tag ", " tnr ", " mnr "\n") + (mnr (or (ahash-ref command-math-uses tag) 0)) + ) ; + ;; (display* tag ", " tnr ", " mnr "\n") (cond ((and (string-ends? name "*") - (or (string-starts? name "itemize") - (string-starts? name "enumerate") - (string-starts? name "description"))) - "") + (or (string-starts? name "itemize") + (string-starts? name "enumerate") + (string-starts? name "description") + ) ;or + ) ;and + "" + ) ; ((>= tnr mnr) - (with r (tmtex t) - ;;(display* t " -> " r "\n") + (with r + (tmtex t) + ;; (display* t " -> " r "\n") (when (and (> mnr 0) (func? r 'newcommand 2)) - (with val (mode-protect (caddr r)) - (set! r (list (car r) (cadr r) val)))) - r)) - (else - (tmtex-env-set "mode" "math") - (with r (tmtex t) + (with val (mode-protect (caddr r)) (set! r (list (car r) (cadr r) val))) + ) ;when + r + ) ;with + ) ; + (else (tmtex-env-set "mode" "math") + (with r + (tmtex t) (tmtex-env-reset "mode") - ;;(display* t " -> " r "\n") + ;; (display* t " -> " r "\n") (when (and (> tnr 0) (func? r 'newcommand 2)) - (with val (mode-protect (caddr r)) - (set! r (list (car r) (cadr r) val)))) - r))))) - (else (tmtex t)))) + (with val (mode-protect (caddr r)) (set! r (list (car r) (cadr r) val))) + ) ;when + r + ) ;with + ) ;else + ) ;cond + ) ;let* + ) ; + (else (tmtex t)) + ) ;cond +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Data @@ -265,74 +388,78 @@ (choice ((left\{) "l" (right.) #f)) (tabbed ("" "l" "" #f)) (tabbed* ("" "l" "" #f)) - (rcl-table ("{\\setlength\\arraylinesep{0.4em}\\everymath={\\displaystyle}" - "rcl" "}" #f))) + (rcl-table ("{\\setlength\\arraylinesep{0.4em}\\everymath={\\displaystyle}" "rcl" "}" #f) + ) ;rcl-table +) ;logic-table (logic-table tex-with-cmd% - (("font-family" "rm") tmtextrm) - (("font-family" "ss") tmtextsf) - (("font-family" "tt") tmtexttt) - (("font-series" "medium") tmtextmd) - (("font-series" "bold") tmtextbf) - (("font-shape" "right") tmtextup) - (("font-shape" "slanted") tmtextsl) - (("font-shape" "italic") tmtextit) - (("font-shape" "small-caps") tmtextsc) - (("par-columns" "2") (!begin "multicols" "2")) - (("par-columns" "3") (!begin "multicols" "3")) - (("par-mode" "center") (!begin "center")) - (("par-mode" "left") (!begin "flushleft")) - (("par-mode" "right") (!begin "flushright"))) + (("font-family" "rm") tmtextrm) + (("font-family" "ss") tmtextsf) + (("font-family" "tt") tmtexttt) + (("font-series" "medium") tmtextmd) + (("font-series" "bold") tmtextbf) + (("font-shape" "right") tmtextup) + (("font-shape" "slanted") tmtextsl) + (("font-shape" "italic") tmtextit) + (("font-shape" "small-caps") tmtextsc) + (("par-columns" "2") (!begin "multicols" "2")) + (("par-columns" "3") (!begin "multicols" "3")) + (("par-mode" "center") (!begin "center")) + (("par-mode" "left") (!begin "flushleft")) + (("par-mode" "right") (!begin "flushright")) +) ;logic-table (logic-table tex-with-cmd-math% - (("font" "cal") mathcal) - (("font" "cal*") mathscr) - (("font" "cal**") EuScript) - (("font" "Euler") mathfrak) - (("font" "Bbb") mathbb) - (("font" "Bbb*") mathbbm) - (("font" "Bbb**") mathbbmss) - (("font" "Bbb***") mathbb) - (("font" "Bbb****") mathds) - (("font-family" "rm") mathrm) - (("font-family" "ss") mathsf) - (("font-family" "tt") mathtt) - (("font-series" "medium") tmmathmd) - (("font-series" "bold") tmmathbf) - (("font-shape" "right") mathrm) - (("font-shape" "slanted") mathit) - (("font-shape" "italic") mathit) - (("font-shape" "small-caps") mathrm) - (("math-font" "cal") mathcal) - (("math-font" "cal*") mathscr) - (("math-font" "cal**") EuScript) - (("math-font" "Euler") mathfrak) - (("math-font" "Bbb") mathbb) - (("math-font" "Bbb*") mathbbm) - (("math-font" "Bbb**") mathbbmss) - (("math-font" "Bbb***") mathbb) - (("math-font" "Bbb****") mathds) - (("math-font-family" "mr") mathrm) - (("math-font-family" "ms") mathsf) - (("math-font-family" "mt") mathtt) - (("math-font-family" "normal") mathnormal) - (("math-font-family" "rm") mathrm) - (("math-font-family" "ss") mathsf) - (("math-font-family" "tt") mathtt) - (("math-font-family" "bf") mathbf) - (("math-font-family" "it") mathit) - (("math-font-series" "bold") tmmathbf)) + (("font" "cal") mathcal) + (("font" "cal*") mathscr) + (("font" "cal**") EuScript) + (("font" "Euler") mathfrak) + (("font" "Bbb") mathbb) + (("font" "Bbb*") mathbbm) + (("font" "Bbb**") mathbbmss) + (("font" "Bbb***") mathbb) + (("font" "Bbb****") mathds) + (("font-family" "rm") mathrm) + (("font-family" "ss") mathsf) + (("font-family" "tt") mathtt) + (("font-series" "medium") tmmathmd) + (("font-series" "bold") tmmathbf) + (("font-shape" "right") mathrm) + (("font-shape" "slanted") mathit) + (("font-shape" "italic") mathit) + (("font-shape" "small-caps") mathrm) + (("math-font" "cal") mathcal) + (("math-font" "cal*") mathscr) + (("math-font" "cal**") EuScript) + (("math-font" "Euler") mathfrak) + (("math-font" "Bbb") mathbb) + (("math-font" "Bbb*") mathbbm) + (("math-font" "Bbb**") mathbbmss) + (("math-font" "Bbb***") mathbb) + (("math-font" "Bbb****") mathds) + (("math-font-family" "mr") mathrm) + (("math-font-family" "ms") mathsf) + (("math-font-family" "mt") mathtt) + (("math-font-family" "normal") mathnormal) + (("math-font-family" "rm") mathrm) + (("math-font-family" "ss") mathsf) + (("math-font-family" "tt") mathtt) + (("math-font-family" "bf") mathbf) + (("math-font-family" "it") mathit) + (("math-font-series" "bold") tmmathbf) +) ;logic-table (logic-table tex-assign-cmd% - (("font-family" "rm") rmfamily) - (("font-family" "ss") ssfamily) - (("font-family" "tt") ttfamily) - (("font-series" "medium") mdseries) - (("font-series" "bold") bfseries) - (("font-shape" "right") upshape) - (("font-shape" "slanted") slshape) - (("font-shape" "italic") itshape) - (("font-shape" "small-caps") scshape)) + (("font-family" "rm") rmfamily) + (("font-family" "ss") ssfamily) + (("font-family" "tt") ttfamily) + (("font-series" "medium") mdseries) + (("font-series" "bold") bfseries) + (("font-shape" "right") upshape) + (("font-shape" "slanted") slshape) + (("font-shape" "italic") itshape) + (("font-shape" "small-caps") scshape) +) ;logic-table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Manipulation of the environment @@ -340,31 +467,40 @@ (define (tmtex-env-list var) (let ((r (ahash-ref tmtex-env var))) - (if r r '()))) + (if r r '()) + ) ;let +) ;define (define (tmtex-env-get var) (let ((val (tmtex-env-list var))) - (and (pair? val) (car val)))) + (and (pair? val) (car val)) + ) ;let +) ;define (define (tmtex-env-get-previous var) (let ((val (tmtex-env-list var))) - (if (or (null? val) (null? (cdr val))) #f - (cadr val)))) + (if (or (null? val) (null? (cdr val))) #f (cadr val)) + ) ;let +) ;define (define (tmtex-math-mode?) - (== (tmtex-env-get "mode") "math")) + (== (tmtex-env-get "mode") "math") +) ;define (tm-define (tmtex-env-set var val) - (ahash-set! tmtex-env var (cons val (tmtex-env-list var)))) + (ahash-set! tmtex-env var (cons val (tmtex-env-list var))) +) ;tm-define (tm-define (tmtex-env-reset var) (let ((val (tmtex-env-list var))) - (if (nnull? val) - (ahash-set! tmtex-env var (cdr val))))) + (if (nnull? val) (ahash-set! tmtex-env var (cdr val))) + ) ;let +) ;tm-define (tm-define (tmtex-env-assign var val) (tmtex-env-reset var) - (tmtex-env-set var val)) + (tmtex-env-set var val) +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Frequently used TeX construction subroutines @@ -372,59 +508,72 @@ (tm-define (tmtex-concat-sep l) (set! l (list-intersperse l '(!concat (tmsep) " "))) - (if (null? l) '() `((!concat ,@l)))) + (if (null? l) '() `((!concat ,@l))) +) ;tm-define (tm-define (tmtex-concat-Sep l) (set! l (list-intersperse l '(!concat (tmSep) " "))) - (if (null? l) '() `((!concat ,@l)))) + (if (null? l) '() `((!concat ,@l))) +) ;tm-define (define (tex-concat-similar l) (cond ((or (null? l) (null? (cdr l))) l) ((> (length l) 1000) - (let* ((s (quotient (length l) 2)) - (h (list-head l s)) - (t (list-tail l s))) - (tex-concat-similar `((!concat ,@h) (!concat ,@t))))) - (else - (let ((r (tex-concat-similar (cdr l)))) - (cond ((and (func? (car l) '!sub) (func? (car r) '!sub)) - (cons (list '!sub (tex-concat (list (cadar l) (cadar r)))) - (cdr r))) - ((and (func? (car l) '!sup) (func? (car r) '!sup)) - (cons (list '!sup (tex-concat (list (cadar l) (cadar r)))) - (cdr r))) - (else (cons (car l) r))))))) + (let* ((s (quotient (length l) 2)) (h (list-head l s)) (t (list-tail l s))) + (tex-concat-similar `((!concat ,@h) (!concat ,@t))) + ) ;let* + ) ; + (else (let ((r (tex-concat-similar (cdr l)))) + (cond ((and (func? (car l) '!sub) (func? (car r) '!sub)) + (cons (list '!sub (tex-concat (list (cadar l) (cadar r)))) (cdr r)) + ) ; + ((and (func? (car l) '!sup) (func? (car r) '!sup)) + (cons (list '!sup (tex-concat (list (cadar l) (cadar r)))) (cdr r)) + ) ; + (else (cons (car l) r)) + ) ;cond + ) ;let + ) ;else + ) ;cond +) ;define (define (tex-concat-list l) (cond ((null? l) l) ((== (car l) "") (tex-concat-list (cdr l))) ((func? (car l) '!concat) (append (cdar l) (tex-concat-list (cdr l)))) - (else (cons (car l) (tex-concat-list (cdr l)))))) + (else (cons (car l) (tex-concat-list (cdr l)))) + ) ;cond +) ;define (tm-define (tex-concat l) (:synopsis "Horizontal concatenation of list of LaTeX expressions") (let ((r (tex-concat-similar (tex-concat-list l)))) - (if (null? r) "" - (if (null? (cdr r)) (car r) - (cons '!concat r))))) + (if (null? r) "" (if (null? (cdr r)) (car r) (cons '!concat r))) + ) ;let +) ;tm-define (define (tex-concat-strings l) (cond ((< (length l) 2) l) ((and (string? (car l)) (string? (cadr l))) - (tex-concat-strings (cons (string-append (car l) (cadr l)) (cddr l)))) - (else (cons (car l) (tex-concat-strings (cdr l)))))) + (tex-concat-strings (cons (string-append (car l) (cadr l)) (cddr l))) + ) ; + (else (cons (car l) (tex-concat-strings (cdr l)))) + ) ;cond +) ;define (tm-define (tex-concat* l) (:synopsis "Variant of tex-concat which concatenates adjacent strings") - (tex-concat (tex-concat-strings l))) + (tex-concat (tex-concat-strings l)) +) ;tm-define (tm-define (tex-apply . l) - (if (or (tmtex-math-mode?) (logic-in? (car l) tmpre-sectional%)) l - (list '!group l))) + (if (or (tmtex-math-mode?) (logic-in? (car l) tmpre-sectional%)) + l + (list '!group l) + ) ;if +) ;tm-define -(tm-define (tex-math-apply . l) - (if (tmtex-math-mode?) l - (list 'ensuremath l))) +(tm-define (tex-math-apply . l) (if (tmtex-math-mode?) l (list 'ensuremath l))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Strings @@ -432,544 +581,757 @@ (define (string-starts? s r) (and (>= (string-length s) (string-length r)) - (== (substring s 0 (string-length r)) r))) + (== (substring s 0 (string-length r)) r) + ) ;and +) ;define (define (tmtex-modified-token op s i) (tex-math-apply op (if (= (string-length s) (+ i 1)) - (substring s i (string-length s)) - (tex-apply (string->symbol (substring s i (string-length s))))))) + (substring s i (string-length s)) + (tex-apply (string->symbol (substring s i (string-length s)))) + ) ;if + ) ;tex-math-apply +) ;define (logic-table latex-special-symbols% - ("less" #\<) - ("gtr" #\>) - ("box" (Box)) - ("over" #\:) - ("||" (|)) ;; | - ("precdot" (tmprecdot))) + ("less" #\<) + ("gtr" #\>) + ("box" (Box)) + ("over" #\:) + ("||" (|)) + ;; | + ("precdot" (tmprecdot)) +) ;logic-table (logic-table latex-text-symbols% - ("#20AC" euro) - ("cent" textcent) - ("circledR" textregistered) - ("copyright" textcopyright) - ("currency" textcurrency) - ("degree" textdegree) - ("textdegree" textdegree) - ("mu" textmu) - ("onehalf" textonehalf) - ("onequarter" textonequarter) - ("onesuperior" textonesuperior) - ("paragraph" P) - ("threequarters" textthreequarters) - ("threesuperior" textthreesuperior) - ("trademark" texttrademark) - ("twosuperior" texttwosuperior) - ("yen" textyen)) + ("#20AC" euro) + ("cent" textcent) + ("circledR" textregistered) + ("copyright" textcopyright) + ("currency" textcurrency) + ("degree" textdegree) + ("textdegree" textdegree) + ("mu" textmu) + ("onehalf" textonehalf) + ("onequarter" textonequarter) + ("onesuperior" textonesuperior) + ("paragraph" P) + ("threequarters" textthreequarters) + ("threesuperior" textthreesuperior) + ("trademark" texttrademark) + ("twosuperior" texttwosuperior) + ("yen" textyen) +) ;logic-table (tm-define (tmtex-token-sub s group?) - (cond ((logic-ref latex-special-symbols% s) - (logic-ref latex-special-symbols% s)) + (cond ((logic-ref latex-special-symbols% s) (logic-ref latex-special-symbols% s)) ((string-starts? s "up-") (tmtex-modified-token 'mathrm s 3)) - ;;((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4)) + ;; ((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4)) ((and (string-starts? s "bbb-") - (>= (string-length s) 5) - (string-number? (substring s 4 5))) - (tmtex-modified-token 'mathbbm s 4)) + (>= (string-length s) 5) + (string-number? (substring s 4 5)) + ) ;and + (tmtex-modified-token 'mathbbm s 4) + ) ; ((string-starts? s "bbb-") (tmtex-modified-token 'mathbb s 4)) ((string-starts? s "cal-") (tmtex-modified-token 'mathcal s 4)) - ((and (string-starts? s "cal*-") - (>= (string-length s) 6)) - (tmtex-modified-token 'mathscr s 5)) - ((and (string-starts? s "cal**-") - (>= (string-length s) 7)) - (tmtex-modified-token 'EuScript s 6)) + ((and (string-starts? s "cal*-") (>= (string-length s) 6)) + (tmtex-modified-token 'mathscr s 5) + ) ; + ((and (string-starts? s "cal**-") (>= (string-length s) 7)) + (tmtex-modified-token 'EuScript s 6) + ) ; ((string-starts? s "frak-") (tmtex-modified-token 'mathfrak s 5)) ((string-starts? s "b-cal-") - (tex-math-apply 'tmmathbf (tmtex-modified-token 'mathcal s 6))) + (tex-math-apply 'tmmathbf (tmtex-modified-token 'mathcal s 6)) + ) ; ((string-starts? s "b-up-") (tmtex-modified-token 'mathbf s 5)) ((string-starts? s "b-") (tmtex-modified-token 'tmmathbf s 2)) ((and (not (tmtex-math-mode?)) (logic-ref latex-text-symbols% s)) - (list '!group (list (logic-ref latex-text-symbols% s)))) + (list '!group (list (logic-ref latex-text-symbols% s))) + ) ; ((and (string-starts? s "#") (not tmtex-use-catcodes?)) - (let* ((qs (string-append "<" s ">")) - (cv (string-convert qs "Cork" "UTF-8"))) - (list '!widechar (string->symbol cv)))) + (let* ((qs (string-append "<" s ">")) (cv (string-convert qs "Cork" "UTF-8"))) + (list '!widechar (string->symbol cv)) + ) ;let* + ) ; ((and (string-starts? s "#") tmtex-use-catcodes?) (let* ((qs (string-append "<" s ">")) (us (string-convert qs "Cork" "UTF-8")) - (cv (string-convert us "UTF-8" "LaTeX"))) - (list '!widechar (string->symbol cv)))) - (else (let* ((s2 (string-replace s "-" "")) - (ss (list (string->symbol s2)))) + (cv (string-convert us "UTF-8" "LaTeX")) + ) ; + (list '!widechar (string->symbol cv)) + ) ;let* + ) ; + (else (let* ((s2 (string-replace s "-" "")) (ss (list (string->symbol s2)))) (cond ((logic-in? (car ss) tmtex-protected-symbol%) - (with sy (string->symbol (string-append "tmx" s2)) - (list '!symbol (list sy)))) + (with sy (string->symbol (string-append "tmx" s2)) (list '!symbol (list sy))) + ) ; ((not (logic-in? (car ss) latex-symbol%)) (display* "TeXmacs] non converted symbol: " s "\n") - (list '!symbol (list 'nonconverted s2))) + (list '!symbol (list 'nonconverted s2)) + ) ; (group? (list '!group ss)) - (else (list '!symbol ss))))))) + (else (list '!symbol ss)) + ) ;cond + ) ;let* + ) ;else + ) ;cond +) ;tm-define (define (tmtex-token l routine group?) - (receive (p1 p2) (list-break (cdr l) (lambda (x) (== x #\>))) - (let* ((s (list->string p1)) - (q (if (null? p2) '() (cdr p2))) - (r (routine q))) - (cons (tmtex-token-sub s group?) r)))) + (receive (p1 p2) + (list-break (cdr l) (lambda (x) (== x #\>))) + (let* ((s (list->string p1)) (q (if (null? p2) '() (cdr p2))) (r (routine q))) + (cons (tmtex-token-sub s group?) r) + ) ;let* + ) ;receive +) ;define (define (tmtex-text-sub head l) (if (string? head) (append (string->list head) (tmtex-text-list (cdr l))) - (append (list head) (tmtex-text-list (cdr l))))) + (append (list head) (tmtex-text-list (cdr l))) + ) ;if +) ;define (define (tmtex-special-char? c) - (string-index "#$%&_{}" c)) + (string-index "#$%&_{}" c) +) ;define (define (tmtex-break-char? c) - (string-index "+ -:=,?;()[]{}<>/" c)) + (string-index "+ -:=,?;()[]{}<>/" c) +) ;define (define (tmtex-text-list-space l) (cond ((null? l) l) ((== (car l) #\space) - (cons (list (string->symbol " ")) (tmtex-text-list-space (cdr l)))) - (else (tmtex-text-list l)))) + (cons (list (string->symbol " ")) (tmtex-text-list-space (cdr l))) + ) ; + (else (tmtex-text-list l)) + ) ;cond +) ;define (define (tmtex-text-list l) - (if (null? l) l - (let ((c (car l))) - (cond ((== c #\<) (tmtex-token l tmtex-text-list #t)) - ((== c #\space) (cons c (tmtex-text-list-space (cdr l)))) - ((tmtex-special-char? c) - (cons (list (string->symbol (char->string c))) - (tmtex-text-list (cdr l)))) - ((== c #\~) (tmtex-text-sub "\\~{}" l)) - ((== c #\^) (tmtex-text-sub "\\^{}" l)) - ((== c #\\) (tmtex-text-sub '(textbackslash) l)) - ((== c #\`) (tmtex-text-sub "`" l)) - ((== c #\x00) (tmtex-text-sub "\\`{}" l)) - ((== c #\x01) (tmtex-text-sub "\\'{}" l)) - ((== c #\x04) (tmtex-text-sub "\\\"{}" l)) - ((== c #\x05) (tmtex-text-sub "\\H{}" l)) - ((== c #\x06) (tmtex-text-sub "\\r{}" l)) - ((== c #\x07) (tmtex-text-sub "\\v{}" l)) - ((== c #\x08) (tmtex-text-sub "\\u{}" l)) - ((== c #\x09) (tmtex-text-sub "\\={}" l)) - ((== c #\x0A) (tmtex-text-sub "\\.{}" l)) - ((== c #\x0E) (tmtex-text-sub "\\k{}" l)) - ((== c #\x10) (tmtex-text-sub "``" l)) - ((== c #\x11) (tmtex-text-sub "''" l)) - ((== c #\x12) (tmtex-text-sub ",," l)) - ((== c #\x15) (tmtex-text-sub "--" l)) - ((== c #\x16) (tmtex-text-sub "---" l)) - ((== c #\x17) (tmtex-text-sub "{}" l)) - ((== c #\x1B) (tmtex-text-sub "ff" l)) - ((== c #\x1C) (tmtex-text-sub '(textbackslash) l)) - ((== c #\x1D) (tmtex-text-sub "fl" l)) - ((== c #\x1E) (tmtex-text-sub "ffi" l)) - ((== c #\x1F) (tmtex-text-sub "ffl" l)) - ((== c #\|) (tmtex-text-sub '(textbar) l)) - (else - (append - (if (or tmtex-use-unicode? tmtex-use-ascii?) - (string->list (string-convert (char->string c) - "Cork" "UTF-8")) - (list c)) - (tmtex-text-list (cdr l)))))))) + (if (null? l) + l + (let ((c (car l))) + (cond ((== c #\<) (tmtex-token l tmtex-text-list #t)) + ((== c #\space) (cons c (tmtex-text-list-space (cdr l)))) + ((tmtex-special-char? c) + (cons (list (string->symbol (char->string c))) (tmtex-text-list (cdr l))) + ) ; + ((== c #\~) (tmtex-text-sub "\\~{}" l)) + ((== c #\^) (tmtex-text-sub "\\^{}" l)) + ((== c #\\) (tmtex-text-sub '(textbackslash) l)) + ((== c #\`) (tmtex-text-sub "`" l)) + ((== c #\x00) (tmtex-text-sub "\\`{}" l)) + ((== c #\x01) (tmtex-text-sub "\\'{}" l)) + ((== c #\x04) (tmtex-text-sub "\\\"{}" l)) + ((== c #\x05) (tmtex-text-sub "\\H{}" l)) + ((== c #\x06) (tmtex-text-sub "\\r{}" l)) + ((== c #\x07) (tmtex-text-sub "\\v{}" l)) + ((== c #\x08) (tmtex-text-sub "\\u{}" l)) + ((== c #\x09) (tmtex-text-sub "\\={}" l)) + ((== c #\x0A) (tmtex-text-sub "\\.{}" l)) + ((== c #\x0E) (tmtex-text-sub "\\k{}" l)) + ((== c #\x10) (tmtex-text-sub "``" l)) + ((== c #\x11) (tmtex-text-sub "''" l)) + ((== c #\x12) (tmtex-text-sub ",," l)) + ((== c #\x15) (tmtex-text-sub "--" l)) + ((== c #\x16) (tmtex-text-sub "---" l)) + ((== c #\x17) (tmtex-text-sub "{}" l)) + ((== c #\x1B) (tmtex-text-sub "ff" l)) + ((== c #\x1C) (tmtex-text-sub '(textbackslash) l)) + ((== c #\x1D) (tmtex-text-sub "fl" l)) + ((== c #\x1E) (tmtex-text-sub "ffi" l)) + ((== c #\x1F) (tmtex-text-sub "ffl" l)) + ((== c #\|) (tmtex-text-sub '(textbar) l)) + (else (append (if (or tmtex-use-unicode? tmtex-use-ascii?) + (string->list (string-convert (char->string c) "Cork" "UTF-8")) + (list c) + ) ;if + (tmtex-text-list (cdr l)) + ) ;append + ) ;else + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-math-operator l) - (receive (p q) (list-break l (lambda (c) (not (char-alphabetic? c)))) - (let* ((op (tmtex-textual (list->string p))) - (tail (tmtex-math-list q))) + (receive (p q) + (list-break l (lambda (c) (not (char-alphabetic? c)))) + (let* ((op (tmtex-textual (list->string p))) (tail (tmtex-math-list q))) (if (logic-in? (string->symbol op) latex-operator%) - (cons (list '!symbol (tex-apply (string->symbol op))) tail) - (cons (post-process-math-text (tex-apply 'tmop op)) tail))))) + (cons (list '!symbol (tex-apply (string->symbol op))) tail) + (cons (post-process-math-text (tex-apply 'tmop op)) tail) + ) ;if + ) ;let* + ) ;receive +) ;define (define (tmtex-math-list l) - (if (null? l) l - (let ((c (car l))) - (cond ((== c #\<) (tmtex-token l tmtex-math-list #f)) - ((tmtex-special-char? c) - (cons (list (string->symbol (char->string c))) - (tmtex-math-list (cdr l)))) - ((== c #\~) (tmtex-math-list (cdr l))) - ((== c #\^) (tmtex-math-list (cdr l))) - ((== c #\\) - (cons (list 'backslash) (tmtex-math-list (cdr l)))) -;; ((== c #\*) (cons '(*) (tmtex-math-list (cdr l)))) - ((== c #\*) (tmtex-math-list (cdr l))) - ((== c #\') (append (list '(prime)) (tmtex-math-list (cdr l)))) - ((== c #\`) (append (list '(backprime)) (tmtex-math-list (cdr l)))) -;; ((== c #\space) (tmtex-math-list (cdr l))) - ((and (char-alphabetic? c) - (nnull? (cdr l)) - (char-alphabetic? (cadr l))) - (tmtex-math-operator l)) - (else - (with c - (if (or tmtex-use-unicode? tmtex-use-ascii?) - (string->list (string-convert (char->string c) - "Cork" "UTF-8")) - (list c)) - (append c (tmtex-math-list (cdr l))))))))) + (if (null? l) + l + (let ((c (car l))) + (cond ((== c #\<) (tmtex-token l tmtex-math-list #f)) + ((tmtex-special-char? c) + (cons (list (string->symbol (char->string c))) (tmtex-math-list (cdr l))) + ) ; + ((== c #\~) (tmtex-math-list (cdr l))) + ((== c #\^) (tmtex-math-list (cdr l))) + ((== c #\\) (cons (list 'backslash) (tmtex-math-list (cdr l)))) + ;; ((== c #\*) (cons '(*) (tmtex-math-list (cdr l)))) + ((== c #\*) (tmtex-math-list (cdr l))) + ((== c #\') (append (list '(prime)) (tmtex-math-list (cdr l)))) + ((== c #\`) (append (list '(backprime)) (tmtex-math-list (cdr l)))) + ;; ((== c #\space) (tmtex-math-list (cdr l))) + ((and (char-alphabetic? c) (nnull? (cdr l)) (char-alphabetic? (cadr l))) + (tmtex-math-operator l) + ) ; + (else (with c + (if (or tmtex-use-unicode? tmtex-use-ascii?) + (string->list (string-convert (char->string c) "Cork" "UTF-8")) + (list c) + ) ;if + (append c (tmtex-math-list (cdr l))) + ) ;with + ) ;else + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-verb-list l) - (if (null? l) l - (let ((c (car l))) - (if (== c #\<) - (let ((r (tmtex-token l tmtex-verb-list #t))) - (if (char? (car r)) r (cdr r))) - (cons c (tmtex-verb-list (cdr l))))))) + (if (null? l) + l + (let ((c (car l))) + (if (== c #\<) + (let ((r (tmtex-token l tmtex-verb-list #t))) + (if (char? (car r)) r (cdr r)) + ) ;let + (cons c (tmtex-verb-list (cdr l))) + ) ;if + ) ;let + ) ;if +) ;define (define (tmtex-string-break? x start) (or (not (char? x)) - (and (tmtex-math-mode?) - (or (tmtex-break-char? x) - (and (char-alphabetic? x) (char-numeric? start)) - (and (char-alphabetic? start) (char-numeric? x)))))) + (and (tmtex-math-mode?) + (or (tmtex-break-char? x) + (and (char-alphabetic? x) (char-numeric? start)) + (and (char-alphabetic? start) (char-numeric? x)) + ) ;or + ) ;and + ) ;or +) ;define (define (tmtex-string-produce l) - (if (null? l) l - (if (not (tmtex-string-break? (car l) (car l))) - (receive (p q) - (list-break l (lambda (x) (tmtex-string-break? x (car l)))) - (cons (list->string p) (tmtex-string-produce q))) - (if (equal? (car l) #\space) - (tmtex-string-produce (cdr l)) - (cons (if (char? (car l)) (char->string (car l)) (car l)) - (tmtex-string-produce (cdr l))))))) + (if (null? l) + l + (if (not (tmtex-string-break? (car l) (car l))) + (receive (p q) + (list-break l (lambda (x) (tmtex-string-break? x (car l)))) + (cons (list->string p) (tmtex-string-produce q)) + ) ;receive + (if (equal? (car l) #\space) + (tmtex-string-produce (cdr l)) + (cons (if (char? (car l)) (char->string (car l)) (car l)) + (tmtex-string-produce (cdr l)) + ) ;cons + ) ;if + ) ;if + ) ;if +) ;define (define (tmtex-string s) (if (> (string-length s) 1000) `(!concat ,@(map tmtex (tmstring-split s))) (let* ((l (string->list s)) - (t (if (tmtex-math-mode?) - (tmtex-math-list l) - (tmtex-text-list l))) - (r (tmtex-string-produce t))) - (tex-concat r)))) + (t (if (tmtex-math-mode?) (tmtex-math-list l) (tmtex-text-list l))) + (r (tmtex-string-produce t)) + ) ; + (tex-concat r) + ) ;let* + ) ;if +) ;define (define (string-convert* what from to) - (with c (string->list what) + (with c + (string->list what) (apply string-append - (map (lambda (x) (string-convert (char->string x) from to)) c)))) + (map (lambda (x) (string-convert (char->string x) from to)) c) + ) ;apply + ) ;with +) ;define (define (tmtex-verb-string s) (when (nstring? s) - (set! s (texmacs->verbatim (tm->tree s)))) - (let* ((l (string->list s)) - (t (tmtex-verb-list l)) - (r (tmtex-string-produce t))) + (set! s (texmacs->verbatim (tm->tree s))) + ) ;when + (let* ((l (string->list s)) (t (tmtex-verb-list l)) (r (tmtex-string-produce t))) (if (or tmtex-use-unicode? tmtex-use-ascii?) - (set! r (map (lambda (x) (string-convert* x "Cork" "UTF-8")) r)) - (set! r (map unescape-angles r))) - (tex-concat r))) + (set! r (map (lambda (x) (string-convert* x "Cork" "UTF-8")) r)) + (set! r (map unescape-angles r)) + ) ;if + (tex-concat r) + ) ;let* +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Entire files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (tm-define (tmtex-transform-style x) - (cond ((in? x '("generic" "exam" - "old-generic" "old-article" - "tmarticle" "tmdoc" "mmxdoc")) "article") - ((in? x '("book" "old-book" "tmbook" "tmmanual")) "book") - ((in? x '("letter" "old-letter")) "letter") - ((in? x '("beamer" "old-beamer")) "beamer") - ((in? x '("seminar" "old-seminar")) "slides") + (cond ((in? x + '("generic" + "exam" + "old-generic" + "old-article" + "tmarticle" + "tmdoc" + "mmxdoc") + ) ;in? + "article" + ) ; + ((in? x '("book" "old-book" "tmbook" "tmmanual")) "book") + ((in? x '("letter" "old-letter")) "letter") + ((in? x '("beamer" "old-beamer")) "beamer") + ((in? x '("seminar" "old-seminar")) "slides") ((not tmtex-replace-style?) x) - (else #f))) + (else #f) + ) ;cond +) ;tm-define (define (tmtex-filter-styles l) - (if (null? l) l - (let* ((next (tmtex-transform-style (car l))) - (tail (tmtex-filter-styles (cdr l)))) - (if next (cons next tail) tail)))) + (if (null? l) + l + (let* ((next (tmtex-transform-style (car l))) (tail (tmtex-filter-styles (cdr l)))) + (if next (cons next tail) tail) + ) ;let* + ) ;if +) ;define (define (macro-definition? x) - (and (func? x 'assign 2) - (string? (cadr x)) - (func? (caddr x) 'macro))) + (and (func? x 'assign 2) (string? (cadr x)) (func? (caddr x) 'macro)) +) ;define (define (tmtex-filter-style-macro t) - (letrec ((ndef-style? (lambda (x env) (or (not (macro-definition? x)) - (nin? (cadr x) env)))) - (filter-style-macro - (lambda (t env) - (cond ((nlist? t) t) - (else (map (cut filter-style-macro <> env) - (filter (cut ndef-style? <> env) t))))))) - (with env (append (logic-first-list 'tmtex-methods%) - (logic-first-list 'tmtex-tmstyle%)) - (filter-style-macro t env)))) + (letrec ((ndef-style? (lambda (x env) (or (not (macro-definition? x)) (nin? (cadr x) env))) + ) ;ndef-style? + (filter-style-macro (lambda (t env) + (cond ((nlist? t) t) + (else (map (cut filter-style-macro <> env) (filter (cut ndef-style? <> env) t))) + ) ;cond + ) ;lambda + ) ;filter-style-macro + ) ; + (with env + (append (logic-first-list 'tmtex-methods%) (logic-first-list 'tmtex-tmstyle%)) + (filter-style-macro t env) + ) ;with + ) ;letrec +) ;define (define (comment-preamble t) (cond ((string? t) `(!comment ,t)) - ((or (func? t 'para) - (func? t 'concat) - (func? t 'document)) (map comment-preamble t)) - (else t))) + ((or (func? t 'para) (func? t 'concat) (func? t 'document)) + (map comment-preamble t) + ) ; + (else t) + ) ;cond +) ;define (define (tmtex-filter-preamble l) (cond ((or (nlist? l) (null? l)) '()) ((macro-definition? l) (list l)) - ((and (func? l 'hide-preamble 1) - (list>0? (cadr l))) (map comment-preamble (cdadr l))) - (else (append-map tmtex-filter-preamble (cdr l))))) + ((and (func? l 'hide-preamble 1) (list>0? (cadr l))) + (map comment-preamble (cdadr l)) + ) ; + (else (append-map tmtex-filter-preamble (cdr l))) + ) ;cond +) ;define (define (tmtex-non-preamble-statement? l) (cond ((or (nlist? l) (null? l)) #t) ((== (car l) 'assign) #f) ((== (car l) 'hide-preamble) #f) ((func? l 'mtm 2) (tmtex-non-preamble-statement? (caddr l))) - (else #t))) + (else #t) + ) ;cond +) ;define (define (tmtex-filter-body l) (cond ((or (nlist? l) (null? l)) l) ((== (car l) 'assign) "") ((== (car l) 'hide-preamble) "") ((in? (car l) '(concat document)) - (with a (list-filter (cdr l) tmtex-non-preamble-statement?) + (with a + (list-filter (cdr l) tmtex-non-preamble-statement?) (if (null? a) - (if (== (car l) 'concat) "" '(document "")) - (cons (car l) (map tmtex-filter-body a))))) - (else (cons (car l) (map tmtex-filter-body (cdr l)))))) + (if (== (car l) 'concat) "" '(document "")) + (cons (car l) (map tmtex-filter-body a)) + ) ;if + ) ;with + ) ; + (else (cons (car l) (map tmtex-filter-body (cdr l)))) + ) ;cond +) ;define (define (tmtex-filter-duplicates* l t) (cond ((null? l) l) ((func? (car l) 'assign 2) (let* ((var (cadr (car l))) (r (tmtex-filter-duplicates* (cdr l) t)) - (dup? (ahash-ref t var))) + (dup? (ahash-ref t var)) + ) ; (ahash-set! t var #t) - (if dup? r (cons (car l) r)))) - ((or (func? (car l) 'concat) - (func? (car l) 'para) - (func? (car l) 'document)) - (with r (tmtex-filter-duplicates* (cdr l) t) - (cons (cons (caar l) (tmtex-filter-duplicates* (cdar l) t)) r))) - (else (cons (car l) (tmtex-filter-duplicates* (cdr l) t))))) + (if dup? r (cons (car l) r)) + ) ;let* + ) ; + ((or (func? (car l) 'concat) (func? (car l) 'para) (func? (car l) 'document)) + (with r + (tmtex-filter-duplicates* (cdr l) t) + (cons (cons (caar l) (tmtex-filter-duplicates* (cdar l) t)) r) + ) ;with + ) ; + (else (cons (car l) (tmtex-filter-duplicates* (cdr l) t))) + ) ;cond +) ;define (define (tmtex-filter-duplicates l) - (with t (make-ahash-table) - (tmtex-filter-duplicates* l t))) + (with t (make-ahash-table) (tmtex-filter-duplicates* l t)) +) ;define (define (tmtex-apply-init body init) - ;;(display* "init= " init "\n") + ;; (display* "init= " init "\n") (cond ((== (assoc-ref init "language") "verbatim") - (with init* (assoc-remove! init "language") - (tmtex-apply-init `(verbatim ,body) init*))) - (else body))) + (with init* + (assoc-remove! init "language") + (tmtex-apply-init `(verbatim ,body) init*) + ) ;with + ) ; + (else body) + ) ;cond +) ;define (define (tmtex-clean-body b) - (when (and (func? b '!document) - (> (length b) 1) - (== (cadr b) `(!document ""))) - (set! b (cons (car b) (cddr b)))) - b) + (when (and (func? b '!document) (> (length b) 1) (== (cadr b) '(!document ""))) + (set! b (cons (car b) (cddr b))) + ) ;when + b +) ;define (define (tmtex-file l) (let* ((doc (car l)) (styles (cadr l)) (init* (cadddr l)) (init (or (and (!= init* "#f") init*) '(collection))) - (init-bis (if (list>1? init) - (map (lambda (x) (cons (cadr x) (caddr x))) (cdr init)) - '())) + (init-bis (if (list>1? init) (map (lambda (x) (cons (cadr x) (caddr x))) (cdr init)) '()) + ) ;init-bis (att (or (cadddr (cdr l)) '())) (doc-pre (tmtex-filter-preamble (tmtex-filter-style-macro doc))) (doc-preamble (tmtex-filter-duplicates doc-pre)) (doc-body-pre (tmtex-filter-body doc)) - (doc-body (tmtex-apply-init doc-body-pre init-bis))) + (doc-body (tmtex-apply-init doc-body-pre init-bis)) + ) ; (init-mode-stats doc-body-pre) (latex-set-texmacs-style (if (pair? styles) (car styles) "none")) (latex-set-texmacs-packages (if (pair? styles) (cdr styles) (list))) (if (== (get-preference "texmacs->latex:expand-user-macros") "on") - (set! doc-preamble '())) - (if (null? styles) (tmtex doc) + (set! doc-preamble '()) + ) ;if + (if (null? styles) + (tmtex doc) (let* ((styles* (tmtex-filter-styles styles)) - (styles** (if (and (== styles* (list "article")) - (in? `(associate "par-columns" "2") init)) - (list `("twocolumn" "article")) - styles*)) - (preamble* (ahash-with tmtex-env :preamble #t - (map-in-order tmtex-pre doc-preamble))) + (styles** (if (and (== styles* (list "article")) (in? '(associate "par-columns" + "2") init)) + (list '("twocolumn" "article")) + styles* + ) ;if + ) ;styles** + (preamble* (ahash-with tmtex-env :preamble #t (map-in-order tmtex-pre doc-preamble)) + ) ;preamble* (body* (tmtex-postprocess-body (tmtex doc-body))) (body** (tmtex-clean-body body*)) - (needs (list tmtex-languages tmtex-colors tmtex-colormaps))) - (list '!file body** styles** needs init preamble*))))) + (needs (list tmtex-languages tmtex-colors tmtex-colormaps)) + ) ; + (list '!file body** styles** needs init preamble*) + ) ;let* + ) ;if + ) ;let* +) ;define (define (convert-charset t) (cond ((string? t) (unescape-angles (utf8->cork t))) - ((list>0? t) `(,(car t) ,@(map convert-charset (cdr t)))))) + ((list>0? t) `(,(car t) ,@(map convert-charset (cdr t)))) + ) ;cond +) ;define (define (tmtex-ilx l) - `(!invariant ,(car l))) + `(!invariant ,(car l)) +) ;define (define (tmtex-mtm l) (cond ((null? l) "") ((null? (cdr l)) (tmtex (car l))) - (else - (with lab (car l) - (when (func? lab 'mtm 1) (set! lab (cadr lab))) - `(!concat (!marker btm ,lab) - ,(tmtex (cadr l)) - (!marker etm ,lab)))))) + (else (with lab + (car l) + (when (func? lab 'mtm 1) + (set! lab (cadr lab)) + ) ;when + `(!concat (!marker btm ,lab) + ,(tmtex (cadr l)) + (!marker etm ,lab)) + ) ;with + ) ;else + ) ;cond +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Simple text ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (tmtex-noop . l) "") -(define (tmtex-default s l) (cons (string->symbol s) (tmtex-list l))) -(define (tmtex-id l) (tmtex (car l))) -(define (tmtex-first l) (tmtex (car l))) -(define (tmtex-style-first s l) (tmtex (car l))) -(define (tmtex-second l) (tmtex (cadr l))) -(define (tmtex-style-second s l) (tmtex (cadr l))) -(define (tmtex-hide-part s l) "") -(define (tmtex-show-part s l) (tmtex (cadr l))) +(define (tmtex-noop . l) + "" +) ;define + +(define (tmtex-default s l) + (cons (string->symbol s) (tmtex-list l)) +) ;define + +(define (tmtex-id l) + (tmtex (car l)) +) ;define + +(define (tmtex-first l) + (tmtex (car l)) +) ;define + +(define (tmtex-style-first s l) + (tmtex (car l)) +) ;define + +(define (tmtex-second l) + (tmtex (cadr l)) +) ;define + +(define (tmtex-style-second s l) + (tmtex (cadr l)) +) ;define + +(define (tmtex-hide-part s l) + "" +) ;define + +(define (tmtex-show-part s l) + (tmtex (cadr l)) +) ;define (define (tmtex-error l) (display* "TeXmacs] error in conversion: " l "\n") - (if tmtex-debug-mode? "(error)" "")) + (if tmtex-debug-mode? "(error)" "") +) ;define (define (tmtex-line-note l) `(tmlinenote ,(tmtex (car l)) - ,(tmtex-decode-length (cadr l)) - ,(tmtex-decode-length (caddr l)))) + ,(tmtex-decode-length (cadr l)) + ,(tmtex-decode-length (caddr l))) +) ;define (define (tmtex-marginal-left-note l) - `(marginpar (!option ,(tmtex (cAr l))) ,(tmtex '()))) + `(marginpar (!option ,(tmtex (cAr l))) ,(tmtex '())) +) ;define (define (tmtex-marginal-right-note l) - `(marginpar (!option "") ,(tmtex (cAr l)))) + `(marginpar (!option "") ,(tmtex (cAr l))) +) ;define (define (tmtex-marginal-note l) (cond ((== (car l) "left") (tmtex-marginal-left-note (cdr l))) ((== (car l) "right") (tmtex-marginal-right-note (cdr l))) - (else `(marginpar ,(tmtex (cAr l)))))) + (else `(marginpar ,(tmtex (cAr l)))) + ) ;cond +) ;define (define (tmtex-document l) - (cons '!document (tmtex-list l))) + (cons '!document (tmtex-list l)) +) ;define (define (tmtex-date l) - (tmtex-default "tmdate" l)) + (tmtex-default "tmdate" l) +) ;define (define (tmtex-para l) - (cons '!paragraph (tmtex-list l))) + (tmtex-image-increment) + (cons '!paragraph (tmtex-list l)) +) ;define (define (tmtex-surround-sub l z) (if (null? (cdr l)) - (list (tex-concat (list (car l) z))) - (cons (car l) (tmtex-surround-sub (cdr l) z)))) + (list (tex-concat (list (car l) z))) + (cons (car l) (tmtex-surround-sub (cdr l) z)) + ) ;if +) ;define (define (tmtex-surround l) - (let* ((ll (tmtex-list l)) - (x (car ll)) - (y (caddr ll)) - (z (cadr ll))) + (let* ((ll (tmtex-list l)) (x (car ll)) (y (caddr ll)) (z (cadr ll))) (if (func? y '!document) - (let* ((a (cadr y)) - (b (cddr y))) - (cons '!document - (tmtex-surround-sub - (cons (tex-concat (list x a)) b) z))) - (tex-concat (list x y z))))) + (let* ((a (cadr y)) (b (cddr y))) + (cons '!document (tmtex-surround-sub (cons (tex-concat (list x a)) b) z)) + ) ;let* + (tex-concat (list x y z)) + ) ;if + ) ;let* +) ;define (define (tmtex-no-space-before? x) (or (func? x '!sub) - (func? x '!sup) - (and (string? x) (!= x "") - (in? (string-ref x 0) '(#\' #\, #\) #\]))) - (and (func? x '!concat) (tmtex-no-space-before? (cadr x))))) + (func? x '!sup) + (and (string? x) (!= x "") (in? (string-ref x 0) '(#\' #\, #\) #\]))) + (and (func? x '!concat) (tmtex-no-space-before? (cadr x))) + ) ;or +) ;define (define (tmtex-no-space-after? x) - (or (and (string? x) (!= x "") - (in? (string-ref x 0) '(#\( #\[))) - (and (func? x '!concat) (tmtex-no-space-after? (cAr x))))) + (or (and (string? x) (!= x "") (in? (string-ref x 0) '(#\( #\[))) + (and (func? x '!concat) (tmtex-no-space-after? (cAr x))) + ) ;or +) ;define (define (tmtex-math-concat-spaces l) - (if (or (null? l) (null? (cdr l))) l - (let* ((head (car l)) - (tail (tmtex-math-concat-spaces (cdr l)))) - (if (or (tmtex-no-space-after? head) - (tmtex-no-space-before? (car tail))) - (cons head tail) - (cons* head " " tail))))) + (if (or (null? l) (null? (cdr l))) + l + (let* ((head (car l)) (tail (tmtex-math-concat-spaces (cdr l)))) + (if (or (tmtex-no-space-after? head) (tmtex-no-space-before? (car tail))) + (cons head tail) + (cons* head " " tail) + ) ;if + ) ;let* + ) ;if +) ;define (define (tmtex-rewrite-no-break l) (cond ((null? l) l) - ((and (string? (car l)) (string-ends? (car l) " ") - (nnull? (cdr l)) (== (cadr l) '(no-break))) + ((and (string? (car l)) + (string-ends? (car l) " ") + (nnull? (cdr l)) + (== (cadr l) '(no-break)) + ) ;and (let* ((s (substring (car l) 0 (- (string-length (car l)) 1))) - (r (tmtex-rewrite-no-break (cddr l)))) - (if (== s "") (cons '(!nbsp) r) (cons* s '(!nbsp) r)))) - (else (cons (car l) (tmtex-rewrite-no-break (cdr l)))))) + (r (tmtex-rewrite-no-break (cddr l))) + ) ; + (if (== s "") (cons '(!nbsp) r) (cons* s '(!nbsp) r)) + ) ;let* + ) ; + (else (cons (car l) (tmtex-rewrite-no-break (cdr l)))) + ) ;cond +) ;define (define (check-double-script? l sub? sup?) (cond ((or (null? l) (npair? (car l))) #f) - ((== (caar l) 'rsub) - (or sub? (check-double-script? (cdr l) #t sup?))) - ((in? (caar l) '(rsup rprime)) - (or sup? (check-double-script? (cdr l) sub? #t))) - (else #f))) + ((== (caar l) 'rsub) (or sub? (check-double-script? (cdr l) #t sup?))) + ((in? (caar l) '(rsup rprime)) (or sup? (check-double-script? (cdr l) sub? #t))) + (else #f) + ) ;cond +) ;define (define (pre-scripts l) (cond ((or (null? l) (null? (cdr l))) l) ((check-double-script? (cdr l) #f #f) (if (== (== (caadr l) 'rsub) (== (caaddr l) 'rsub)) - (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l))) - (cddr l))) - (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l) ,(caddr l))) - (cdddr l))))) - (else - (cons (car l) (pre-scripts (cdr l)))))) + (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l))) (cddr l))) + (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l) ,(caddr l))) (cdddr l))) + ) ;if + ) ; + (else (cons (car l) (pre-scripts (cdr l)))) + ) ;cond +) ;define (define (tmtex-concat l) - ;;(display* "l= " l "\n") + ;; (display* "l= " l "\n") (if (> (length l) 50) - (with s (quotient (length l) 2) - (let ((h (list-head l s)) - (t (list-tail l s))) - (tmtex-concat `((concat ,@h) (concat ,@t))))) + (with s + (quotient (length l) 2) + (let ((h (list-head l s)) (t (list-tail l s))) + (tmtex-concat `((concat ,@h) (concat ,@t))) + ) ;let + ) ;with (if (tmtex-math-mode?) - (with l* (pre-scripts l) - ;;(when (!= l* l) (display* l " -> " l* "\n")) - ;;(display* "l1= " l* "\n") - ;;(display* "l2= " (pre-brackets-recurse l*) "\n") - ;;(display* "l3= " (tmtex-list (pre-brackets-recurse l*)) "\n") - (tex-concat (tmtex-math-concat-spaces - (tmtex-list (pre-brackets-recurse l*))))) - (tex-concat (tmtex-list (tmtex-rewrite-no-break l)))))) + (with l* + (pre-scripts l) + ;; (when (!= l* l) (display* l " -> " l* "\n")) + ;; (display* "l1= " l* "\n") + ;; (display* "l2= " (pre-brackets-recurse l*) "\n") + ;; (display* "l3= " (tmtex-list (pre-brackets-recurse l*)) "\n") + (tex-concat (tmtex-math-concat-spaces (tmtex-list (pre-brackets-recurse l*)))) + ) ;with + (tex-concat (tmtex-list (tmtex-rewrite-no-break l))) + ) ;if + ) ;if +) ;define (define (tmtex-rigid l) - (tmtex-function '!group l)) + (tmtex-function '!group l) +) ;define + +(define (tmtex-no-first-indentation l) + (tex-apply 'noindent) +) ;define + +(define (tmtex-line-break l) + (tex-apply 'linebreak) +) ;define + +(define (tmtex-page-break l) + (tex-apply 'pagebreak) +) ;define + +(define (tmtex-new-page l) + (tex-apply 'newpage) +) ;define -(define (tmtex-no-first-indentation l) (tex-apply 'noindent)) -(define (tmtex-line-break l) (tex-apply 'linebreak)) -(define (tmtex-page-break l) (tex-apply 'pagebreak)) -(define (tmtex-new-page l) (tex-apply 'newpage)) -(define (tmtex-no-page-break l) (tex-apply 'nopagebreak)) -(define (tmtex-next-line l) (list '!nextline)) -(define (tmtex-no-break l) '(!group (nobreak))) -(define (tmtex-emdash l) "---") +(define (tmtex-no-page-break l) + (tex-apply 'nopagebreak) +) ;define + +(define (tmtex-next-line l) + (list '!nextline) +) ;define + +(define (tmtex-no-break l) + '(!group (nobreak)) +) ;define + +(define (tmtex-emdash l) + "---" +) ;define (define (tmtex-new-line l) - (if (tmtex-math-mode?) (tmtex-next-line l) (tex-apply '!newline))) + (if (tmtex-math-mode?) (tmtex-next-line l) (tex-apply '!newline)) +) ;define (tm-define (tmtex-decode-length len) ;; FIXME: should be completed - (with s (force-string len) - (cond ((string-ends? s "fn") (string-replace s "fn" "em")) - ((string-ends? s "tab") (string-replace s "tab" "em")) - ((string-ends? s "spc") (string-replace s "spc" "em")) - ((string-ends? s "sep") (string-replace s "sep" "ex")) - ((string-ends? s "par") (string-replace s "par" "\\columnwidth")) - ((string-ends? s "pag") (string-replace s "pag" "\\textheight")) - (else s)))) - -(define (tmtex-hrule s l) (list 'hrulefill)) + (with s + (force-string len) + (cond ((string-ends? s "fn") (string-replace s "fn" "em")) + ((string-ends? s "tab") (string-replace s "tab" "em")) + ((string-ends? s "spc") (string-replace s "spc" "em")) + ((string-ends? s "sep") (string-replace s "sep" "ex")) + ((string-ends? s "par") (string-replace s "par" "\\columnwidth")) + ((string-ends? s "pag") (string-replace s "pag" "\\textheight")) + (else s) + ) ;cond + ) ;with +) ;tm-define + +(define (tmtex-hrule s l) + (list 'hrulefill) +) ;define (define (tmtex-hspace l) (let ((s (if (= (length l) 1) (car l) (cadr l)))) @@ -984,87 +1346,123 @@ (cond ((== s "0.4spc") (list (string->symbol ","))) ((== s "0.6spc") (list (string->symbol ","))) ((== s "0.16667em") (list (string->symbol ","))) - (else (tex-apply 'hspace (tmtex-decode-length s))))) + (else (tex-apply 'hspace (tmtex-decode-length s))) + ) ;cond + ) ; ((== s "0.4spc") (list (string->symbol ":"))) ((== s "0.6spc") (list (string->symbol ";"))) ((== s "-0.6spc") '(!concat (!) (!) (!))) ((== s "-0.4spc") '(!concat (!) (!))) ((== s "-0.2spc") '(!concat (!))) - (else (tex-apply 'hspace (tmtex-decode-length s)))))) + (else (tex-apply 'hspace (tmtex-decode-length s))) + ) ;cond + ) ;let +) ;define (define (tmtex-hspace* s l) - (tmtex-hspace l)) + (tmtex-hspace l) +) ;define (define (tmtex-vspace l) (let ((s (if (= (length l) 1) (car l) (cadr l)))) (cond ((== s "0.5fn") (tex-apply 'smallskip)) ((== s "1fn") (tex-apply 'medskip)) ((== s "2fn") (tex-apply 'bigskip)) - (else (tex-apply 'vspace (tmtex-decode-length s)))))) + (else (tex-apply 'vspace (tmtex-decode-length s))) + ) ;cond + ) ;let +) ;define (define (tmtex-space l) - (tmtex-hspace (list (car l)))) + (tmtex-hspace (list (car l))) +) ;define (define (into-single-paragraph t) - (set! t (tm-replace t (lambda (x) (tm-in? x '(equation equation*))) - (lambda (x) - (if (and (== (length x) 2) - (tm-func? (cadr x) 'document 1)) - `(math ,(cadr (cadr x))) - `(math ,@(cdr x)))))) - (set! t (tm-replace t (lambda (x) (tm-func? x 'document)) - (lambda (x) `(para ,@(cdr x))))) - t) + (set! t + (tm-replace t + (lambda (x) (tm-in? x '(equation equation*))) + (lambda (x) + (if (and (== (length x) 2) (tm-func? (cadr x) 'document 1)) + `(math ,(cadr (cadr x))) + `(math ,@(cdr x)) + ) ;if + ) ;lambda + ) ;tm-replace + ) ;set! + (set! t + (tm-replace t + (lambda (x) (tm-func? x 'document)) + (lambda (x) `(para ,@(cdr x))) + ) ;tm-replace + ) ;set! + t +) ;define (define (tmtex-float-make wide? size type position x capt) (let* ((pos (string-replace position "f" "")) (type* (if wide? (string-append type "*") type)) (body (tmtex x)) (caption (tmtex (into-single-paragraph capt))) - (body* `(!paragraph ,body (caption ,caption)))) + (body* `(!paragraph ,body (caption ,caption))) + ) ; (cond ((and (== size "big") (== type "figure")) (if (== pos "") - `((!begin ,type) ,body*) - `((!begin ,type* (!option ,pos)) ,body*))) + `((!begin ,type) ,body*) + `((!begin ,type* (!option ,pos)) ,body*) + ) ;if + ) ; ((and (== size "big") (== type "table")) (if (== pos "") - `((!begin ,type) ,body*) - `((!begin ,type* (!option ,pos)) ,body*))) - (else (list 'tmfloat pos size type* body caption))))) + `((!begin ,type) ,body*) + `((!begin ,type* (!option ,pos)) ,body*) + ) ;if + ) ; + (else (list 'tmfloat pos size type* body caption)) + ) ;cond + ) ;let* +) ;define (define (tmtex-float-table? x) - (or (func? x 'small-table 2) (func? x 'big-table 2))) + (or (func? x 'small-table 2) (func? x 'big-table 2)) +) ;define (define (tmtex-float-figure? x) - (or (func? x 'small-figure 2) (func? x 'big-figure 2))) + (or (func? x 'small-figure 2) (func? x 'big-figure 2)) +) ;define (define (tmtex-float-size l) (if (list? l) - (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big") - "big")) + (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big") + "big" + ) ;if +) ;define (define (tmtex-float-sub wide? position l) - (with pos (string-replace position "f" "") - (cond ((func? l 'document 1) - (tmtex-float-sub wide? pos (cadr l))) + (with pos + (string-replace position "f" "") + (cond ((func? l 'document 1) (tmtex-float-sub wide? pos (cadr l))) ((tmtex-float-figure? l) - (tmtex-float-make wide? (tmtex-float-size l) "figure" - pos (cadr l) (caddr l))) + (tmtex-float-make wide? (tmtex-float-size l) "figure" pos (cadr l) (caddr l)) + ) ; ((tmtex-float-table? l) - (tmtex-float-make wide? (tmtex-float-size l) "table" - pos (cadr l) (caddr l))) - (else - (tmtex-float-make wide? "big" "figure" - pos l ""))))) + (tmtex-float-make wide? (tmtex-float-size l) "table" pos (cadr l) (caddr l)) + ) ; + (else (tmtex-float-make wide? "big" "figure" pos l "")) + ) ;cond + ) ;with +) ;define (define (tmtex-float l) - (tmtex-float-sub #f (force-string (cadr l)) (caddr l))) + (tmtex-float-sub #f (force-string (cadr l)) (caddr l)) +) ;define (define (tmtex-wide-float l) - (tmtex-float-sub #t (force-string (cadr l)) (caddr l))) + (tmtex-float-sub #t (force-string (cadr l)) (caddr l)) +) ;define (define (tmtex-htab l) - (tex-apply 'hspace* (list 'fill))) + (tex-apply 'hspace* (list 'fill)) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Make brackets small when necessary @@ -1072,72 +1470,89 @@ (define (disable-large? x level) (cond ((string? x) #t) - ((func? x 'concat) - (list-and (map (cut disable-large? <> level) (cdr x)))) + ((func? x 'concat) (list-and (map (cut disable-large? <> level) (cdr x)))) ((tm-in? x '(left mid right)) #t) ((tm-in? x '(lsub lsup rsub rsup)) - (and (> level 0) (disable-large? (cadr x) (- level 1)))) + (and (> level 0) (disable-large? (cadr x) (- level 1))) + ) ; ((tm-in? x '(lprime rprime)) #t) - ((tm-in? x '(wide wide*)) - (disable-large? (cadr x) (- level 1))) - ((tm-in? x '(with rigid locus)) - (disable-large? (cAr x) level)) + ((tm-in? x '(wide wide*)) (disable-large? (cadr x) (- level 1))) + ((tm-in? x '(with rigid locus)) (disable-large? (cAr x) level)) ((tm-in? x '(math-up math-ss math-tt math-bf math-it math-sl)) - (and (== (tm-arity x) 1) (disable-large? (cadr x) level))) - (else #f))) + (and (== (tm-arity x) 1) (disable-large? (cadr x) level)) + ) ; + (else #f) + ) ;cond +) ;define (define (make-small s) (cond ((nstring? s) "") ((== s ".") "") ((<= (string-length s) 1) s) ((and (string-starts? s "<") (string-ends? s ">")) s) - (else (string-append "<" s ">")))) + (else (string-append "<" s ">")) + ) ;cond +) ;define (define (make-small-bracket x) - (if (tm-in? x '(left mid right)) (make-small (cadr x)) x)) + (if (tm-in? x '(left mid right)) (make-small (cadr x)) x) +) ;define (define (find-right l) (cond ((null? l) #f) ((func? (car l) 'left) #f) ((func? (car l) 'right) 2) - (else (with i (find-right (cdr l)) (and i (+ i 1)))))) + (else (with i (find-right (cdr l)) (and i (+ i 1)))) + ) ;cond +) ;define (define (pre-brackets l) (cond ((null? l) l) ((func? (car l) 'left) - (with n (find-right (cdr l)) - (if (not n) (cons (car l) (pre-brackets (cdr l))) - (let* ((r (pre-brackets (sublist l n (length l)))) - (m (sublist l 0 n))) - (if (disable-large? `(concat ,@m) 2) - (begin - ;;(display* "< " m "\n") - ;;(display* "> " (map make-small-bracket m) "\n") - (append (map make-small-bracket m) r)) - (append m r)))))) - (else (cons (car l) (pre-brackets (cdr l)))))) + (with n + (find-right (cdr l)) + (if (not n) + (cons (car l) (pre-brackets (cdr l))) + (let* ((r (pre-brackets (sublist l n (length l)))) (m (sublist l 0 n))) + (if (disable-large? `(concat ,@m) 2) + (begin + ;; (display* "< " m "\n") + ;; (display* "> " (map make-small-bracket m) "\n") + (append (map make-small-bracket m) r) + ) ;begin + (append m r) + ) ;if + ) ;let* + ) ;if + ) ;with + ) ; + (else (cons (car l) (pre-brackets (cdr l)))) + ) ;cond +) ;define (define (pre-brackets-recurse l) - (with r (pre-brackets l) - (if (== r l) r - (pre-brackets-recurse r)))) + (with r (pre-brackets l) (if (== r l) r (pre-brackets-recurse r))) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mathematics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (convert-around x) - (with d (downgrade-brackets x) - (tmtex-concat (if (pair? d) (cdr d) (list d))))) + (with d (downgrade-brackets x) (tmtex-concat (if (pair? d) (cdr d) (list d)))) +) ;define (define (tmtex-around l) - (convert-around (cons 'around l))) + (convert-around (cons 'around l)) +) ;define (define (tmtex-around* l) - (convert-around (cons 'around* l))) + (convert-around (cons 'around* l)) +) ;define (define (tmtex-big-around l) - (convert-around (cons 'big-around l))) + (convert-around (cons 'big-around l)) +) ;define (define (tmtex-large-decode s) (cond ((nstring? s) ".") @@ -1145,50 +1560,66 @@ ((in? s '("||" "<||>")) "\\|") ((== s "\\") "\\backslash") ((and (string-starts? s "<") (string-ends? s ">")) - (string-append "\\" (substring s 1 (- (string-length s) 1)))) - (else (string-append "\\" s)))) + (string-append "\\" (substring s 1 (- (string-length s) 1))) + ) ; + (else (string-append "\\" s)) + ) ;cond +) ;define (define (tmtex-large-decode-text s) (cond ((nstring? s) "") ((== s ".") "") ((in? s '("(" ")" "[" "]" "|" "/")) s) ((in? s '("{" "}")) (string-append "\\" s)) - (else - (display* "TeXmacs] non converted bracket: " s "\n") - ""))) + (else (display* "TeXmacs] non converted bracket: " s "\n") "") + ) ;cond +) ;define (define (tmtex-left l) (if (tmtex-math-mode?) - (let* ((s (tmtex-large-decode (car l))) - (n (if (= (length l) 2) (string->number (cadr l)) 0)) - (b (cond ((not n) "left") - ((= n 1) "bigl") - ((= n 2) "Bigl") - ((= n 3) "biggl") - ((= n 4) "Biggl") - (else "left")))) - (list (string->symbol (string-append b s)))) - (tmtex-large-decode-text (car l)))) + (let* ((s (tmtex-large-decode (car l))) + (n (if (= (length l) 2) (string->number (cadr l)) 0)) + (b (cond ((not n) "left") + ((= n 1) "bigl") + ((= n 2) "Bigl") + ((= n 3) "biggl") + ((= n 4) "Biggl") + (else "left") + ) ;cond + ) ;b + ) ; + (list (string->symbol (string-append b s))) + ) ;let* + (tmtex-large-decode-text (car l)) + ) ;if +) ;define (define (tmtex-mid l) (display* "TeXmacs] downgraded large middle delimiter: " (car l) "\n") (if (tmtex-math-mode?) - (with s (tmtex-large-decode (car l)) - (if (== s ".") "" s)) - (tmtex-large-decode-text (car l)))) + (with s (tmtex-large-decode (car l)) (if (== s ".") "" s)) + (tmtex-large-decode-text (car l)) + ) ;if +) ;define (define (tmtex-right l) (if (tmtex-math-mode?) - (let* ((s (tmtex-large-decode (car l))) - (n (if (= (length l) 2) (string->number (cadr l)) 0)) - (b (cond ((not n) "right") - ((= n 1) "bigr") - ((= n 2) "Bigr") - ((= n 3) "biggr") - ((= n 4) "Biggr") - (else "right")))) - (list (string->symbol (string-append b s)))) - (tmtex-large-decode-text (car l)))) + (let* ((s (tmtex-large-decode (car l))) + (n (if (= (length l) 2) (string->number (cadr l)) 0)) + (b (cond ((not n) "right") + ((= n 1) "bigr") + ((= n 2) "Bigr") + ((= n 3) "biggr") + ((= n 4) "Biggr") + (else "right") + ) ;cond + ) ;b + ) ; + (list (string->symbol (string-append b s))) + ) ;let* + (tmtex-large-decode-text (car l)) + ) ;if +) ;define (define (tmtex-big-decode s) (cond ((nstring? s) "bignone") @@ -1198,111 +1629,155 @@ ((== s "amalg") "coprod") ((== s "pluscup") "uplus") ((== s ".") "bignone") - (else (string-append "big" s)))) + (else (string-append "big" s)) + ) ;cond +) ;define (define (tmtex-big l) - (list (string->symbol (tmtex-big-decode (car l))))) + (list (string->symbol (tmtex-big-decode (car l)))) +) ;define (define (tmtex-decode-long-arrow s) (cond ((nstring? s) #f) ((and (string-starts? s "")) - (tmtex-decode-long-arrow (substring s 8 (- (string-length s) 1)))) - ((in? s '("minus" "leftarrow" "rightarrow" "leftrightarrow" - "equal" "Leftarrow" "Rightarrow" "Leftrightarrow" - "mapsto" "mapsfrom")) - (string->symbol (string-append "x" s))) - ((in? s '("leftrightarrows" "leftleftarrows" - "threeleftarrows" "fourleftarrows" - "rightleftarrows" "rightrightarrows" - "threerightarrows" "fourrightarrows")) - (string-append "")) + (tmtex-decode-long-arrow (substring s 8 (- (string-length s) 1))) + ) ; + ((in? s + '("minus" + "leftarrow" + "rightarrow" + "leftrightarrow" + "equal" + "Leftarrow" + "Rightarrow" + "Leftrightarrow" + "mapsto" + "mapsfrom") + ) ;in? + (string->symbol (string-append "x" s)) + ) ; + ((in? s + '("leftrightarrows" + "leftleftarrows" + "threeleftarrows" + "fourleftarrows" + "rightleftarrows" + "rightrightarrows" + "threerightarrows" + "fourrightarrows") + ) ;in? + (string-append "") + ) ; ((== s "Lleftarrow") "") ((== s "Rrightarrow") "") ((== s "LRleftrightarrow") "") - (else (string-append "<" s ">")))) + (else (string-append "<" s ">")) + ) ;cond +) ;define (define (tmtex-long-arrow l) - (with cmd (tmtex-decode-long-arrow (car l)) - (cond ((and (symbol? cmd) (== (length l) 2)) - (list cmd (tmtex (cadr l)))) - ((symbol? cmd) - (list cmd (list '!option (tmtex (caddr l))) (tmtex (cadr l)))) - ((== (length l) 2) - (list 'overset (tmtex (cadr l)) (tmtex cmd))) - ((== (cadr l) "") - (list 'underset (tmtex (caddr l)) (tmtex cmd))) - (else - (list 'underset (tmtex (caddr l)) - (list 'overset (tmtex (cadr l)) (tmtex cmd))))))) + (with cmd + (tmtex-decode-long-arrow (car l)) + (cond ((and (symbol? cmd) (== (length l) 2)) (list cmd (tmtex (cadr l)))) + ((symbol? cmd) (list cmd (list '!option (tmtex (caddr l))) (tmtex (cadr l)))) + ((== (length l) 2) (list 'overset (tmtex (cadr l)) (tmtex cmd))) + ((== (cadr l) "") (list 'underset (tmtex (caddr l)) (tmtex cmd))) + (else (list 'underset (tmtex (caddr l)) (list 'overset (tmtex (cadr l)) (tmtex cmd))) + ) ;else + ) ;cond + ) ;with +) ;define (define (tmtex-below l) - (list 'underset (tmtex (cadr l)) (tmtex (car l)))) + (list 'underset (tmtex (cadr l)) (tmtex (car l))) +) ;define (define (tmtex-above l) - (list 'overset (tmtex (cadr l)) (tmtex (car l)))) + (list 'overset (tmtex (cadr l)) (tmtex (car l))) +) ;define (define (tmtex-lsub l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex `(concat (!group) (rsub ,(car l))))) - (else (tmtex `(rsub ,(car l)))))) + (else (tmtex `(rsub ,(car l)))) + ) ;cond +) ;define (define (tmtex-lsup l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex `(concat (!group) (rsup ,(car l))))) - (else (tmtex `(rsup ,(car l)))))) + (else (tmtex `(rsup ,(car l)))) + ) ;cond +) ;define (define (tmtex-contains-table? x) (cond ((nlist? x) #f) ((and (>= (length x) 2) (== (car x) '!table)) #t) - (else (list-or (map-in-order tmtex-contains-table? (cdr x)))))) + (else (list-or (map-in-order tmtex-contains-table? (cdr x)))) + ) ;cond +) ;define (define (tmtex-script which script) - (with r (tmtex script) - (if (tmtex-contains-table? r) - (list which (list 'tmscript r)) - (list which r)))) + (with r + (tmtex script) + (if (tmtex-contains-table? r) (list which (list 'tmscript r)) (list which r)) + ) ;with +) ;define (define (tmtex-rsub l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex-script '!sub (car l))) - (else (list 'tmrsub (tmtex (car l)))))) + (else (list 'tmrsub (tmtex (car l)))) + ) ;cond +) ;define (define (tmtex-rsup l) (cond ((== (car l) "") "") ((tmtex-math-mode?) (tmtex-script '!sup (car l))) - (else (list 'tmrsup (tmtex (car l)))))) + (else (list 'tmrsup (tmtex (car l)))) + ) ;cond +) ;define (define (tmtex-modulo l) - (tmtex-script 'mod (car l))) + (tmtex-script 'mod (car l)) +) ;define (define (tmtex-frac l) - (tmtex-function 'frac l)) + (tmtex-function 'frac l) +) ;define (define (tmtex-sqrt l) (if (= (length l) 1) - (tmtex-function 'sqrt l) - (list 'sqrt - (list '!option (tmtex (cadr l))) - (tmtex (car l))))) + (tmtex-function 'sqrt l) + (list 'sqrt (list '!option (tmtex (cadr l))) (tmtex (car l))) + ) ;if +) ;define (define (tmtex-token? s) (or (= (string-length s) 1) - (and (!= s "") - (== (string-ref s 0) #\<) - (== (string-index s #\>) (- (string-length s) 1))))) + (and (!= s "") + (== (string-ref s 0) #\<) + (== (string-index s #\>) (- (string-length s) 1)) + ) ;and + ) ;or +) ;define (define (tmtex-wide-star? x) (cond ((func? x 'wide* 1) (tmtex-wide-star? (cadr x))) ((nstring? x) #t) - (else (not (tmtex-token? x))))) + (else (not (tmtex-token? x))) + ) ;cond +) ;define (define (tmtex-wide-star l) (let ((wide? (tmtex-wide-star? (car l))) (arg (tmtex (car l))) (acc (cadr l)) - (text? (not (tmtex-math-mode?)))) + (text? (not (tmtex-math-mode?))) + ) ; (if (and (string? acc) (string-starts? acc "" "^")) (list (if wide? 'uwidehat 'uhat) arg)) ((in? acc '("" "~")) (list (if wide? 'uwidetilde 'utilde) arg)) @@ -1324,57 +1799,56 @@ ((== acc "") (list 'underrightarrow arg)) ((== acc "") (list 'underleftarrow arg)) ((== acc "") (list 'underleftrightarrow arg)) - ((in? acc '("" "")) - (list 'underbrace arg)) + ((in? acc '("" "")) (list 'underbrace arg)) ((in? acc '("" "")) - (tmtex-below `(,(car l) (text (downbracefill))))) - ((in? acc '("" "")) - (list 'underbrace arg)) + (tmtex-below `(,(car l) (text (downbracefill)))) + ) ; + ((in? acc '("" "")) (list 'underbrace arg)) ((in? acc '("" "")) - (tmtex-below `(,(car l) (text (downbracefill))))) + (tmtex-below `(,(car l) (text (downbracefill)))) + ) ; ;; imperfect translations - ((in? acc '("" "")) - (list 'underbrace arg)) + ((in? acc '("" "")) (list 'underbrace arg)) ((in? acc '("" "")) - (tmtex-below `(,(car l) (text (downbracefill))))) - (else - (display* "TeXmacs] non converted accent below: " acc "\n") - arg)))) + (tmtex-below `(,(car l) (text (downbracefill)))) + ) ; + (else (display* "TeXmacs] non converted accent below: " acc "\n") arg) + ) ;cond + ) ;let +) ;define (define (tmtex-wide? x) (cond ((func? x 'wide 1) (tmtex-wide? (cadr x))) ((nstring? x) #t) - (else (not (tmtex-token? x))))) + (else (not (tmtex-token? x))) + ) ;cond +) ;define (define (tmtex-wide l) (let ((wide? (tmtex-wide? (car l))) (arg (tmtex (car l))) (acc (cadr l)) - (text? (not (tmtex-math-mode?)))) + (text? (not (tmtex-math-mode?))) + ) ; (if (and (string? acc) (string-starts? acc "" "^")) - (list (if text? '^ (if wide? 'widehat 'hat)) arg)) + ((in? acc '("" "^")) (list (if text? '^ (if wide? 'widehat 'hat)) arg)) ((in? acc '("" "~")) - (list (if text? '~ (if wide? 'widetilde 'tilde)) arg)) - ((== (cadr l) "") - (list (if text? '= 'overline) arg)) - ((== acc "") - (list (if text? '= (if wide? 'overline 'bar)) arg)) + (list (if text? '~ (if wide? 'widetilde 'tilde)) arg) + ) ; + ((== (cadr l) "") (list (if text? '= 'overline) arg)) + ((== acc "") (list (if text? '= (if wide? 'overline 'bar)) arg)) ((== acc "") (list (if wide? 'overrightarrow 'vec) arg)) ((== acc "") (list (if text? 'u 'breve) arg)) ((== acc "") (list 'invbreve arg)) ((== acc "") (list (if text? 'v 'check) arg)) ((== acc "") (list (if text? 'r 'ring) arg)) - ((== acc "") - (list (if text? (string->symbol "'") 'acute) arg)) - ((== acc "") - (list (if text? (string->symbol "`") 'grave) arg)) - ((== acc "") - (list (if text? (string->symbol ".") 'dot) arg)) - ((== acc "") - (list (if text? (string->symbol "\"") 'ddot) arg)) + ((== acc "") (list (if text? (string->symbol "'") 'acute) arg)) + ((== acc "") (list (if text? (string->symbol "`") 'grave) arg)) + ((== acc "") (list (if text? (string->symbol ".") 'dot) arg)) + ((== acc "") (list (if text? (string->symbol "\"") 'ddot) arg)) ((== acc "") (list 'dddot arg)) ((== acc "") (list 'ddddot arg)) ((== acc "") (list 'overrightarrow arg)) @@ -1383,160 +1857,200 @@ ((== acc "") (list 'overrightarrow arg)) ((== acc "") (list 'overleftarrow arg)) ((== acc "") (list 'overleftrightarrow arg)) - ((in? acc '("" "")) - (list 'overbrace arg)) + ((in? acc '("" "")) (list 'overbrace arg)) ((in? acc '("" "")) - (tmtex-above `(,(car l) (text (upbracefill))))) - ((in? acc '("" "")) - (list 'overbrace arg)) + (tmtex-above `(,(car l) (text (upbracefill)))) + ) ; + ((in? acc '("" "")) (list 'overbrace arg)) ((in? acc '("" "")) - (tmtex-above `(,(car l) (text (upbracefill))))) + (tmtex-above `(,(car l) (text (upbracefill)))) + ) ; ;; FIXME: imperfect translations - ((in? acc '("" "")) - (list 'overbrace arg)) + ((in? acc '("" "")) (list 'overbrace arg)) ((in? acc '("" "")) - (tmtex-above `(,(car l) (text (upbracefill))))) - (else - (display* "TeXmacs] non converted accent: " acc "\n") - arg)))) + (tmtex-above `(,(car l) (text (upbracefill)))) + ) ; + (else (display* "TeXmacs] non converted accent: " acc "\n") arg) + ) ;cond + ) ;let +) ;define (define (tmtex-neg l) - (tmtex-function 'not l)) + (tmtex-function 'not l) +) ;define (define (tmtex-tree l) (let* ((root (list '!begin "bundle" (tmtex (car l)))) - (children (map (lambda (x) (list 'chunk (tmtex x))) (cdr l)))) - (list root (tex-concat children)))) + (children (map (lambda (x) (list 'chunk (tmtex x))) (cdr l))) + ) ; + (list root (tex-concat children)) + ) ;let* +) ;define (define (tmtex-tree-eps l) - (tmtex-eps (cons 'tree l))) + (tmtex-eps (cons 'tree l)) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Hacks for tables with multi-paragraph cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (map-or l1 l2) - (if (or (null? l1) (null? l2)) (list) - (cons (or (car l1) (car l2)) (map-or (cdr l1) (cdr l2))))) + (if (or (null? l1) (null? l2)) + (list) + (cons (or (car l1) (car l2)) (map-or (cdr l1) (cdr l2))) + ) ;if +) ;define (define (tmtex-block-columns t) (cond ((tm-func? t 'tformat) (tmtex-block-columns (cAr t))) ((tm-func? t 'table 1) (tmtex-block-columns (cAr t))) ((tm-func? t 'table) (let* ((b1 (tmtex-block-columns `(table ,(cadr t)))) - (b2 (tmtex-block-columns `(table ,@(cddr t))))) - (map-or b1 b2))) + (b2 (tmtex-block-columns `(table ,@(cddr t)))) + ) ; + (map-or b1 b2) + ) ;let* + ) ; ((tm-func? t 'row) (map tmtex-block-columns (cdr t))) ((tm-func? t 'cell) (tmtex-block-columns (cAr t))) - (else (tm-func? t 'document)))) + (else (tm-func? t 'document)) + ) ;cond +) ;define (define (column-numbers l i) (cond ((null? l) (list)) ((car l) (cons i (column-numbers (cdr l) (+ i 1)))) - (else (column-numbers (cdr l) (+ i 1))))) + (else (column-numbers (cdr l) (+ i 1))) + ) ;cond +) ;define (define (block-align nr out-of) (let* ((c (number->string nr)) - (p (string-append "p{" (number->string (/ 12.0 out-of)) "cm}"))) - `(cwith "1" "-1" ,c ,c "cell-halign" ,p))) + (p (string-append "p{" (number->string (/ 12.0 out-of)) "cm}")) + ) ; + `(cwith ,"1" ,"-1" ,c ,c ,"cell-halign" ,p) + ) ;let* +) ;define (define (tmtex-block-adjust t) - (cond ((tm-func? t 'tformat) - (append (cDr t) (list (tmtex-block-adjust (cAr t))))) + (cond ((tm-func? t 'tformat) (append (cDr t) (list (tmtex-block-adjust (cAr t))))) ((tm-func? t 'table) - (let* ((b (tmtex-block-columns t)) - (n (column-numbers b 1))) - (if (null? n) t - `(tformat ,@(map (cut block-align <> (length n)) n) ,t)))) - (else t))) + (let* ((b (tmtex-block-columns t)) (n (column-numbers b 1))) + (if (null? n) t `(tformat ,@(map (cut block-align <> (length n)) n) + ,t)) + ) ;let* + ) ; + (else t) + ) ;cond +) ;define (define (tm-big-figure? t) - (tm-in? t '(big-figure big-table))) + (tm-in? t '(big-figure big-table)) +) ;define (define (tm-replace-figure t) - (cond ((tm-func? t 'big-figure) - (list 'tmfloat "h" "big" "figure" (cadr t) (caddr t))) - ((tm-func? t 'big-table) - (list 'tmfloat "h" "big" "table" (cadr t) (caddr t))) - (else t))) + (cond ((tm-func? t 'big-figure) (list 'tmfloat "h" "big" "figure" (cadr t) (caddr t))) + ((tm-func? t 'big-table) (list 'tmfloat "h" "big" "table" (cadr t) (caddr t))) + (else t) + ) ;cond +) ;define (define (tmtex-figure-adjust t) - (tm-replace t tm-big-figure? tm-replace-figure)) + (tm-replace t tm-big-figure? tm-replace-figure) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-table-rows-assemble tb bb rows) - (cond ((null? rows) - (if (null? bb) '() (if (car bb) (list (list 'hline)) '()))) + (cond ((null? rows) (if (null? bb) '() (if (car bb) (list (list 'hline)) '()))) (else (append (if (or (car tb) (car bb)) (list (list 'hline)) '()) - (cons (cons '!row (map tmtex (car rows))) - (tmtex-table-rows-assemble - (cdr tb) (cdr bb) (cdr rows))))))) + (cons (cons '!row (map tmtex (car rows))) + (tmtex-table-rows-assemble (cdr tb) (cdr bb) (cdr rows)) + ) ;cons + ) ;append + ) ;else + ) ;cond +) ;define (define (tmtex-table-make p) - (let ((tb (p 'rows 'tborder)) - (bb (p 'rows 'bborder)) - (l (p 'rows 'content))) - (cons '!table (tmtex-table-rows-assemble tb (cons (car tb) bb) l)))) + (let ((tb (p 'rows 'tborder)) (bb (p 'rows 'bborder)) (l (p 'rows 'content))) + (cons '!table (tmtex-table-rows-assemble tb (cons (car tb) bb) l)) + ) ;let +) ;define (define (tmtex-table-args-assemble lb rb ha) - (cond - ((null? ha) (if (null? rb) '() (list (if (car rb) "|" "")))) - (else (cons (if (or (car lb) (car rb)) "|" "") - (cons (car ha) (tmtex-table-args-assemble - (cdr lb) (cdr rb) (cdr ha))))))) + (cond ((null? ha) (if (null? rb) '() (list (if (car rb) "|" "")))) + (else (cons (if (or (car lb) (car rb)) "|" "") + (cons (car ha) (tmtex-table-args-assemble (cdr lb) (cdr rb) (cdr ha))) + ) ;cons + ) ;else + ) ;cond +) ;define (define (tmtex-table-args p) - (let ((lb (p 'cols 'lborder)) - (rb (p 'cols 'rborder)) - (l (p 'cols 'halign))) - (apply string-append - (tmtex-table-args-assemble lb (cons (car lb) rb) l)))) + (let ((lb (p 'cols 'lborder)) (rb (p 'cols 'rborder)) (l (p 'cols 'halign))) + (apply string-append (tmtex-table-args-assemble lb (cons (car lb) rb) l)) + ) ;let +) ;define (define (tmtex-table-apply key args x) (let* ((props (logic-ref tmtex-table-props% key)) - (wide? (and props (string-contains? (cadr props) "X")))) + (wide? (and props (string-contains? (cadr props) "X"))) + ) ; (when (== key 'rcl-table) - (latex-add-extra "tabls")) + (latex-add-extra "tabls") + ) ;when (when (and (not (tmtex-math-mode?)) (not wide?)) (set! x (tmtex-block-adjust x)) - (set! x (tmtex-figure-adjust x))) + (set! x (tmtex-figure-adjust x)) + ) ;when (if props - (let* ((env (if (tmtex-math-mode?) "array" "tabular")) - (env* (if wide? (list "tabularx" "1.0\\textwidth") (list env))) - (before (car props)) - (after (caddr props)) - (defaults (append (tmtable-cell-halign (cadr props)) - (tmtable-block-borders (cadddr props)))) - (p (tmtable-parser `(tformat ,@defaults ,x))) - (e `(!begin ,@env* ,(tmtex-table-args p))) - (r (tmtex-table-make p))) - (tex-concat (list before (list e r) after))) - (begin - (list `(!begin ,(symbol->string key) ,@args) - (tmtex-table-make (tmtable-parser x))))))) + (let* ((env (if (tmtex-math-mode?) "array" "tabular")) + (env* (if wide? (list "tabularx" "1.0\\textwidth") (list env))) + (before (car props)) + (after (caddr props)) + (defaults (append (tmtable-cell-halign (cadr props)) + (tmtable-block-borders (cadddr props)) + ) ;append + ) ;defaults + (p (tmtable-parser `(tformat ,@defaults ,x))) + (e `(!begin ,@env* ,(tmtex-table-args p))) + (r (tmtex-table-make p)) + ) ; + (tex-concat (list before (list e r) after)) + ) ;let* + (begin + (list `(!begin ,(symbol->string key) ,@args) + (tmtex-table-make (tmtable-parser x)) + ) ;list + ) ;begin + ) ;if + ) ;let* +) ;define (define (tmtex-tformat l) - (tmtex-table-apply 'tabular '() (cons 'tformat l))) + (tmtex-table-apply 'tabular '() (cons 'tformat l)) +) ;define (define (tmtex-table l) - (tmtex-table-apply 'tabular '() (cons 'table l))) + (tmtex-image-increment) + (tmtex-table-apply 'tabular '() (cons 'table l)) +) ;define (define (tmtex-stack l) (when (nnull? l) - (let* ((x (car l)) - (p (tmtable-parser x)) - (rows (p 'rows 'content))) + (let* ((x (car l)) (p (tmtable-parser x)) (rows (p 'rows 'content))) (latex-add-extra "mathtools") (tex-apply 'substack - (tex-concat - (list-intersperse - (map (lambda (row) - (tex-concat (map tmtex row))) - rows) - "\\\\")))))) + (tex-concat (list-intersperse (map (lambda (row) (tex-concat (map tmtex row))) rows) "\\\\") + ) ;tex-concat + ) ;tex-apply + ) ;let* + ) ;when +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Local and global environment changes @@ -1544,85 +2058,120 @@ (define (tmtex-get-with-cmd var val) (if (tmtex-math-mode?) - (or (logic-ref tex-with-cmd-math% (list var val)) - (logic-ref tex-with-cmd% (list var val))) - (logic-ref tex-with-cmd% (list var val)))) + (or (logic-ref tex-with-cmd-math% (list var val)) + (logic-ref tex-with-cmd% (list var val)) + ) ;or + (logic-ref tex-with-cmd% (list var val)) + ) ;if +) ;define (define (tmtex-get-assign-cmd var val) (if (== var "font-size") - (let ((x (* (string->number val) 10))) - (cond ((< x 1) #f) - ((< x 5.5) 'tiny) - ((< x 6.5) 'scriptsize) - ((< x 7.5) 'footnotesize) - ((< x 9.5) 'small) - ((< x 11.5) 'normalsize) - ((< x 13.5) 'large) - ((< x 15.5) 'Large) - ((< x 18.5) 'LARGE) - ((< x 22.5) 'huge) - ((< x 50) 'Huge) - (else #f))) - (logic-ref tex-assign-cmd% (list var val)))) + (let ((x (* (string->number val) 10))) + (cond ((< x 1) #f) + ((< x 5.5) 'tiny) + ((< x 6.5) 'scriptsize) + ((< x 7.5) 'footnotesize) + ((< x 9.5) 'small) + ((< x 11.5) 'normalsize) + ((< x 13.5) 'large) + ((< x 15.5) 'Large) + ((< x 18.5) 'LARGE) + ((< x 22.5) 'huge) + ((< x 50) 'Huge) + (else #f) + ) ;cond + ) ;let + (logic-ref tex-assign-cmd% (list var val)) + ) ;if +) ;define (define (tmlength->texlength len) ;; TODO: rewrite (quote x) -> x and (tmlen ...) -> ...pt - (with tmlen (string->tmlength (force-string len)) - (if (tmlength-null? tmlen) "0pt" - (let* ((val (tmlength-value tmlen)) - (unit (symbol->string (tmlength-unit tmlen))) - (val-string (number->string val))) - (cond ((== unit "fn") (string-append val-string "em")) - (else len)))))) + (with tmlen + (string->tmlength (force-string len)) + (if (tmlength-null? tmlen) + "0pt" + (let* ((val (tmlength-value tmlen)) + (unit (symbol->string (tmlength-unit tmlen))) + (val-string (number->string val)) + ) ; + (cond ((== unit "fn") (string-append val-string "em")) + (else len) + ) ;cond + ) ;let* + ) ;if + ) ;with +) ;define (define (tmtex-make-parmod x y z arg flag?) (set! x (tmlength->texlength x)) (set! y (tmlength->texlength y)) (set! z (tmlength->texlength z)) (if (and (tmlength-zero? (string->tmlength x)) - (tmlength-zero? (string->tmlength y)) - (tmlength-zero? (string->tmlength z)) - flag?) - arg - (list (list '!begin "tmparmod" x y z) arg))) + (tmlength-zero? (string->tmlength y)) + (tmlength-zero? (string->tmlength z)) + flag? + ) ;and + arg + (list (list '!begin "tmparmod" x y z) arg) + ) ;if +) ;define (define (tmtex-make-parsep x arg) (set! x (tmlength->texlength x)) - (list (list '!begin "tmparsep" x) arg)) + (list (list '!begin "tmparsep" x) arg) +) ;define (define (tmtex-make-lang val arg) (if (== val "verbatim") `(tt ,arg) (begin (if (nin? val tmtex-languages) - (set! tmtex-languages (append (list val) tmtex-languages))) + (set! tmtex-languages (append (list val) tmtex-languages)) + ) ;if (if (texout-multiline? arg) - `((!begin "otherlanguage" ,val) ,arg) - `(foreignlanguage ,val ,arg))))) + `((!begin ,"otherlanguage" ,val) ,arg) + `(foreignlanguage ,val ,arg) + ) ;if + ) ;begin + ) ;if +) ;define (define (tmtex-decode-color s . force-html) - (with cm (if (string-starts? s "#") "HTML" (named-color->xcolormap s)) + (with cm + (if (string-starts? s "#") "HTML" (named-color->xcolormap s)) (cond ((and (== cm "none") (nnull? force-html)) - (tmtex-decode-color (get-hex-color s) force-html)) + (tmtex-decode-color (get-hex-color s) force-html) + ) ; ((and (== cm "HTML") (nnull? force-html)) - `((!option "HTML") ,(html-color->latex-xcolor s))) + `((!option "HTML") ,(html-color->latex-xcolor s)) + ) ; ((== cm "texmacs") (when (nin? s tmtex-colors) - (set! tmtex-colors (append (list s) tmtex-colors))) - (string-replace s " " "")) - ((in? cm (list "x11names")) - (tmtex-decode-color (get-hex-color s) #t)) - (else - (when (and (nin? cm tmtex-colormaps) - (!= cm "xcolor") (!= cm "none")) - (set! tmtex-colormaps (append (list cm) tmtex-colormaps))) - (string-replace s " " ""))))) + (set! tmtex-colors (append (list s) tmtex-colors)) + ) ;when + (string-replace s " " "") + ) ; + ((in? cm (list "x11names")) (tmtex-decode-color (get-hex-color s) #t)) + (else (when (and (nin? cm tmtex-colormaps) (!= cm "xcolor") (!= cm "none")) + (set! tmtex-colormaps (append (list cm) tmtex-colormaps)) + ) ;when + (string-replace s " " "") + ) ;else + ) ;cond + ) ;with +) ;define (define (tmtex-make-color val arg) - (with ltxcolor (tmtex-decode-color val #t) + (with ltxcolor + (tmtex-decode-color val #t) (if (list? ltxcolor) - `(!group (!append (color ,@ltxcolor) ,arg)) - `(tmcolor ,ltxcolor ,arg)))) + `(!group (!append (color ,@ltxcolor) ,arg)) + `(tmcolor ,ltxcolor ,arg) + ) ;if + ) ;with +) ;define (define (post-process-math-text t) (cond ((or (nlist? t) (!= (length t) 2)) t) @@ -1635,182 +2184,232 @@ ((func? t 'mathsl 1) `(textsl ,(cadr t))) ((func? t 'mathtt 1) `(texttt ,(cadr t))) ((func? t 'tmop 1) `(textrm ,(cadr t))) - (else t))) + (else t) + ) ;cond +) ;define (define (tmtex-with-one var val arg) (if (== var "mode") - (let ((old (tmtex-env-get-previous "mode"))) - (cond ((and (== val "text") (!= old "text")) - (list 'text arg)) - ((and (== val "math") (!= old "math") - (ahash-ref tmtex-env :preamble)) - (list 'ensuremath arg)) - ((and (== val "math") (!= old "math")) - (list '!math arg)) - ((and (== val "prog") (== old "text")) - `(tt ,arg)) - ((and (== val "prog") (== old "math")) - `(text (tt ,arg))) - (else arg))) - (let ((w (tmtex-get-with-cmd var val)) - (a (tmtex-get-assign-cmd var val))) - (cond ((and w (tm-func? arg w 1)) arg) - ((in? w '(mathrm mathbf mathsf mathit mathtt mathsl)) - (post-process-math-text (list w arg))) - (w (list w arg)) - (a (list '!group (tex-concat (list (list a) " " arg)))) - ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg #t)) - ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg #t)) - ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg #f)) - ((== "par-par-sep" var) (tmtex-make-parsep val arg)) - ((== var "language") (tmtex-make-lang val arg)) - ((== var "color") (tmtex-make-color val arg)) - (else arg))))) + (let ((old (tmtex-env-get-previous "mode"))) + (cond ((and (== val "text") (!= old "text")) (list 'text arg)) + ((and (== val "math") (!= old "math") (ahash-ref tmtex-env :preamble)) + (list 'ensuremath arg) + ) ; + ((and (== val "math") (!= old "math")) (list '!math arg)) + ((and (== val "prog") (== old "text")) `(tt ,arg)) + ((and (== val "prog") (== old "math")) `(text (tt ,arg))) + (else arg) + ) ;cond + ) ;let + (let ((w (tmtex-get-with-cmd var val)) (a (tmtex-get-assign-cmd var val))) + (cond ((and w (tm-func? arg w 1)) arg) + ((in? w '(mathrm mathbf mathsf mathit mathtt mathsl)) + (post-process-math-text (list w arg)) + ) ; + (w (list w arg)) + (a (list '!group (tex-concat (list (list a) " " arg)))) + ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg #t)) + ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg #t)) + ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg #f)) + ((== "par-par-sep" var) (tmtex-make-parsep val arg)) + ((== var "language") (tmtex-make-lang val arg)) + ((== var "color") (tmtex-make-color val arg)) + (else arg) + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-with l) (cond ((null? l) "") ((null? (cdr l)) (tmtex (car l))) ((func? (cAr l) 'graphics) (tmtex-eps (cons 'with l))) - (else (let ((var (force-string (car l))) - (val (force-string (cadr l))) - (next (cddr l))) + (else (let ((var (force-string (car l))) (val (force-string (cadr l))) (next (cddr l))) (tmtex-env-set var val) (let ((r (tmtex-with-one var val (tmtex-with next)))) (tmtex-env-reset var) - r))))) + r + ) ;let + ) ;let + ) ;else + ) ;cond +) ;define (define (tmtex-with-wrapped l) (if (and (== (length l) 3) - (== (car l) "par-columns") - (== (cadr l) "1") - (tm-in? (caddr l) '(small-figure big-figure - small-table big-table))) - (tmtex-float-sub #t "h" (caddr l)) - (tmtex-with l))) + (== (car l) "par-columns") + (== (cadr l) "1") + (tm-in? (caddr l) '(small-figure big-figure small-table big-table)) + ) ;and + (tmtex-float-sub #t "h" (caddr l)) + (tmtex-with l) + ) ;if +) ;define (define (tmtex-var-name-sub l) - (if (null? l) l - (let ((c (car l)) (r (tmtex-var-name-sub (cdr l)))) - (cond ((char-alphabetic? c) (cons c r)) - ((char-numeric? c) - (cond ((char=? c #\0) (cons* #\z #\e #\r #\o r)) - ((char=? c #\1) (cons* #\o #\n #\e r)) - ((char=? c #\2) (cons* #\t #\w #\o r)) - ((char=? c #\3) (cons* #\t #\h #\r #\e #\e r)) - ((char=? c #\4) (cons* #\f #\o #\u #\r r)) - ((char=? c #\5) (cons* #\f #\i #\v #\e r)) - ((char=? c #\6) (cons* #\s #\i #\x r)) - ((char=? c #\7) (cons* #\s #\e #\v #\e #\n r)) - ((char=? c #\8) (cons* #\e #\i #\g #\h #\t r)) - ((char=? c #\9) (cons* #\n #\i #\n #\e r)) - (else r))) - ((and (char=? c #\*) (null? (cdr l))) (list c)) - (else r))))) + (if (null? l) + l + (let ((c (car l)) (r (tmtex-var-name-sub (cdr l)))) + (cond ((char-alphabetic? c) (cons c r)) + ((char-numeric? c) + (cond ((char=? c #\0) (cons* #\z #\e #\r #\o r)) + ((char=? c #\1) (cons* #\o #\n #\e r)) + ((char=? c #\2) (cons* #\t #\w #\o r)) + ((char=? c #\3) (cons* #\t #\h #\r #\e #\e r)) + ((char=? c #\4) (cons* #\f #\o #\u #\r r)) + ((char=? c #\5) (cons* #\f #\i #\v #\e r)) + ((char=? c #\6) (cons* #\s #\i #\x r)) + ((char=? c #\7) (cons* #\s #\e #\v #\e #\n r)) + ((char=? c #\8) (cons* #\e #\i #\g #\h #\t r)) + ((char=? c #\9) (cons* #\n #\i #\n #\e r)) + (else r) + ) ;cond + ) ; + ((and (char=? c #\*) (null? (cdr l))) (list c)) + (else r) + ) ;cond + ) ;let + ) ;if +) ;define (define (tmtex-var-name var) (cond ((nstring? var) "") - ((logic-in? (string->symbol var) tmtex-protected%) - (string-append "tm" var)) + ((logic-in? (string->symbol var) tmtex-protected%) (string-append "tm" var)) ((<= (string-length var) 1) var) - (else - (with r (list->string (tmtex-var-name-sub (string->list var))) - (if (and (string-occurs? "*" r) - (== (latex-type r) "undefined")) - (string-replace r "*" "star") - r))))) + (else (with r + (list->string (tmtex-var-name-sub (string->list var))) + (if (and (string-occurs? "*" r) (== (latex-type r) "undefined")) + (string-replace r "*" "star") + r + ) ;if + ) ;with + ) ;else + ) ;cond +) ;define (define (tmtex-tex-arg l) - (cons '!arg l)) + (cons '!arg l) +) ;define (define (tmtex-args-search x args) (cond ((null? args) #f) ((== x (car args)) 1) - (else - (let ((n (tmtex-args-search x (cdr args)))) - (if n (+ 1 n) #f))))) + (else (let ((n (tmtex-args-search x (cdr args)))) (if n (+ 1 n) #f))) + ) ;cond +) ;define (define (tmtex-args-sub l args) - (if (null? l) l - (cons (tmtex-args (car l) args) - (tmtex-args-sub (cdr l) args)))) + (if (null? l) l (cons (tmtex-args (car l) args) (tmtex-args-sub (cdr l) args))) +) ;define (define (tmtex-args x args) (cond ((nlist? x) x) ((or (func? x 'arg) (func? x 'value)) (let ((n (tmtex-args-search (cadr x) args))) - (if n (list '!arg (number->string n)) (tmtex-args-sub x args)))) - (else (tmtex-args-sub x args)))) + (if n (list '!arg (number->string n)) (tmtex-args-sub x args)) + ) ;let + ) ; + (else (tmtex-args-sub x args)) + ) ;cond +) ;define (define (tmtex-assign l) (let* ((var (tmtex-var-name (car l))) (bsvar (string-append "\\" var)) (type (latex-type var)) (def (if (== type "undefined") 'newcommand 'providecommand)) - (val (cadr l))) + (val (cadr l)) + ) ; (while (func? val 'quote 1) (set! val (cadr val))) (if (!= var "") - (begin - (tmtex-env-assign var val) - (cond ((string? val) - (let ((a (tmtex-get-assign-cmd var val))) - (if a (list a) (list def bsvar (tmtex val))))) - ((or (func? val 'macro) (func? val 'func)) - (if (null? (cddr val)) - (list def bsvar (tmtex (cAr val))) - (list def bsvar - (list '!option (number->string (- (length val) 2))) - (tmtex (tmtex-args (cAr val) (cDdr val)))))) - (else (list def bsvar (tmtex val))))) - ""))) + (begin + (tmtex-env-assign var val) + (cond ((string? val) + (let ((a (tmtex-get-assign-cmd var val))) + (if a (list a) (list def bsvar (tmtex val))) + ) ;let + ) ; + ((or (func? val 'macro) (func? val 'func)) + (if (null? (cddr val)) + (list def bsvar (tmtex (cAr val))) + (list def + bsvar + (list '!option (number->string (- (length val) 2))) + (tmtex (tmtex-args (cAr val) (cDdr val))) + ) ;list + ) ;if + ) ; + (else (list def bsvar (tmtex val))) + ) ;cond + ) ;begin + "" + ) ;if + ) ;let* +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Other primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-quote l) - (tmtex (car l))) + (tmtex (car l)) +) ;define (define (tmtex-hidden-binding l) (if (and (== (length l) 2) (string->number (force-string (cAr l)))) - (list 'custombinding (force-string (cAr l))) - "")) + (list 'custombinding (force-string (cAr l))) + "" + ) ;if +) ;define (define (tmtex-label l) - (list 'label (force-string (car l)))) + (list 'label (force-string (car l))) +) ;define (define (tmtex-reference l) - (list 'ref (force-string (car l)))) + (list 'ref (force-string (car l))) +) ;define (define (tmtex-pageref l) - (list 'pageref (force-string (car l)))) + (list 'pageref (force-string (car l))) +) ;define (define (tmtex-eqref s l) - (list 'eqref (force-string (car l)))) + (list 'eqref (force-string (car l))) +) ;define (define (tmtex-smart-ref s l) - (let* ((ss (map force-string l)) - (key (string-recompose ss ","))) - (list 'Cref key))) + (let* ((ss (map force-string l)) (key (string-recompose ss ","))) + (list 'Cref key) + ) ;let* +) ;define (define (tmtex-specific l) (cond ((== (car l) "latex") (tmtex-tt (cadr l))) ((== (car l) "image") (tmtex-eps (cadr l))) ((== (car l) "printer") (tmtex (cadr l))) - ((== (car l) "odd") `(ifthispageodd ,(tmtex (cadr l)) "")) - ((== (car l) "even") `(ifthispageodd "" ,(tmtex (cadr l)))) - (else ""))) + ((== (car l) "odd") `(ifthispageodd ,(tmtex (cadr l)) ,"")) + ((== (car l) "even") `(ifthispageodd ,"" ,(tmtex (cadr l)))) + (else "") + ) ;cond +) ;define (define (tmtex-eps-names) (set! tmtex-serial (+ tmtex-serial 1)) (let* ((suffix ".pdf") (postfix (string-append "-" (number->string tmtex-serial) suffix)) (name-url (url-glue tmtex-image-root-url postfix)) - (name-string (string-append tmtex-image-root-string postfix))) - (values name-url name-string))) + (name-string (string-append tmtex-image-root-string postfix)) + ) ; + (values name-url name-string) + ) ;let* +) ;define (define (tmtex-eps x) - (if (tmtex-math-mode?) (set! x `(with "mode" "math" ,x))) - (receive (name-url name-string) (tmtex-eps-names) + (tmtex-image-increment) + (if (tmtex-math-mode?) (set! x `(with ,"mode" ,"math" ,x))) + (receive (name-url name-string) + (tmtex-eps-names) (let* ((extents (print-snippet name-url x #t)) (unit (* (/ 1.0 60984.0) (/ 600.0 (tenth extents)))) (x3 (* unit (first extents))) @@ -1826,213 +2425,276 @@ (ww (string-append (number->string (- x4 x3)) "cm")) (hh (string-append (number->string (- y4 y3)) "cm")) (opt `(!option ,(string-append "width=" ww ",height=" hh))) - (rb `(includegraphics ,opt ,name-string))) + (rb `(includegraphics ,opt ,name-string)) + ) ; ;; TODO: top and bottom margins - ;;(display* name-url ": " x1 ", " y1 "; " x2 ", " y2 "\n") - ;;(display* name-url ": " x3 ", " y3 "; " x4 ", " y4 "\n") - (if (and (< (abs (- x3 x1)) 0.01) (< (abs (- x2 x4)) 0.01)) rb - `(!concat (hspace ,lm) ,rb (hspace ,rm)))))) + ;; (display* name-url ": " x1 ", " y1 "; " x2 ", " y2 "\n") + ;; (display* name-url ": " x3 ", " y3 "; " x4 ", " y4 "\n") + (if (and (< (abs (- x3 x1)) 0.01) (< (abs (- x2 x4)) 0.01)) + rb + `(!concat (hspace ,lm) ,rb (hspace ,rm)) + ) ;if + ) ;let* + ) ;receive +) ;define (define (tmtex-make-eps s l) - (tmtex-eps (cons (string->symbol s) l))) + (tmtex-eps (cons (string->symbol s) l)) +) ;define (define (tmtex-graphics l) - (tmtex-eps (cons 'graphics l))) + (tmtex-eps (cons 'graphics l)) +) ;define (define (tmtex-as-eps name) + (tmtex-image-increment) (let* ((u (url-relative current-save-target (unix->url name))) (suffix (url-suffix u)) - (fm (string-append (format-from-suffix suffix) "-file"))) + (fm (string-append (format-from-suffix suffix) "-file")) + ) ; (if (and (url-exists? u) (in? suffix (list "eps" "pdf" "png" "jpg"))) - (with p (url->string "$TEXMACS_PATH") - (set! name (string-replace name "$TEXMACS_PATH" p)) - (set! name (string-replace name "file://" "")) - (list 'includegraphics name)) - (receive (name-url name-string) (tmtex-eps-names) - (when (string-starts? name "..") - (set! u (url-relative current-save-source (unix->url name)))) - (with nfm (if (== (url-suffix name-url) "pdf") "pdf-file" - "postscript-file") - (convert-to-file u fm nfm name-url)) - (list 'includegraphics name-string))))) + (with p + (url->string "$TEXMACS_PATH") + (set! name (string-replace name "$TEXMACS_PATH" p)) + (set! name (string-replace name "file://" "")) + (list 'includegraphics name) + ) ;with + (receive (name-url name-string) + (tmtex-eps-names) + (when (string-starts? name "..") + (set! u (url-relative current-save-source (unix->url name))) + ) ;when + (with nfm + (if (== (url-suffix name-url) "pdf") "pdf-file" "postscript-file") + (convert-to-file u fm nfm name-url) + ) ;with + (list 'includegraphics name-string) + ) ;receive + ) ;if + ) ;let* +) ;define (define (tmtex-image-length len) - (let* ((s (force-string len)) - (unit (and (tm-length? s) (tm-length-unit len)))) + (let* ((s (force-string len)) (unit (and (tm-length? s) (tm-length-unit len)))) (cond ((== s "") "!") ((string-ends? s "%") "!") ((in? unit '("w" "h")) "!") - (else (tmtex-decode-length len))))) + (else (tmtex-decode-length len)) + ) ;cond + ) ;let* +) ;define (define (tmtex-image-mag len) (let* ((s (force-string len)) (val (and (tm-length? s) (tm-length-value len))) - (unit (and (tm-length? s) (tm-length-unit len)))) + (unit (and (tm-length? s) (tm-length-unit len))) + ) ; (cond ((== s "") 0.0) ((string-ends? s "%") - (with x (string->number (string-drop-right s 1)) - (if x (/ x 100.0) 0))) + (with x (string->number (string-drop-right s 1)) (if x (/ x 100.0) 0)) + ) ; ((in? unit '("w" "h")) (or val 0)) - (else #f)))) + (else #f) + ) ;cond + ) ;let* +) ;define (define (tmtex-image l) (if (nstring? (car l)) - (tmtex-eps (cons 'image l)) - (let* ((fig (tmtex-as-eps (force-string (car l)))) - (hor (tmtex-image-length (cadr l))) - (ver (tmtex-image-length (caddr l))) - (mhor (tmtex-image-mag (cadr l))) - (mver (tmtex-image-mag (caddr l)))) - (cond ((or (not mhor) (not mver)) (list 'resizebox hor ver fig)) - ((and (== mhor 0.0) (== mver 0.0)) fig) - ((or (== mhor 1.0) (== mver 1.0)) fig) - ((== mhor 0.0) (list 'scalebox (number->string mver) fig)) - (else (list 'scalebox (number->string mhor) fig)))))) + (tmtex-eps (cons 'image l)) + (let* ((fig (tmtex-as-eps (force-string (car l)))) + (hor (tmtex-image-length (cadr l))) + (ver (tmtex-image-length (caddr l))) + (mhor (tmtex-image-mag (cadr l))) + (mver (tmtex-image-mag (caddr l))) + ) ; + (cond ((or (not mhor) (not mver)) (list 'resizebox hor ver fig)) + ((and (== mhor 0.0) (== mver 0.0)) fig) + ((or (== mhor 1.0) (== mver 1.0)) fig) + ((== mhor 0.0) (list 'scalebox (number->string mver) fig)) + (else (list 'scalebox (number->string mhor) fig)) + ) ;cond + ) ;let* + ) ;if +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Metadata for documents ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-make-inline t) - (tm-replace t '(new-line) '(next-line))) + (tm-replace t '(new-line) '(next-line)) +) ;define -(tm-define (tmtex-inline t) - (tmtex (tmtex-make-inline t))) +(tm-define (tmtex-inline t) (tmtex (tmtex-make-inline t))) -(tm-define (tmtex-doc-title t) - `(title ,(tmtex-inline (cadr t)))) +(tm-define (tmtex-doc-title t) `(title ,(tmtex-inline (cadr t)))) (tm-define (tmtex-doc-running-title t) - `(tmrunningtitle ,(tmtex-inline (cadr t)))) + `(tmrunningtitle ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-doc-subtitle t) (set! t (tmtex-remove-line-feeds t)) - `(tmsubtitle ,(tmtex-inline (cadr t)))) + `(tmsubtitle ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-doc-note t) (set! t (tmtex-remove-line-feeds t)) - `(tmnote ,(tmtex (cadr t)))) + `(tmnote ,(tmtex (cadr t))) +) ;tm-define (tm-define (tmtex-doc-misc t) (set! t (tmtex-remove-line-feeds t)) - `(tmmisc ,(tmtex (cadr t)))) + `(tmmisc ,(tmtex (cadr t))) +) ;tm-define -(tm-define (tmtex-doc-date t) - `(date ,(tmtex-inline (cadr t)))) +(tm-define (tmtex-doc-date t) `(date ,(tmtex-inline (cadr t)))) (tm-define (tmtex-doc-running-author t) - `(tmrunningauthor ,(tmtex-inline (cadr t)))) + `(tmrunningauthor ,(tmtex-inline (cadr t))) +) ;tm-define -(tm-define (tmtex-author-name t) - `(author ,(tmtex-inline (cadr t)))) +(tm-define (tmtex-author-name t) `(author ,(tmtex-inline (cadr t)))) (tm-define (tmtex-author-affiliation t) - ;;(set! t (tmtex-remove-line-feeds t)) - `(tmaffiliation ,(tmtex (cadr t)))) + ;; (set! t (tmtex-remove-line-feeds t)) + `(tmaffiliation ,(tmtex (cadr t))) +) ;tm-define (tm-define (tmtex-author-email t) (set! t (tmtex-remove-line-feeds t)) - `(tmemail ,(tmtex-inline (cadr t)))) + `(tmemail ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-author-homepage t) (set! t (tmtex-remove-line-feeds t)) - `(tmhomepage ,(tmtex-inline (cadr t)))) + `(tmhomepage ,(tmtex-inline (cadr t))) +) ;tm-define (tm-define (tmtex-author-note t) (set! t (tmtex-remove-line-feeds t)) - `(tmnote ,(tmtex (cadr t)))) + `(tmnote ,(tmtex (cadr t))) +) ;tm-define (tm-define (tmtex-author-misc t) (set! t (tmtex-remove-line-feeds t)) - `(tmmisc ,(tmtex (cadr t)))) + `(tmmisc ,(tmtex (cadr t))) +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Useful macros for metadata presentation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(tm-define (tmtex-select-args-by-func n l) - (filter (lambda (x) (func? x n)) l)) +(tm-define (tmtex-select-args-by-func n l) (filter (lambda (x) (func? x n)) l)) (define (tmtex-get-transform l tag) - (let ((transform (symbol-append 'tmtex- tag)) - (l* (tmtex-select-args-by-func tag l))) - (map tmtex l*))) + (let ((transform (symbol-append 'tmtex- tag)) (l* (tmtex-select-args-by-func tag l))) + (map tmtex l*) + ) ;let +) ;define (tm-define (tmtex-remove-line-feeds t) - (if (npair? t) t - (with (r s) (list (car t) (map tmtex-remove-line-feeds (cdr t))) - (if (== r 'next-line) '(!concat (tmSep) (!linefeed)) `(,r ,@s))))) + (if (npair? t) + t + (with (r s) + (list (car t) (map tmtex-remove-line-feeds (cdr t))) + (if (== r 'next-line) '(!concat (tmSep) (!linefeed)) `(,r ,@s)) + ) ;with + ) ;if +) ;tm-define (tm-define (tmtex-replace-documents t) - (if (npair? t) t - (with (r s) (list (car t) (map tmtex-replace-documents (cdr t))) - (if (!= r 'document) `(,r ,@s) - `(concat ,@(list-intersperse s '(next-line))))))) + (if (npair? t) + t + (with (r s) + (list (car t) (map tmtex-replace-documents (cdr t))) + (if (!= r 'document) `(,r ,@s) `(concat ,@(list-intersperse s + '(next-line)))) + ) ;with + ) ;if +) ;tm-define (tm-define (contains-tags? t l) (cond ((or (nlist? t) (null? t)) #f) ((in? (car t) l) #t) - (else - (with found? #f - (for-each (lambda (x) - (set! found? (or found? (contains-tags? x l)))) - t) - found?)))) + (else (with found? + #f + (for-each (lambda (x) (set! found? (or found? (contains-tags? x l)))) t) + found? + ) ;with + ) ;else + ) ;cond +) ;tm-define (tm-define (contains-stree? t u) (cond ((== t u) #t) ((or (null? t) (nlist? t)) #f) - (else - (with found? #f - (for-each (lambda (x) - (set! found? (or found? (contains-stree? x u)))) - t) - found?)))) + (else (with found? + #f + (for-each (lambda (x) (set! found? (or found? (contains-stree? x u)))) t) + found? + ) ;with + ) ;else + ) ;cond +) ;tm-define ;; Metadata clustering (define (stree-replace l what by) (cond ((or (null? l) (nlist? l)) l) ((== l what) by) - (else - (map (lambda (x) (stree-replace x what by)) l)))) + (else (map (lambda (x) (stree-replace x what by)) l)) + ) ;cond +) ;define (define (next-stree-occurence l tag) (cond ((or (null? l) (nlist? l)) #f) ((== (car l) tag) l) - (else - (with found? #f - (map-in-order - (lambda (x) - (if (not found?) - (set! found? (next-stree-occurence x tag)))) l) - found?)))) + (else (with found? + #f + (map-in-order (lambda (x) (if (not found?) (set! found? (next-stree-occurence x tag)))) + l + ) ;map-in-order + found? + ) ;with + ) ;else + ) ;cond +) ;define (define (add-refs l n tag tr tl global-counter?) - (with streetag (next-stree-occurence (car l) tag) + (with streetag + (next-stree-occurence (car l) tag) (if (not streetag) (begin (if global-counter? (set! tmtex-ref-cnt n)) - l) - (let* ((n* (number->string n)) - (tagref (list tr n*)) + l + ) ;begin + (let* ((n* (number->string n)) + (tagref (list tr n*)) (authors (stree-replace (car l) streetag tagref)) (taglist (if (null? (cdr l)) '() (cadr l))) (taglist `(,@taglist (,tl ,n* ,(cadr streetag)))) - (l* (list authors taglist))) - (add-refs l* (1+ n) tag tr tl global-counter?))))) + (l* (list authors taglist)) + ) ; + (add-refs l* (1+ n) tag tr tl global-counter?) + ) ;let* + ) ;if + ) ;with +) ;define (tm-define (make-references l tag author? global-counter?) - (let* ((tag-ref (symbol-append tag '- 'ref)) - (tag-label (symbol-append tag '- 'label)) - (cnt (if global-counter? tmtex-ref-cnt 1)) - (tmp (add-refs `(,l) cnt tag tag-ref tag-label - global-counter?)) - (data-refs (car tmp)) - (data-labels (if (null? (cdr tmp)) '() (cadr tmp)))) - (if author? - (set! data-labels `((doc-author (author-data ,@data-labels))))) - `(,@data-refs ,@data-labels))) + (let* ((tag-ref (symbol-append tag '- 'ref)) + (tag-label (symbol-append tag '- 'label)) + (cnt (if global-counter? tmtex-ref-cnt 1)) + (tmp (add-refs `(,l) cnt tag tag-ref tag-label global-counter?)) + (data-refs (car tmp)) + (data-labels (if (null? (cdr tmp)) '() (cadr tmp))) + ) ; + (if author? (set! data-labels `((doc-author (author-data ,@data-labels))))) + `(,@data-refs ,@data-labels) + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Author metadata presentation @@ -2040,39 +2702,61 @@ (tm-define (tmtex-prepare-author-data l) l) -(tm-define (tmtex-make-author names affiliations emails urls miscs notes - affs* emails* urls* miscs* notes*) - (let* ((names (tmtex-concat-Sep (map cadr names))) - (result `(,@names ,@notes ,@miscs ,@affiliations ,@emails ,@urls))) - (if (null? result) '() - `(author (!paragraph ,@result))))) +(tm-define (tmtex-make-author names + affiliations + emails + urls + miscs + notes + affs* + emails* + urls* + miscs* + notes* + ) ;tmtex-make-author + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@notes ,@miscs ,@affiliations ,@emails ,@urls)) + ) ; + (if (null? result) '() `(author (!paragraph ,@result))) + ) ;let* +) ;tm-define (tm-define (tmtex-doc-author t) - (if (or (npair? t) (npair? (cdr t)) (not (func? (cadr t) 'author-data))) '() - (let* ((l (tmtex-prepare-author-data (cdadr t))) - (names (tmtex-get-transform l 'author-name)) - (emails (tmtex-get-transform l 'author-email)) - (urls (tmtex-get-transform l 'author-homepage)) - (affs (tmtex-get-transform l 'author-affiliation)) - (miscs (tmtex-get-transform l 'author-misc)) - (notes (tmtex-get-transform l 'author-note)) - (emails* (tmtex-get-transform l 'author-email-ref)) - (urls* (tmtex-get-transform l 'author-homepage-ref)) - (affs* (tmtex-get-transform l 'author-affiliation-ref)) - (miscs* (tmtex-get-transform l 'author-misc-ref)) - (notes* (tmtex-get-transform l 'author-note-ref)) - (affs (append affs (tmtex-get-transform - l 'author-affiliation-label))) - (urls (append urls (tmtex-get-transform - l 'author-homepage-label))) - (miscs (append miscs (tmtex-get-transform - l 'author-misc-label))) - (notes (append notes (tmtex-get-transform - l 'author-note-label))) - (emails (append emails (tmtex-get-transform - l 'author-email-label)))) - (tmtex-make-author names affs emails urls miscs notes - affs* emails* urls* miscs* notes*)))) + (if (or (npair? t) (npair? (cdr t)) (not (func? (cadr t) 'author-data))) + '() + (let* ((l (tmtex-prepare-author-data (cdadr t))) + (names (tmtex-get-transform l 'author-name)) + (emails (tmtex-get-transform l 'author-email)) + (urls (tmtex-get-transform l 'author-homepage)) + (affs (tmtex-get-transform l 'author-affiliation)) + (miscs (tmtex-get-transform l 'author-misc)) + (notes (tmtex-get-transform l 'author-note)) + (emails* (tmtex-get-transform l 'author-email-ref)) + (urls* (tmtex-get-transform l 'author-homepage-ref)) + (affs* (tmtex-get-transform l 'author-affiliation-ref)) + (miscs* (tmtex-get-transform l 'author-misc-ref)) + (notes* (tmtex-get-transform l 'author-note-ref)) + (affs (append affs (tmtex-get-transform l 'author-affiliation-label))) + (urls (append urls (tmtex-get-transform l 'author-homepage-label))) + (miscs (append miscs (tmtex-get-transform l 'author-misc-label))) + (notes (append notes (tmtex-get-transform l 'author-note-label))) + (emails (append emails (tmtex-get-transform l 'author-email-label))) + ) ; + (tmtex-make-author names + affs + emails + urls + miscs + notes + affs* + emails* + urls* + miscs* + notes* + ) ;tmtex-make-author + ) ;let* + ) ;if +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Document metadata presentation @@ -2080,100 +2764,147 @@ (tm-define (tmtex-prepare-doc-data l) (set! l (map tmtex-replace-documents l)) - l) + l +) ;tm-define (define (tmtex-make-title titles subtitles notes miscs tr) (let* ((titles (tmtex-concat-Sep (map cadr titles))) - (content `(,@titles ,@subtitles ,@notes ,@miscs))) - (if (null? content) '() - `((title (!indent (!paragraph ,@content))))))) + (content `(,@titles ,@subtitles ,@notes ,@miscs)) + ) ; + (if (null? content) '() `((title (!indent (!paragraph ,@content))))) + ) ;let* +) ;define (tm-define (tmtex-append-authors l) (set! l (filter nnull? l)) (cond ((null? l) '()) ((== (length l) 1) `((author (!indent (!concat ,@(cdar l)))))) - (else - (with lf '(!concat (!linefeed) (and) (!linefeed)) - `((author - (!indent (!concat ,@(list-intersperse (map cadr l) lf))))))))) - -(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes - subtits-l dates-l miscs-l notes-l tr ar) - `(!document - ,@(tmtex-make-title titles subtitles notes miscs tr) + (else (with lf + '(!concat (!linefeed) (and) (!linefeed)) + `((author (!indent (!concat ,@(list-intersperse (map cadr l) lf))))) + ) ;with + ) ;else + ) ;cond +) ;tm-define + +(tm-define (tmtex-make-doc-data titles + subtitles + authors + dates + miscs + notes + subtits-l + dates-l + miscs-l + notes-l + tr + ar + ) ;tmtex-make-doc-data + `(!document ,@(tmtex-make-title titles subtitles notes miscs tr) ,@(tmtex-append-authors authors) ,@dates - (maketitle))) + (maketitle)) +) ;tm-define (tm-define (tmtex-get-title-option l) - (apply append (map cdr (tmtex-select-args-by-func 'doc-title-options l)))) + (apply append (map cdr (tmtex-select-args-by-func 'doc-title-options l))) +) ;tm-define (tm-define (tmtex-doc-data s l) (set! l (tmtex-prepare-doc-data l)) - (let* ((titles (tmtex-get-transform l 'doc-title)) - (tr (tmtex-get-transform l 'doc-running-title)) - (subtits (tmtex-get-transform l 'doc-subtitle)) - (authors (tmtex-get-transform l 'doc-author)) - (ar (tmtex-get-transform l 'doc-running-author)) - (dates (tmtex-get-transform l 'doc-date)) - (miscs (tmtex-get-transform l 'doc-misc)) - (notes (tmtex-get-transform l 'doc-note)) + (let* ((titles (tmtex-get-transform l 'doc-title)) + (tr (tmtex-get-transform l 'doc-running-title)) + (subtits (tmtex-get-transform l 'doc-subtitle)) + (authors (tmtex-get-transform l 'doc-author)) + (ar (tmtex-get-transform l 'doc-running-author)) + (dates (tmtex-get-transform l 'doc-date)) + (miscs (tmtex-get-transform l 'doc-misc)) + (notes (tmtex-get-transform l 'doc-note)) (subtits-l (tmtex-get-transform l 'doc-subtitle-label)) - (dates-l (tmtex-get-transform l 'doc-date-label)) - (miscs-l (tmtex-get-transform l 'doc-misc-label)) - (notes-l (tmtex-get-transform l 'doc-note-label)) - (subtits (append subtits (tmtex-get-transform l 'doc-subtitle-ref))) - (dates (append dates (tmtex-get-transform l 'doc-date-ref))) - (miscs (append miscs (tmtex-get-transform l 'doc-misc-ref))) - (notes (append notes (tmtex-get-transform l 'doc-note-ref)))) - (tmtex-make-doc-data titles subtits authors dates miscs notes - subtits-l dates-l miscs-l notes-l tr ar))) + (dates-l (tmtex-get-transform l 'doc-date-label)) + (miscs-l (tmtex-get-transform l 'doc-misc-label)) + (notes-l (tmtex-get-transform l 'doc-note-label)) + (subtits (append subtits (tmtex-get-transform l 'doc-subtitle-ref))) + (dates (append dates (tmtex-get-transform l 'doc-date-ref))) + (miscs (append miscs (tmtex-get-transform l 'doc-misc-ref))) + (notes (append notes (tmtex-get-transform l 'doc-note-ref))) + ) ; + (tmtex-make-doc-data titles + subtits + authors + dates + miscs + notes + subtits-l + dates-l + miscs-l + notes-l + tr + ar + ) ;tmtex-make-doc-data + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Abstract metadata presentation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(tm-define (tmtex-abstract t) - (tmtex-std-env "abstract" (cdr t))) +(tm-define (tmtex-abstract t) (tmtex-std-env "abstract" (cdr t))) (tm-define (tmtex-abstract-keywords t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmkeywords) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmkeywords) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-acm t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmacm) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmacm) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-arxiv t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmarxiv) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmarxiv) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-msc t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmmsc) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmmsc) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-pacs t) - (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) - `(!concat (tmpacs) ,@(map (lambda (x) `(!group ,x)) args)))) + (with args + (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmpacs) ,@(map (lambda (x) `(!group ,x)) args)) + ) ;with +) ;tm-define (tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) - (with result `(,@abstract ,@acm ,@arxiv ,@msc ,@pacs ,@keywords) - (if (null? result) "" `(!document ,@result)))) + (with result + `(,@abstract ,@acm ,@arxiv ,@msc ,@pacs ,@keywords) + (if (null? result) "" `(!document ,@result)) + ) ;with +) ;tm-define (tm-define (tmtex-abstract-data s l) - (let* ((acm (map tmtex-abstract-acm - (tmtex-select-args-by-func 'abstract-acm l))) - (arxiv (map tmtex-abstract-arxiv - (tmtex-select-args-by-func 'abstract-arxiv l))) - (msc (map tmtex-abstract-msc - (tmtex-select-args-by-func 'abstract-msc l))) - (pacs (map tmtex-abstract-pacs - (tmtex-select-args-by-func 'abstract-pacs l))) - (keywords (map tmtex-abstract-keywords - (tmtex-select-args-by-func 'abstract-keywords l))) - (abstract (map tmtex-abstract - (tmtex-select-args-by-func 'abstract l)))) - (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract))) + (let* ((acm (map tmtex-abstract-acm (tmtex-select-args-by-func 'abstract-acm l))) + (arxiv (map tmtex-abstract-arxiv (tmtex-select-args-by-func 'abstract-arxiv l))) + (msc (map tmtex-abstract-msc (tmtex-select-args-by-func 'abstract-msc l))) + (pacs (map tmtex-abstract-pacs (tmtex-select-args-by-func 'abstract-pacs l))) + (keywords (map tmtex-abstract-keywords (tmtex-select-args-by-func 'abstract-keywords l)) + ) ;keywords + (abstract (map tmtex-abstract (tmtex-select-args-by-func 'abstract l))) + ) ; + (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TeXmacs style primitives @@ -2182,622 +2913,821 @@ (define (tmtex-std-env s l) (if (== s "quote-env") (set! s "quote")) (if (null? l) - (list (list '!begin s) '()) - (list (list '!begin s) (tmtex (car l))))) + (list (list '!begin s) '()) + (list (list '!begin s) (tmtex (car l))) + ) ;if +) ;define (define (tmtex-footnote s l) - `(footnote ,(tmtex (car l)))) + `(footnote ,(tmtex (car l))) +) ;define (define (tmtex-footnotemark s l) - `(footnotemark (!option ,(tmtex (car l))))) + `(footnotemark (!option ,(tmtex (car l)))) +) ;define (define (filter-enunciation-due-to l) (cond ((func? l 'dueto) (list l)) ((nlist>0? l) '()) - (else (append-map filter-enunciation-due-to l)))) + (else (append-map filter-enunciation-due-to l)) + ) ;cond +) ;define (define (filter-enunciation-body l) (cond ((func? l 'dueto) '()) ((nlist>0? l) l) - (else (filter nnull? (map filter-enunciation-body l))))) + (else (filter nnull? (map filter-enunciation-body l))) + ) ;cond +) ;define (define (tmtex-enunciation s l) - (let* ((t (car l)) - (option (filter-enunciation-due-to t)) + (let* ((t (car l)) + (option (filter-enunciation-due-to t)) (option* (map (lambda (x) `(!option ,(tmtex (cadr x)))) option)) - (body (filter-enunciation-body t))) - `((!begin ,s ,@option*) ,(tmtex body)))) + (body (filter-enunciation-body t)) + ) ; + `((!begin ,s ,@option*) ,(tmtex body)) + ) ;let* +) ;define (define (find-label x) (cond ((npair? x) #f) ((func? x 'label) x) - (else (or (find-label (car x)) (find-label (cdr x)))))) + (else (or (find-label (car x)) (find-label (cdr x)))) + ) ;cond +) ;define (define (remove-labels x) (cond ((npair? x) x) ((func? x 'label) "") - (else (cons (remove-labels (car x)) (remove-labels (cdr x)))))) + (else (cons (remove-labels (car x)) (remove-labels (cdr x)))) + ) ;cond +) ;define (define (tmtex-sectional s l) + (tmtex-image-increment) (let* ((lab (find-label (car l))) (tit (if lab (remove-labels (car l)) (car l))) - (sec (list (string->symbol s) (tmtex tit)))) - (if lab (list '!concat sec lab) sec))) + (sec (list (string->symbol s) (tmtex tit))) + ) ; + (if lab (list '!concat sec lab) sec) + ) ;let* +) ;define (define (tmtex-appendix s l) - (with app (list (if (latex-book-style?) 'chapter 'section) (tmtex (car l))) - (if tmtex-appendices? app + (with app + (list (if (latex-book-style?) 'chapter 'section) (tmtex (car l))) + (if tmtex-appendices? + app (begin (set! tmtex-appendices? #t) - (list '!concat '(appendix) app))))) + (list '!concat '(appendix) app) + ) ;begin + ) ;if + ) ;with +) ;define (define (tmtex-appendix* s l) - (with app (list (if (latex-book-style?) 'chapter* 'section*) (tmtex (car l))) - (if tmtex-appendices? app + (with app + (list (if (latex-book-style?) 'chapter* 'section*) (tmtex (car l))) + (if tmtex-appendices? + app (begin (set! tmtex-appendices? #t) - (list '!concat '(appendix) app))))) + (list '!concat '(appendix) app) + ) ;begin + ) ;if + ) ;with +) ;define (define (tmtex-tt-document l) (cond ((null? l) "") ((null? (cdr l)) (tmtex-tt (car l))) - (else (string-append (tmtex-tt (car l)) "\n" - (tmtex-tt-document (cdr l)))))) + (else (string-append (tmtex-tt (car l)) "\n" (tmtex-tt-document (cdr l)))) + ) ;cond +) ;define (define (tmtex-tt x) (cond ((string? x) (tmtex-verb-string x)) ((== x '(next-line)) "\n") ((func? x 'document) (tmtex-tt-document (cdr x))) ((func? x 'para) (tmtex-tt-document (cdr x))) - ((func? x 'concat) - (apply string-append (map-in-order tmtex-tt (cdr x)))) + ((func? x 'concat) (apply string-append (map-in-order tmtex-tt (cdr x)))) ((func? x 'mtm 2) (tmtex-tt (cAr x))) ((func? x 'surround 3) - (string-append (tmtex-tt (cadr x)) - (tmtex-tt (cadddr x)) - (tmtex-tt (caddr x)))) - ((or (func? x 'hgroup 1) (func? x 'vgroup 1)) - (tmtex-tt (cadr x))) + (string-append (tmtex-tt (cadr x)) (tmtex-tt (cadddr x)) (tmtex-tt (caddr x))) + ) ; + ((or (func? x 'hgroup 1) (func? x 'vgroup 1)) (tmtex-tt (cadr x))) ((func? x 'with) (begin (display* "TeXmacs] lost in verbatim content: " (cDr x) "\n") - (tmtex-tt (cAr x)))) + (tmtex-tt (cAr x)) + ) ;begin + ) ; ((func? x 'math) (begin (display* "TeXmacs] lost in verbatim content: " (cDr x) "\n") - (tmtex-tt (cAr x)))) - (else - (begin - (display* "TeXmacs] non converted verbatim content: " x "\n") - "")))) + (tmtex-tt (cAr x)) + ) ;begin + ) ; + (else (begin (display* "TeXmacs] non converted verbatim content: " x "\n") "")) + ) ;cond +) ;define (define (unescape-angles l) - (cond ((string? l) - (string-replace (string-replace l "" "<") "" ">")) + (cond ((string? l) (string-replace (string-replace l "" "<") "" ">")) ((symbol? l) l) - (else (map unescape-angles l)))) + (else (map unescape-angles l)) + ) ;cond +) ;define (define (escape-braces l) (cond ((string? l) (string-replace (string-replace l "{" "\\{") "}" "\\}")) ((symbol? l) l) - (else (map escape-braces l)))) + (else (map escape-braces l)) + ) ;cond +) ;define (define (escape-backslashes l) (cond ((string? l) (string-replace l "\\" "\\textbackslash ")) ((symbol? l) l) - (else (map escape-backslashes l)))) + (else (map escape-backslashes l)) + ) ;cond +) ;define (define (tmtex-new-theorem s l) - (with var (tmtex-var-name (car l)) + (with var + (tmtex-var-name (car l)) (ahash-set! tmtex-dynamic (string->symbol (car l)) 'environment) (ahash-set! tmtex-dynamic (string->symbol var) 'environment) - (if (and (logic-in? var latex-texmacs-theorem-environment%)) "" - `(newtheorem ,var (,@(cdr l)))))) + (if (and (logic-in? var latex-texmacs-theorem-environment%)) + "" + `(newtheorem ,var (,@(cdr l))) + ) ;if + ) ;with +) ;define (define (tmtex-verbatim s l) (if (func? (car l) 'document) - (list '!verbatim (tmtex-tt (escape-braces (escape-backslashes (car l))))) - (list 'tmverbatim (tmtex (car l))))) + (list '!verbatim (tmtex-tt (escape-braces (escape-backslashes (car l))))) + (list 'tmverbatim (tmtex (car l))) + ) ;if +) ;define (define (sharp-fix t) (cond ((and (func? t '!document) (nnull? (cdr t))) - `(!document ,(sharp-fix (cadr t)) ,@(cddr t))) + `(!document ,(sharp-fix (cadr t)) ,@(cddr t)) + ) ; ((and (func? t '!concat) (nnull? (cdr t))) - `(!concat ,(sharp-fix (cadr t)) ,@(cddr t))) - ((and (string? t) (string-starts? t "#")) - (string-append "\\" t)) - (else t))) + `(!concat ,(sharp-fix (cadr t)) ,@(cddr t)) + ) ; + ((and (string? t) (string-starts? t "#")) (string-append "\\" t)) + (else t) + ) ;cond +) ;define (define (tmtex-verbatim* s l) (if (func? (car l) 'document) - (list '!verbatim* (sharp-fix (tmtex-tt (car l)))) - (list 'tmverbatim (tmtex (car l))))) + (list '!verbatim* (sharp-fix (tmtex-tt (car l)))) + (list 'tmverbatim (tmtex (car l))) + ) ;if +) ;define (define (tmtex-code-inline s l) - (with lang `((!option ,s)) - `(tmcodeinline ,@lang ,(tmtex (car l))))) + (with lang `((!option ,s)) `(tmcodeinline ,@lang ,(tmtex (car l)))) +) ;define (define (tmtex-code-block s l) (set! l (escape-backslashes l)) (set! l (escape-braces l)) (set! s (car (string-decompose s "-"))) - (with lang (if (or (== s "verbatim") (== s "code")) '() `((!option ,s))) - `((!begin* "tmcode" ,@lang) ,(tmtex-verbatim* "" l)))) + (with lang + (if (or (== s "verbatim") (== s "code")) '() `((!option ,s))) + `((!begin* ,"tmcode" ,@lang) ,(tmtex-verbatim* "" l)) + ) ;with +) ;define (define (tmtex-add-preview-packages x) (cond ((list? x) (for-each tmtex-add-preview-packages x)) ((nstring? x) (noop)) - ((string-occurs? "tikzpicture" x) (latex-add-extra "tikz")))) + ((string-occurs? "tikzpicture" x) (latex-add-extra "tikz")) + ) ;cond +) ;define (define (tmtex-mixed s l) - (if (func? (cadr l) 'text) (set! l `("" ,(cadadr l)))) + (if (func? (cadr l) 'text) (set! l `(,"" ,(cadadr l)))) ;; (set! l (unescape-angles l)) ;; NOTE: instead, we now unescape in tmtex-verb-string (tmtex-env-set "mode" "text") - (with src (list '!verbatim* (tmtex-tt (cadr l))) + (with src + (list '!verbatim* (tmtex-tt (cadr l))) (tmtex-add-preview-packages src) (tmtex-env-reset "mode") - (list '!unindent src))) + (list '!unindent src) + ) ;with +) ;define (define (tmtex-listing s l) - (list (list '!begin "tmlisting") (tmtex (car l)))) - ;;(list (list '!begin "linenumbers") (tmtex (car l)))) + (list (list '!begin "tmlisting") (tmtex (car l))) +) ;define +;; (list (list '!begin "linenumbers") (tmtex (car l)))) (define (tmtex-minipage s l) - (let* - ((pos (car l)) - (opt (if (== pos "f") '() `((!option ,pos)))) - (size (cadr l)) - (body (caddr l))) - `((!begin "minipage" ,@opt ,(tmtex-decode-length size)) ,(tmtex body)))) + (let* ((pos (car l)) + (opt (if (== pos "f") '() `((!option ,pos)))) + (size (cadr l)) + (body (caddr l)) + ) ; + `((!begin ,"minipage" ,@opt ,(tmtex-decode-length size)) ,(tmtex body)) + ) ;let* +) ;define (define (tmtex-number-renderer l) - (let ((r (cond ((string? l) l) - ((list? l) (tmtex-number-renderer (car l))) - (else "")))) - (cond - ((== r "alpha") "alph") - ((== r "Alpha") "Alph") - (else r)))) + (let ((r (cond ((string? l) l) ((list? l) (tmtex-number-renderer (car l))) (else ""))) + ) ; + (cond ((== r "alpha") "alph") + ((== r "Alpha") "Alph") + (else r) + ) ;cond + ) ;let +) ;define (define (tmtex-number-counter l) (cond ((func? l 'value) (tmtex-number-counter (cdr l))) ((and (list? l) (== 1 (length l))) (tmtex-number-counter (car l))) ((symbol? l) (tmtex-number-counter (symbol->string l))) ((string? l) (if (string-ends? l "-nr") (string-drop-right l 3) l)) - (else ""))) + (else "") + ) ;cond +) ;define (define (tmtex-number l) - (tmtex-default - (tmtex-number-renderer (cdr l)) - (list (tmtex-number-counter (car l))))) + (tmtex-default (tmtex-number-renderer (cdr l)) + (list (tmtex-number-counter (car l))) + ) ;tmtex-default +) ;define (define (tmtex-change-case l) - (cond - ((== (cadr l) "UPCASE") (tex-apply 'MakeUppercase (tmtex (car l)))) - ((== (cadr l) "locase") (tex-apply 'MakeLowercase (tmtex (car l)))) - (else (tmtex (car l))))) + (cond ((== (cadr l) "UPCASE") (tex-apply 'MakeUppercase (tmtex (car l)))) + ((== (cadr l) "locase") (tex-apply 'MakeLowercase (tmtex (car l)))) + (else (tmtex (car l))) + ) ;cond +) ;define (define (tmtex-frame s l) - `(fbox ,(car l))) + `(fbox ,(car l)) +) ;define (define (tmtex-colored-frame s l) - `(colorbox ,(tmtex-decode-color (car l)) ,(tmtex (cadr l)))) + `(colorbox ,(tmtex-decode-color (car l)) ,(tmtex (cadr l))) +) ;define (define (tmtex-fcolorbox s l) - `(fcolorbox ,@(map tmtex-decode-color (cDr l)) ,(tmtex (cAr l)))) + `(fcolorbox ,@(map tmtex-decode-color (cDr l)) ,(tmtex (cAr l))) +) ;define (define (tmtex-rotate s l) (let* ((body (tmtex (cadr l))) - (body* (if (tmtex-math-mode?) `(ensuremath ,body) body))) - `(rotatebox (!option "origin=c") ,(tmtex (car l)) ,body*))) + (body* (if (tmtex-math-mode?) `(ensuremath ,body) body)) + ) ; + `(rotatebox (!option "origin=c") ,(tmtex (car l)) ,body*) + ) ;let* +) ;define (define (tmtex-translate s l) - (let ((from (cadr l)) - (to (caddr l)) - (body (car l))) - (tmtex (translate-from-to body from to)))) + (let ((from (cadr l)) (to (caddr l)) (body (car l))) + (tmtex (translate-from-to body from to)) + ) ;let +) ;define (define (tmtex-localize s l) - (with lan (if (list>0? tmtex-languages) (cAr tmtex-languages) "english") - (tmtex `(translate ,(car l) "english" ,lan)))) + (with lan + (if (list>0? tmtex-languages) (cAr tmtex-languages) "english") + (tmtex `(translate ,(car l) ,"english" ,lan)) + ) ;with +) ;define (define (tmtex-render-key s l) - (with body (tmtex (car l)) - (if (func? body '!concat) - (set! body `(!append ,@(cdr body)))) - `(key ,body))) + (with body + (tmtex (car l)) + (if (func? body '!concat) (set! body `(!append ,@(cdr body)))) + `(key ,body) + ) ;with +) ;define (define (tmtex-key s l) - (tmtex (tm->stree (tmdoc-key (car l))))) + (tmtex (tm->stree (tmdoc-key (car l)))) +) ;define (define (tmtex-key* s l) - (tmtex (tm->stree (tmdoc-key* (car l))))) + (tmtex (tm->stree (tmdoc-key* (car l)))) +) ;define (define (tmtex-padded-center s l) - (list (list '!begin "center") (tmtex (car l)))) + (list (list '!begin "center") (tmtex (car l))) +) ;define (define (tmtex-padded-left-aligned s l) - (list (list '!begin "flushleft") (tmtex (car l)))) + (list (list '!begin "flushleft") (tmtex (car l))) +) ;define (define (tmtex-padded-right-aligned s l) - (list (list '!begin "flushright") (tmtex (car l)))) + (list (list '!begin "flushright") (tmtex (car l))) +) ;define (define (tmtex-compact s l) - (list (list '!begin "tmcompact") (tmtex (car l)))) + (list (list '!begin "tmcompact") (tmtex (car l))) +) ;define (define (tmtex-compressed s l) - (list (list '!begin "tmcompressed") (tmtex (car l)))) + (list (list '!begin "tmcompressed") (tmtex (car l))) +) ;define (define (tmtex-amplified s l) - (list (list '!begin "tmamplified") (tmtex (car l)))) + (list (list '!begin "tmamplified") (tmtex (car l))) +) ;define (define (tmtex-indent s l) - (list (list '!begin "tmindent") (tmtex (car l)))) + (list (list '!begin "tmindent") (tmtex (car l))) +) ;define (define (tmtex-jump-in s l) - (list (list '!begin "tmjumpin") (tmtex (car l)))) + (list (list '!begin "tmjumpin") (tmtex (car l))) +) ;define (define (tmtex-script-inout s l) - (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) - (lang (car l)) + (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) + (lang (car l)) (lang* (session-name (car l))) - (in (tmtex (caddr l))) - (out (tmtex (cadddr l)))) - `(,name ,lang ,lang* ,in ,out))) + (in (tmtex (caddr l))) + (out (tmtex (cadddr l))) + ) ; + `(,name ,lang ,lang* ,in ,out) + ) ;let +) ;define (define (tmtex-converter s l) - (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) - (lang (car l)) + (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) + (lang (car l)) (lang* (format-get-name (car l))) - (in (tmtex (cadr l))) - (out (tmtex (caddr l)))) - `(,name ,lang ,lang* ,in ,out))) + (in (tmtex (cadr l))) + (out (tmtex (caddr l))) + ) ; + `(,name ,lang ,lang* ,in ,out) + ) ;let +) ;define (define (tmtex-list-env s l) (let* ((r (string-replace s "-" "")) (t (cond ((== r "enumerateRoman") "enumerateromancap") ((== r "enumerateAlpha") "enumeratealphacap") - (else r)))) - (list (list '!begin t) (tmtex (car l))))) + (else r) + ) ;cond + ) ;t + ) ; + (list (list '!begin t) (tmtex (car l))) + ) ;let* +) ;define (define (tmtex-tiny s l) - (tex-apply 'tiny (tmtex (car l)))) + (tex-apply 'tiny (tmtex (car l))) +) ;define (define (tmtex-scriptsize s l) - (tex-apply 'scriptsize (tmtex (car l)))) + (tex-apply 'scriptsize (tmtex (car l))) +) ;define (define (tmtex-footnotesize s l) - (tex-apply 'footnotesize (tmtex (car l)))) + (tex-apply 'footnotesize (tmtex (car l))) +) ;define (define (tmtex-small s l) - (tex-apply 'small (tmtex (car l)))) + (tex-apply 'small (tmtex (car l))) +) ;define (define (tmtex-normalsize s l) - (tex-apply 'normalsize (tmtex (car l)))) + (tex-apply 'normalsize (tmtex (car l))) +) ;define (define (tmtex-large s l) - (tex-apply 'large (tmtex (car l)))) + (tex-apply 'large (tmtex (car l))) +) ;define (define (tmtex-Large s l) - (tex-apply 'Large (tmtex (car l)))) + (tex-apply 'Large (tmtex (car l))) +) ;define (define (tmtex-LARGE s l) - (tex-apply 'LARGE (tmtex (car l)))) + (tex-apply 'LARGE (tmtex (car l))) +) ;define (define (tmtex-Huge s l) - (list 'Huge (tmtex (car l)))) + (list 'Huge (tmtex (car l))) +) ;define (define (tmtex-specific-language s l) - (tmtex `(with "language" ,s ,(car l)))) + (tmtex `(with ,"language" ,s ,(car l))) +) ;define (tm-define (tmtex-equation s l) + (tmtex-image-increment) (tmtex-env-set "mode" "math") (let ((r (tmtex (car l)))) (tmtex-env-reset "mode") - (if (== s "equation") - (list (list '!begin s) r) - (list '!eqn r)))) + (if (== s "equation") (list (list '!begin s) r) (list '!eqn r)) + ) ;let +) ;tm-define (define (tmtex-eqnarray s l) + (tmtex-image-increment) (tmtex-env-set "mode" "math") (let ((r (tmtex-table-apply (string->symbol s) '() (car l)))) (tmtex-env-reset "mode") - r)) + r + ) ;let +) ;define (define (tmtex-math s l) - (cond ((tm-in? (car l) '(equation equation* eqnarray eqnarray*)) - (tmtex (car l))) - ((not (tm-func? (car l) 'document)) - (tmtex `(with "mode" "math" ,(car l)))) - ((tm-func? (car l) 'document 1) - (tmtex `(math ,(cadr (car l))))) - (else - (with ps (map (lambda (x) `(math ,x)) (cdar l)) - (tmtex `(document ,@ps)))))) + (cond ((tm-in? (car l) '(equation equation* eqnarray eqnarray*)) (tmtex (car l))) + ((not (tm-func? (car l) 'document)) (tmtex `(with ,"mode" + ,"math" + ,(car l)))) + ((tm-func? (car l) 'document 1) (tmtex `(math ,(cadr (car l))))) + (else (with ps (map (lambda (x) `(math ,x)) (cdar l)) (tmtex `(document ,@ps)))) + ) ;cond +) ;define (define (tmtex-textual x) (tmtex-env-set "mode" "text") - (with r (tmtex x) - (tmtex-env-reset "mode") - r)) + (with r (tmtex x) (tmtex-env-reset "mode") r) +) ;define (define (tmtex-text s l) - (list 'text (tmtex-textual (car l)))) + (list 'text (tmtex-textual (car l))) +) ;define (define (tmtex-math-up s l) - (post-process-math-text (list 'mathrm (tmtex-textual (car l))))) + (post-process-math-text (list 'mathrm (tmtex-textual (car l)))) +) ;define (define (tmtex-math-ss s l) - (post-process-math-text (list 'mathsf (tmtex-textual (car l))))) + (post-process-math-text (list 'mathsf (tmtex-textual (car l)))) +) ;define (define (tmtex-math-tt s l) - (post-process-math-text (list 'mathtt (tmtex-textual (car l))))) + (post-process-math-text (list 'mathtt (tmtex-textual (car l)))) +) ;define (define (tmtex-math-bf s l) - (post-process-math-text (list 'mathbf (tmtex-textual (car l))))) + (post-process-math-text (list 'mathbf (tmtex-textual (car l)))) +) ;define (define (tmtex-math-sl s l) - (post-process-math-text (list 'mathsl (tmtex-textual (car l))))) + (post-process-math-text (list 'mathsl (tmtex-textual (car l)))) +) ;define (define (tmtex-math-it s l) - (post-process-math-text (list 'mathit (tmtex-textual (car l))))) + (post-process-math-text (list 'mathit (tmtex-textual (car l)))) +) ;define (define (tmtex-mathord s l) - (list 'mathord (tmtex (car l)))) + (list 'mathord (tmtex (car l))) +) ;define (define (tmtex-mathbin s l) - (list 'mathbin (tmtex (car l)))) + (list 'mathbin (tmtex (car l))) +) ;define (define (tmtex-mathrel s l) - (list 'mathrel (tmtex (car l)))) + (list 'mathrel (tmtex (car l))) +) ;define (define (tmtex-mathopen s l) - (list 'mathopen (tmtex (car l)))) + (list 'mathopen (tmtex (car l))) +) ;define (define (tmtex-mathclose s l) - (list 'mathclose (tmtex (car l)))) + (list 'mathclose (tmtex (car l))) +) ;define (define (tmtex-mathpunct s l) - (list 'mathpunct (tmtex (car l)))) + (list 'mathpunct (tmtex (car l))) +) ;define (define (tmtex-mathop s l) - (list 'mathop (tmtex (car l)))) + (list 'mathop (tmtex (car l))) +) ;define (define (tmtex-syntax l) - (tmtex (car l))) + (tmtex (car l)) +) ;define (define (tmtex-theindex s l) - (list 'printindex)) + (list 'printindex) +) ;define (define (tmtex-toc s l) - (tex-apply 'tableofcontents)) + (tex-apply 'tableofcontents) +) ;define (define (tmtex-bib-sub doc) (cond ((nlist? doc) doc) ((match? doc '(concat (bibitem* :%1) (label :string?) :*)) - (let* ((l (cadr (caddr doc))) - (s (if (string-starts? l "bib-") (string-drop l 4) l))) - (cons* 'concat (list 'bibitem* (cadadr doc) s) (cdddr doc)))) + (let* ((l (cadr (caddr doc))) (s (if (string-starts? l "bib-") (string-drop l 4) l))) + (cons* 'concat (list 'bibitem* (cadadr doc) s) (cdddr doc)) + ) ;let* + ) ; ((func? doc 'bib-list 2) (tmtex-bib-sub (cAr doc))) - (else (map tmtex-bib-sub doc)))) + (else (map tmtex-bib-sub doc)) + ) ;cond +) ;define (define (tmtex-bib-max l) (cond ((npair? l) "") ((match? l '(bibitem* :string? :%1)) (cadr l)) - (else (let* ((s1 (tmtex-bib-max (car l))) - (s2 (tmtex-bib-max (cdr l)))) - (if (< (string-length s1) (string-length s2)) s2 s1))))) + (else (let* ((s1 (tmtex-bib-max (car l))) (s2 (tmtex-bib-max (cdr l)))) + (if (< (string-length s1) (string-length s2)) s2 s1) + ) ;let* + ) ;else + ) ;cond +) ;define (tm-define (tmtex-biblio s l titled?) (if tmtex-indirect-bib? - (tex-concat (list (list 'bibliographystyle (force-string (cadr l))) - (list 'bibliography (force-string (caddr l))))) - (let* ((doc (tmtex-bib-sub (cadddr l))) - (max (tmtex-textual (tmtex-bib-max doc))) - (tls tmtex-languages) - (lan (or (and (pair? tls) (car tls)) "english")) - (txt (translate-from-to "References" "english" lan)) - (bib (tmtex (list 'thebibliography max doc)))) - (if titled? - `(!document (section* ,(tmtex txt)) ,bib) - bib)))) - -(tm-define (tmtex-bib t) - (tmtex-biblio (car t) (cdr t) #f)) + (tex-concat (list (list 'bibliographystyle (force-string (cadr l))) + (list 'bibliography (force-string (caddr l))) + ) ;list + ) ;tex-concat + (let* ((doc (tmtex-bib-sub (cadddr l))) + (max (tmtex-textual (tmtex-bib-max doc))) + (tls tmtex-languages) + (lan (or (and (pair? tls) (car tls)) "english")) + (txt (translate-from-to "References" "english" lan)) + (bib (tmtex (list 'thebibliography max doc))) + ) ; + (if titled? `(!document (section* ,(tmtex txt)) ,bib) bib) + ) ;let* + ) ;if +) ;tm-define + +(tm-define (tmtex-bib t) (tmtex-biblio (car t) (cdr t) #f)) (define (tmtex-thebibliography s l) - (list (list '!begin s (car l)) (tmtex (cadr l)))) + (list (list '!begin s (car l)) (tmtex (cadr l))) +) ;define (define (tmtex-bibitem*-std s l) - (cond ((= (length l) 1) - `(bibitem ,(car l))) - ((= (length l) 2) - `(bibitem (!option ,(tmtex (car l))) ,(cadr l))) - (else - (begin - (display* "TeXmacs] non converted bibitem content: " - (list s l) "\n") - "")))) - -(tm-define (tmtex-bibitem* s l) - (tmtex-bibitem*-std s l)) + (cond ((= (length l) 1) `(bibitem ,(car l))) + ((= (length l) 2) `(bibitem (!option ,(tmtex (car l))) ,(cadr l))) + (else (begin + (display* "TeXmacs] non converted bibitem content: " (list s l) "\n") + "" + ) ;begin + ) ;else + ) ;cond +) ;define + +(tm-define (tmtex-bibitem* s l) (tmtex-bibitem*-std s l)) (define (split-year s pos) (if (and (> pos 0) - (string>=? (substring s (- pos 1) pos) "0") - (string<=? (substring s (- pos 1) pos) "9")) - (split-year s (- pos 1)) - pos)) + (string>=? (substring s (- pos 1) pos) "0") + (string<=? (substring s (- pos 1) pos) "9") + ) ;and + (split-year s (- pos 1)) + pos + ) ;if +) ;define (define (natbibify s) - (let* ((pos (split-year s (string-length s))) + (let* ((pos (split-year s (string-length s))) (auth (substring s 0 pos)) - (year (substring s pos (string-length s)))) + (year (substring s pos (string-length s))) + ) ; (when (== (string-length year) 2) - (set! year (string-append (if (string>=? year "30") "19" "20") year))) - (string-append auth "(" year ")"))) + (set! year (string-append (if (string>=? year "30") "19" "20") year)) + ) ;when + (string-append auth "(" year ")") + ) ;let* +) ;define (tm-define (tmtex-bibitem* s l) (:mode natbib-package?) - (if (and (== (length l) 2) - (string? (cadr l)) - (not (string-occurs? "(" (cadr l)))) - (tmtex-bibitem*-std s (list (natbibify (cadr l)) (cadr l))) - (tmtex-bibitem*-std s l))) + (if (and (== (length l) 2) (string? (cadr l)) (not (string-occurs? "(" (cadr l)))) + (tmtex-bibitem*-std s (list (natbibify (cadr l)) (cadr l))) + (tmtex-bibitem*-std s l) + ) ;if +) ;tm-define (define (tmtex-figure s l) - (tmtex-float-sub #f "h" (cons (string->symbol s) l))) + (tmtex-float-sub #f "h" (cons (string->symbol s) l)) +) ;define (define (tmtex-item s l) - (tex-concat (list (list 'item) " "))) + (tex-concat (list (list 'item) " ")) +) ;define (define (tmtex-item-arg s l) - (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " "))) + (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " ")) +) ;define (define (tmtex-render-proof s l) - (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l)))) + (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l))) +) ;define (define (tmtex-nbsp s l) - '(!nbsp)) + '(!nbsp) +) ;define (define (tmtex-nbhyph s l) - '(!nbhyph)) + '(!nbhyph) +) ;define (define (tmtex-frac* s l) - (tex-concat (list (tmtex (car l)) "/" (tmtex (cadr l))))) + (tex-concat (list (tmtex (car l)) "/" (tmtex (cadr l)))) +) ;define (define (tmtex-ornament-shape s) - (if (== s "rounded") "1.7ex" "0pt")) + (if (== s "rounded") "1.7ex" "0pt") +) ;define (define (assign-ornament-env l) - (let* ((keys* (car l)) - (val (cadr l)) - (keys (cDr keys*)) - (fun (cAr keys*))) + (let* ((keys* (car l)) (val (cadr l)) (keys (cDr keys*)) (fun (cAr keys*))) (apply string-append - (list-intersperse - (map (lambda (key) - (with arg (fun val) - (if (nstring? arg) "" - (string-append key "=" arg)))) keys) ",")))) + (list-intersperse (map (lambda (key) + (with arg (fun val) (if (nstring? arg) "" (string-append key "=" arg))) + ) ;lambda + keys + ) ;map + "," + ) ;list-intersperse + ) ;apply + ) ;let* +) ;define (define (get-ornament-env) - (let* ((l1 (ahash-set->list tmtex-env)) + (let* ((l1 (ahash-set->list tmtex-env)) (l21 (map (cut logic-ref tex-ornament-opts% <>) l1)) (l22 (map (cut tmtex-env-get <>) l1)) - (l3 (map (lambda (x y) (if (and x y) (list x y) '())) l21 l22)) - (l4 (filter nnull? l3)) - (l5 (map assign-ornament-env l4))) - (apply string-append (list-intersperse l5 ",")))) + (l3 (map (lambda (x y) (if (and x y) (list x y) '())) l21 l22)) + (l4 (filter nnull? l3)) + (l5 (map assign-ornament-env l4)) + ) ; + (apply string-append (list-intersperse l5 ",")) + ) ;let* +) ;define (define (tmtex-ornamented s l) - (let* ((env (string-append "tm" s)) - (option (get-ornament-env)) - (option* (if (!= option "") `((!option ,option)) '()))) - `((!begin ,env ,@option*) ,(tmtex (car l))))) + (let* ((env (string-append "tm" s)) + (option (get-ornament-env)) + (option* (if (!= option "") `((!option ,option)) '())) + ) ; + `((!begin ,env ,@option*) ,(tmtex (car l))) + ) ;let* +) ;define (logic-table tex-ornament-opts% - ("padding-above" ("skipabove" ,tmtex-decode-length)) - ("padding-below" ("skipbelow" ,tmtex-decode-length)) - ("overlined-sep" ("innertopmargin" ,tmtex-decode-length)) - ("underlined-sep" ("innerbottommargin" ,tmtex-decode-length)) - ("framed-hsep" ("innerleftmargin" "innerrightmargin" - ,tmtex-decode-length)) - ("framed-vsep" ("innertopmargin" "innerbottommargin" - ,tmtex-decode-length)) - ("ornament-vpadding" ("innertopmargin" "innerbottommargin" - ,tmtex-decode-length)) - ("ornament-hpadding" ("innerleftmargin" "innerrightmargin" - ,tmtex-decode-length)) - ("ornament-color" ("backgroundcolor" ,tmtex-decode-color)) - ("ornament-shape" ("roundcorner" ,tmtex-ornament-shape))) + ("padding-above" ("skipabove" ,tmtex-decode-length)) + ("padding-below" ("skipbelow" ,tmtex-decode-length)) + ("overlined-sep" ("innertopmargin" ,tmtex-decode-length)) + ("underlined-sep" ("innerbottommargin" ,tmtex-decode-length)) + ("framed-hsep" ("innerleftmargin" "innerrightmargin" ,tmtex-decode-length)) + ("framed-vsep" ("innertopmargin" "innerbottommargin" ,tmtex-decode-length)) + ("ornament-vpadding" + ("innertopmargin" "innerbottommargin" ,tmtex-decode-length) + ) ; + ("ornament-hpadding" + ("innerleftmargin" "innerrightmargin" ,tmtex-decode-length) + ) ; + ("ornament-color" ("backgroundcolor" ,tmtex-decode-color)) + ("ornament-shape" ("roundcorner" ,tmtex-ornament-shape)) +) ;logic-table (define (tmtex-tm s l) - (with tag (string->symbol (string-append "tm" (string-replace s "-" ""))) - `(,tag ,@(map tmtex l)))) + (with tag + (string->symbol (string-append "tm" (string-replace s "-" ""))) + `(,tag ,@(map tmtex l)) + ) ;with +) ;define (define (tmtex-input-math s l) (let ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) - (a1 (tmtex (car l))) - (a2 (with r (begin - (tmtex-env-set "mode" "math") - (tmtex (cadr l))) - (tmtex-env-reset "mode") r))) - (list tag a1 a2))) + (a1 (tmtex (car l))) + (a2 (with r + (begin + (tmtex-env-set "mode" "math") + (tmtex (cadr l)) + ) ;begin + (tmtex-env-reset "mode") + r + ) ;with + ) ;a2 + ) ; + (list tag a1 a2) + ) ;let +) ;define (define (tmtex-fold-io-math s l) (let ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) - (a1 (tmtex (car l))) - (a2 (with r (begin - (tmtex-env-set "mode" "math") - (tmtex (cadr l))) - (tmtex-env-reset "mode") r)) - (a3 (tmtex (caddr l)))) - (list tag a1 a2 a3))) + (a1 (tmtex (car l))) + (a2 (with r + (begin + (tmtex-env-set "mode" "math") + (tmtex (cadr l)) + ) ;begin + (tmtex-env-reset "mode") + r + ) ;with + ) ;a2 + (a3 (tmtex (caddr l))) + ) ; + (list tag a1 a2 a3) + ) ;let +) ;define (define (tmtex-session s l) (let* ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) (arg (tmtex (car l))) (lan (tmtex (cadr l))) - (lst (tmtex (caddr l)))) - (if (func? lst '!document) - (set! lst `(!indent (!paragraph ,@(cdr lst))))) - `(!document (,tag ,arg ,lan ,lst)))) + (lst (tmtex (caddr l))) + ) ; + (if (func? lst '!document) (set! lst `(!indent (!paragraph ,@(cdr lst))))) + `(!document (,tag ,arg ,lan ,lst)) + ) ;let* +) ;define (define (escape-hyperref-url l) (cond ((string? l) (let* ((r1 (string-replace l "\\" "\\\\")) (r2 (string-replace r1 "#" "\\#")) - (r3 (string-replace r2 "_" "\\_"))) - r3)) + (r3 (string-replace r2 "_" "\\_")) + ) ; + r3 + ) ;let* + ) ; ((symbol? l) l) - (else (map escape-hyperref-url l)))) + (else (map escape-hyperref-url l)) + ) ;cond +) ;define (define (tmtex-hyperref u) - (tmtex-tt (escape-hyperref-url u))) + (tmtex-tt (escape-hyperref-url u)) +) ;define (define (tmtex-hlink s l) - (let* ((h (cadr l)) - (d (tmtex (car l)))) + (let* ((h (cadr l)) (d (tmtex (car l)))) (if (and (string? h) (string-starts? h "#")) - (list 'hyperref `(!option ,(string-drop h 1)) d) - (list 'href (tmtex-hyperref h) d)))) + (list 'hyperref `(!option ,(string-drop h 1)) d) + (list 'href (tmtex-hyperref h) d) + ) ;if + ) ;let* +) ;define (define (tmtex-href s l) - (list 'url (tmtex-verb-string (car l)))) + (list 'url (tmtex-verb-string (car l))) +) ;define (define (tmtex-action s l) - (list 'tmaction (tmtex (car l)) (tmtex (cadr l)))) + (list 'tmaction (tmtex (car l)) (tmtex (cadr l))) +) ;define (define (tmtex-choose s l) - (list 'binom (tmtex (car l)) (tmtex (cadr l)))) + (list 'binom (tmtex (car l)) (tmtex (cadr l))) +) ;define (define (tmtex-text-tt s l) - (if (tmtex-math-mode?) - (tmtex-math-tt s l) - (tmtex-modifier s l))) + (if (tmtex-math-mode?) (tmtex-math-tt s l) (tmtex-modifier s l)) +) ;define (define (tmtex-modifier s l) - (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l)))) + (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l))) +) ;define (define (tmtex-render-line-number s l) - (list 'tmlinenumber (tmtex (car l)) (tmtex-decode-length (tmtex (cadr l))))) + (list 'tmlinenumber (tmtex (car l)) (tmtex-decode-length (tmtex (cadr l)))) +) ;define (define (tmtex-menu-one x) - (tmtex (list 'samp x))) + (tmtex (list 'samp x)) +) ;define (define (tmtex-menu-list l) - (if (null? l) l - (cons* (list '!math (list 'rightarrow)) - (tmtex-menu-one (car l)) - (tmtex-menu-list (cdr l))))) + (if (null? l) + l + (cons* (list '!math (list 'rightarrow)) + (tmtex-menu-one (car l)) + (tmtex-menu-list (cdr l)) + ) ;cons* + ) ;if +) ;define (define (tmtex-menu s l) - (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l))))) + (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l)))) +) ;define (define ((tmtex-rename into) s l) - (tmtex-apply into (tmtex-list l))) + (tmtex-apply into (tmtex-list l)) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Citations @@ -2807,101 +3737,136 @@ (cond ((null? l) "") ((nstring? (car l)) (display* "TeXmacs] non converted citation: " (car l) "\n") - (tmtex-cite-list (cdr l))) + (tmtex-cite-list (cdr l)) + ) ; ((null? (cdr l)) (car l)) - (else (string-append (car l) "," (tmtex-cite-list (cdr l)))))) + (else (string-append (car l) "," (tmtex-cite-list (cdr l)))) + ) ;cond +) ;define -(tm-define (tmtex-cite s l) - (tex-apply 'cite (tmtex-cite-list l))) +(tm-define (tmtex-cite s l) (tex-apply 'cite (tmtex-cite-list l))) (tm-define (tmtex-cite s l) (:mode natbib-package?) - (tex-apply 'citep (tmtex-cite-list l))) + (tex-apply 'citep (tmtex-cite-list l)) +) ;tm-define (define (tmtex-nocite s l) - (tex-apply 'nocite (tmtex-cite-list l))) + (tex-apply 'nocite (tmtex-cite-list l)) +) ;define (define (tmtex-cite-TeXmacs s l) - (tex-apply 'citetexmacs (tmtex-cite-list l))) + (tex-apply 'citetexmacs (tmtex-cite-list l)) +) ;define (tm-define (tmtex-cite-detail s l) - (with c (tmtex-cite-list (list (car l))) - (tex-apply 'cite `(!option ,(tmtex (cadr l))) c))) + (with c + (tmtex-cite-list (list (car l))) + (tex-apply 'cite `(!option ,(tmtex (cadr l))) c) + ) ;with +) ;tm-define (tm-define (tmtex-cite-detail s l) (:mode natbib-package?) - (with c (tmtex-cite-list (list (car l))) - (tex-apply 'citetext `(!concat (citealp ,c) ", " ,(tmtex (cadr l)))))) + (with c + (tmtex-cite-list (list (car l))) + (tex-apply 'citetext `(!concat (citealp ,c) ,", " ,(tmtex (cadr l)))) + ) ;with +) ;tm-define (tm-define (tmtex-cite-detail-poor s l) - (with c (tmtex-cite-list (list (car l))) - `(!concat ,(tex-apply 'cite c) " (" ,(tmtex (cadr l)) ")"))) + (with c + (tmtex-cite-list (list (car l))) + `(!concat ,(tex-apply 'cite c) ," (" ,(tmtex (cadr l)) ,")") + ) ;with +) ;tm-define (define (tmtex-cite-detail-hook s l) - (tmtex-cite-detail s l)) + (tmtex-cite-detail s l) +) ;define (define (tmtex-cite-raw s l) - (tex-apply 'citealp (tmtex-cite-list l))) + (tex-apply 'citealp (tmtex-cite-list l)) +) ;define (define (tmtex-cite-raw* s l) - (tex-apply 'citealp* (tmtex-cite-list l))) + (tex-apply 'citealp* (tmtex-cite-list l)) +) ;define (define (tmtex-cite-textual s l) - (tex-apply 'citet (tmtex-cite-list l))) + (tex-apply 'citet (tmtex-cite-list l)) +) ;define (define (tmtex-cite-textual* s l) - (tex-apply 'citet* (tmtex-cite-list l))) + (tex-apply 'citet* (tmtex-cite-list l)) +) ;define (define (tmtex-cite-parenthesized s l) - (tex-apply 'citep (tmtex-cite-list l))) + (tex-apply 'citep (tmtex-cite-list l)) +) ;define (define (tmtex-cite-parenthesized* s l) - (tex-apply 'citep* (tmtex-cite-list l))) + (tex-apply 'citep* (tmtex-cite-list l)) +) ;define (define (tmtex-render-cite s l) - (tex-apply 'citetext (tmtex (car l)))) + (tex-apply 'citetext (tmtex (car l))) +) ;define (define (tmtex-cite-author s l) - (tex-apply 'citeauthor (tmtex (car l)))) + (tex-apply 'citeauthor (tmtex (car l))) +) ;define (define (tmtex-cite-author* s l) - (tex-apply 'citeauthor* (tmtex (car l)))) + (tex-apply 'citeauthor* (tmtex (car l))) +) ;define (define (tmtex-cite-year s l) - (tex-apply 'citeyear (tmtex (car l)))) + (tex-apply 'citeyear (tmtex (car l))) +) ;define (define (tmtex-natbib-triple s l) - `(protect (citeauthoryear ,@(map tmtex l)))) + `(protect (citeauthoryear ,@(map tmtex l))) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Glossaries ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (tmtex-glossary s l) - (with nr (+ tmtex-auto-produce 1) + (with nr + (+ tmtex-auto-produce 1) (set! tmtex-auto-produce nr) - `(label ,(string-append "autolab" (number->string nr))))) + `(label ,(string-append "autolab" (number->string nr))) + ) ;with +) ;define (define (tmtex-glossary-entry s l) - (with nr (+ tmtex-auto-consume 1) - (with lab (string-append "autolab" (number->string nr)) + (with nr + (+ tmtex-auto-consume 1) + (with lab + (string-append "autolab" (number->string nr)) (set! tmtex-auto-consume nr) - `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab))))) + `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab)) + ) ;with + ) ;with +) ;define (define (tmtex-glossary-line t) - (with r (tmtex t) - (if (func? r 'glossaryentry) r - `(listpart ,r)))) + (with r (tmtex t) (if (func? r 'glossaryentry) r `(listpart ,r))) +) ;define (define (tmtex-glossary-body b) (if (not (tm-func? b 'document)) - (tmtex b) - (cons '!document (map-in-order tmtex-glossary-line (cdr b))))) + (tmtex b) + (cons '!document (map-in-order tmtex-glossary-line (cdr b))) + ) ;if +) ;define (define (tmtex-the-glossary s l) - `(!document - (,(if (latex-book-style?) 'chapter* 'section*) "Glossary") - ((!begin "theglossary" ,(car l)) ,(tmtex-glossary-body (cadr l))))) + `(!document (,(if (latex-book-style?) 'chapter* 'section*) ,"Glossary") + ((!begin ,"theglossary" ,(car l)) ,(tmtex-glossary-body (cadr l)))) +) ;define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The main conversion routines @@ -2909,199 +3874,294 @@ (define (tmtex-apply key args) (let ((n (length args)) - (r (or (ahash-ref tmtex-dynamic key) (logic-ref tmtex-methods% key)))) + (r (or (ahash-ref tmtex-dynamic key) (logic-ref tmtex-methods% key))) + ) ; (if (in? key '(quote quasiquote unquote)) (set! r tmtex-noop)) - (cond ((== r 'environment) - (tmtex-std-env (symbol->string key) args)) + (cond ((== r 'environment) (tmtex-std-env (symbol->string key) args)) (r (r args)) - (else - (let ((p (logic-ref tmtex-tmstyle% key))) - (cond ((and p (or (= (cadr p) -1) (= (cadr p) n))) - ((car p) (symbol->string key) args)) - ((and p (= (cadr p) -2)) ((car p) `(,key ,@args))) - ((and (= n 1) - (or (func? (car args) 'tformat) - (func? (car args) 'table))) - (tmtex-table-apply key '() (car args))) - ((and (= n 2) - (or (func? (cAr args) 'tformat) - (func? (cAr args) 'table))) - (tmtex-table-apply key (cDr args) (cAr args))) - (else (tmtex-function key args)))))))) + (else (let ((p (logic-ref tmtex-tmstyle% key))) + (cond ((and p (or (= (cadr p) -1) (= (cadr p) n))) + ((car p) (symbol->string key) args) + ) ; + ((and p (= (cadr p) -2)) ((car p) `(,key ,@args))) + ((and (= n 1) (or (func? (car args) 'tformat) (func? (car args) 'table))) + (tmtex-table-apply key '() (car args)) + ) ; + ((and (= n 2) (or (func? (cAr args) 'tformat) (func? (cAr args) 'table))) + (tmtex-table-apply key (cDr args) (cAr args)) + ) ; + (else (tmtex-function key args)) + ) ;cond + ) ;let + ) ;else + ) ;cond + ) ;let +) ;define (define (tmtex-function f l) (if (== (string-ref (symbol->string f) 0) #\!) - (cons f (map-in-order tmtex l)) - (let ((v (tmtex-var-name (symbol->string f)))) - (if (== v "") "" - (apply tex-apply - (cons (string->symbol v) - (map-in-order tmtex l))))))) + (cons f (map-in-order tmtex l)) + (let ((v (tmtex-var-name (symbol->string f)))) + (if (== v "") + "" + (apply tex-apply (cons (string->symbol v) (map-in-order tmtex l))) + ) ;if + ) ;let + ) ;if +) ;define (define (tmtex-compound l) - (if (string? (car l)) - (tmtex-apply (string->symbol (car l)) (cdr l)) - "")) + (if (string? (car l)) (tmtex-apply (string->symbol (car l)) (cdr l)) "") +) ;define (define (tmtex-list l) - (map-in-order tmtex l)) + (map-in-order tmtex l) +) ;define (tm-define (tmtex x) (cond ((string? x) (tmtex-string x)) ((list>0? x) (tmtex-apply (car x) (cdr x))) - (else ""))) + (else "") + ) ;cond +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Dispatching ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (logic-dispatcher tmtex-primitives% - ((:or unknown uninit error raw-data) tmtex-error) - (document tmtex-document) - (para tmtex-para) - (surround tmtex-surround) - (concat tmtex-concat) - (rigid tmtex-rigid) - (hgroup tmtex-rigid) - (vgroup tmtex-id) - (hidden tmtex-noop) - (hspace tmtex-hspace) - (vspace* tmtex-noop) - (vspace tmtex-vspace) - (space tmtex-space) - (htab tmtex-htab) - (move tmtex-first) - (shift tmtex-first) - (resize tmtex-first) - (clipped tmtex-first) - (repeat tmtex-noop) - (float tmtex-float) - (datoms tmtex-second) - ((:or dlines dpages dbox) tmtex-noop) - (line-note tmtex-line-note) - - (with-limits tmtex-noop) - (line-break tmtex-line-break) - (new-line tmtex-new-line) - (next-line tmtex-next-line) - (emdash tmtex-emdash) - (no-break tmtex-no-break) - (no-indent tmtex-no-first-indentation) - (yes-indent tmtex-noop) - (no-indent* tmtex-noop) - (yes-indent* tmtex-noop) - (page-break* tmtex-noop) - (page-break tmtex-page-break) - (no-page-break* tmtex-noop) - (no-page-break tmtex-no-page-break) - (no-break-here* tmtex-noop) - (no-break-here tmtex-no-page-break) - (no-break-start tmtex-no-page-break) - (no-break-end tmtex-noop) - (new-page* tmtex-noop) - (new-page tmtex-new-page) - (new-dpage* tmtex-noop) - (new-dpage tmtex-noop) - - (around tmtex-around) - (around* tmtex-around*) - (big-around tmtex-big-around) - (left tmtex-left) - (mid tmtex-mid) - (right tmtex-right) - (big tmtex-big) - (long-arrow tmtex-long-arrow) - (lprime tmtex-lsup) - (rprime tmtex-rsup) - (below tmtex-below) - (above tmtex-above) - (lsub tmtex-lsub) - (lsup tmtex-lsup) - (rsub tmtex-rsub) - (rsup tmtex-rsup) - (modulo tmtex-modulo) - (frac tmtex-frac) - (sqrt tmtex-sqrt) - (wide tmtex-wide) - (neg tmtex-neg) - (wide* tmtex-wide-star) - ;;(tree tmtex-tree) - (tree tmtex-tree-eps) - - (tformat tmtex-tformat) - ((:or twith cwith tmarker) tmtex-noop) - (table tmtex-table) - ((:or row cell subtable) tmtex-noop) - - (assign tmtex-assign) - (with tmtex-with-wrapped) - (provides tmtex-noop) - (value tmtex-compound) - (quote-value tmtex-noop) - ((:or quote-value drd-props arg quote-arg) tmtex-noop) - (compound tmtex-compound) - ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop) - ;; quote missing - (quasi tmtex-noop) - ;; quasiquote missing - ;; unquote missing - ((:or unquote* copy - if if* case while for-each - extern include use-package) tmtex-noop) - (syntax tmtex-syntax) - - ((:or or xor and not plus minus times over div mod - merge length range find-file - is-tuple look-up - equal unequal less lesseq greater greatereq) tmtex-noop) - - (number tmtex-number) - (change-case tmtex-change-case) - (date tmtex-date) - - ((:or cm-length mm-length in-length pt-length - bp-length dd-length pc-length cc-length - fs-length fbs-length em-length - ln-length sep-length yfrac-length ex-length - fn-length fns-length bls-length - spc-length xspc-length par-length pag-length - gm-length gh-length) tmtex-noop) - - ((:or style-with style-with* style-only style-only* - active active* inactive inactive* - rewrite-inactive inline-tag open-tag middle-tag close-tag - symbol latex hybrid) tmtex-noop) - - ((:or tuple attr tmlen collection associate backup) tmtex-noop) - (set-binding tmtex-noop) - (get-binding tmtex-noop) - (hidden-binding tmtex-hidden-binding) - (label tmtex-label) - (reference tmtex-reference) - (pageref tmtex-pageref) - (write tmtex-noop) - (specific tmtex-specific) - ((:or tag meaning flag) tmtex-noop) - - ((:or anim-compose anim-repeat anim-constant - anim-translate anim-progressive video sound) tmtex-noop) - - (graphics tmtex-graphics) - (superpose tmtex-noop) - ((:or gr-group gr-transform - text-at cline arc carc spline spine* cspline fill) tmtex-noop) - (image tmtex-image) - ((:or box-info frame-direct frame-inverse) tmtex-noop) - - ((:or format line-sep split delay hold release - old-matrix old-table old-mosaic old-mosaic-item - set reset expand expand* hide-expand display-baloon - apply begin end func env) tmtex-noop) - - (shown tmtex-id) - (mtm tmtex-mtm) - (!file tmtex-file) - (!arg tmtex-tex-arg)) + ((:or unknown uninit error raw-data) tmtex-error) + (document tmtex-document) + (para tmtex-para) + (surround tmtex-surround) + (concat tmtex-concat) + (rigid tmtex-rigid) + (hgroup tmtex-rigid) + (vgroup tmtex-id) + (hidden tmtex-noop) + (hspace tmtex-hspace) + (vspace* tmtex-noop) + (vspace tmtex-vspace) + (space tmtex-space) + (htab tmtex-htab) + (move tmtex-first) + (shift tmtex-first) + (resize tmtex-first) + (clipped tmtex-first) + (repeat tmtex-noop) + (float tmtex-float) + (datoms tmtex-second) + ((:or dlines dpages dbox) tmtex-noop) + (line-note tmtex-line-note) + + (with-limits tmtex-noop) + (line-break tmtex-line-break) + (new-line tmtex-new-line) + (next-line tmtex-next-line) + (emdash tmtex-emdash) + (no-break tmtex-no-break) + (no-indent tmtex-no-first-indentation) + (yes-indent tmtex-noop) + (no-indent* tmtex-noop) + (yes-indent* tmtex-noop) + (page-break* tmtex-noop) + (page-break tmtex-page-break) + (no-page-break* tmtex-noop) + (no-page-break tmtex-no-page-break) + (no-break-here* tmtex-noop) + (no-break-here tmtex-no-page-break) + (no-break-start tmtex-no-page-break) + (no-break-end tmtex-noop) + (new-page* tmtex-noop) + (new-page tmtex-new-page) + (new-dpage* tmtex-noop) + (new-dpage tmtex-noop) + + (around tmtex-around) + (around* tmtex-around*) + (big-around tmtex-big-around) + (left tmtex-left) + (mid tmtex-mid) + (right tmtex-right) + (big tmtex-big) + (long-arrow tmtex-long-arrow) + (lprime tmtex-lsup) + (rprime tmtex-rsup) + (below tmtex-below) + (above tmtex-above) + (lsub tmtex-lsub) + (lsup tmtex-lsup) + (rsub tmtex-rsub) + (rsup tmtex-rsup) + (modulo tmtex-modulo) + (frac tmtex-frac) + (sqrt tmtex-sqrt) + (wide tmtex-wide) + (neg tmtex-neg) + (wide* tmtex-wide-star) + ;; (tree tmtex-tree) + (tree tmtex-tree-eps) + + (tformat tmtex-tformat) + ((:or twith cwith tmarker) tmtex-noop) + (table tmtex-table) + ((:or row cell subtable) tmtex-noop) + + (assign tmtex-assign) + (with tmtex-with-wrapped) + (provides tmtex-noop) + (value tmtex-compound) + (quote-value tmtex-noop) + ((:or quote-value drd-props arg quote-arg) tmtex-noop) + (compound tmtex-compound) + ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop) + ;; quote missing + (quasi tmtex-noop) + ;; quasiquote missing + ;; unquote missing + ((:or unquote* copy if if* case while for-each extern include use-package) + tmtex-noop + ) ; + (syntax tmtex-syntax) + + ((:or or + xor + and + not + plus + minus + times + over + div + mod + merge + length + range + find-file + is-tuple + look-up + equal + unequal + less + lesseq + greater + greatereq + ) ;:or + tmtex-noop + ) ; + + (number tmtex-number) + (change-case tmtex-change-case) + (date tmtex-date) + + ((:or cm-length + mm-length + in-length + pt-length + bp-length + dd-length + pc-length + cc-length + fs-length + fbs-length + em-length + ln-length + sep-length + yfrac-length + ex-length + fn-length + fns-length + bls-length + spc-length + xspc-length + par-length + pag-length + gm-length + gh-length + ) ;:or + tmtex-noop + ) ; + + ((:or style-with + style-with* + style-only + style-only* + active + active* + inactive + inactive* + rewrite-inactive + inline-tag + open-tag + middle-tag + close-tag + symbol + latex + hybrid + ) ;:or + tmtex-noop + ) ; + + ((:or tuple attr tmlen collection associate backup) tmtex-noop) + (set-binding tmtex-noop) + (get-binding tmtex-noop) + (hidden-binding tmtex-hidden-binding) + (label tmtex-label) + (reference tmtex-reference) + (pageref tmtex-pageref) + (write tmtex-noop) + (specific tmtex-specific) + ((:or tag meaning flag) tmtex-noop) + + ((:or anim-compose + anim-repeat + anim-constant + anim-translate + anim-progressive + video + sound + ) ;:or + tmtex-noop + ) ; + + (graphics tmtex-graphics) + (superpose tmtex-noop) + ((:or gr-group gr-transform text-at cline arc carc spline spine* cspline fill) + tmtex-noop + ) ; + (image tmtex-image) + ((:or box-info frame-direct frame-inverse) tmtex-noop) + + ((:or format + line-sep + split + delay + hold + release + old-matrix + old-table + old-mosaic + old-mosaic-item + set + reset + expand + expand* + hide-expand + display-baloon + apply + begin + end + func + env + ) ;:or + tmtex-noop + ) ; + + (shown tmtex-id) + (mtm tmtex-mtm) + (!file tmtex-file) + (!arg tmtex-tex-arg) +) ;logic-dispatcher (logic-dispatcher tmtex-extra-methods% (stack tmtex-stack) @@ -3109,319 +4169,524 @@ (phantom-float tmtex-noop) ((:or marginal-note marginal-normal-note) tmtex-marginal-note) ((:or marginal-left-note marginal-even-left-note) tmtex-marginal-left-note) - ((:or marginal-right-note marginal-even-right-note)tmtex-marginal-right-note) - (!ilx tmtex-ilx)) + ((:or marginal-right-note marginal-even-right-note) tmtex-marginal-right-note) + (!ilx tmtex-ilx) +) ;logic-dispatcher -(logic-rules - ((tmtex-methods% 'x 'y) (tmtex-primitives% 'x 'y)) - ((tmtex-methods% 'x 'y) (tmtex-extra-methods% 'x 'y))) +(logic-rules ((tmtex-methods% 'x 'y) (tmtex-primitives% 'x 'y)) + ((tmtex-methods% 'x 'y) (tmtex-extra-methods% 'x 'y)) +) ;logic-rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Expansion of all macros which are not recognized by LaTeX ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (logic-table tmtex-tmstyle% - ((:or section subsection subsubsection paragraph subparagraph part chapter) - (,tmtex-sectional 1)) - ((:or hide-preamble show-preamble) (,tmtex-default -1)) - (hide-part (,tmtex-hide-part -1)) - (show-part (,tmtex-show-part -1)) - ((:or doc-title-options author-data) (,tmtex-default -1)) - (appendix (,tmtex-appendix 1)) - (appendix* (,tmtex-appendix* 1)) - ((:or theorem proposition lemma corollary proof axiom definition - notation conjecture remark note example convention warning - acknowledgments - exercise problem question solution answer - quote-env quotation verse - theorem* proposition* lemma* corollary* axiom* definition* - notation* conjecture* remark* note* example* convention* warning* - acknowledgments* - exercise* problem* question* solution* answer*) - (,tmtex-enunciation 1)) - (new-theorem (,tmtex-new-theorem 2)) - (new-remark (,tmtex-new-theorem 2)) - (new-exercise (,tmtex-new-theorem 2)) - (verbatim (,tmtex-verbatim 1)) - (padded-center (,tmtex-padded-center 1)) - (padded-left-aligned (,tmtex-padded-left-aligned 1)) - (padded-right-aligned (,tmtex-padded-right-aligned 1)) - (compact (,tmtex-compact 1)) - (compressed (,tmtex-compressed 1)) - (amplified (,tmtex-amplified 1)) - (indent (,tmtex-indent 1)) - (jump-in (,tmtex-jump-in 1)) - (algorithm-indent (,tmtex-indent 1)) - ((:or footnote wide-footnote) (,tmtex-footnote 1)) - (footnotemark (,tmtex-default 0)) - (footnotemark* (,tmtex-footnotemark 1)) - ((:or description description-compact description-aligned - description-dash description-long description-paragraphs - itemize itemize-minus itemize-dot itemize-arrow - enumerate enumerate-numeric enumerate-numeric-bracket - enumerate-roman enumerate-roman-bracket enumerate-roman-paren - enumerate-Roman - enumerate-alpha enumerate-alpha-bracket - enumerate-alpha-full-paren enumerate-Alpha) - (,tmtex-list-env 1)) - ((:or folded unfolded folded-plain unfolded-plain folded-std unfolded-std - folded-explain unfolded-explain folded-env unfolded-env - folded-documentation unfolded-documentation folded-grouped - unfolded-grouped summarized detailed summarized-plain summarized-std - summarized-env summarized-documentation summarized-grouped - summarized-raw summarized-tiny detailed-plain detailed-std detailed-env - detailed-documentation detailed-grouped detailed-raw detailed-tiny - unfolded-subsession folded-subsession folded-io unfolded-io - input output errput timing) - (,tmtex-tm -1)) - ((:or padded underlined overlined bothlined framed ornamented) - (,tmtex-ornamented 1)) - ((:or folded-io-math unfolded-io-math) (,tmtex-fold-io-math 3)) - (input-math (,tmtex-input-math 2)) - (session (,tmtex-session 3)) - ((:or converter-input converter-output) (,tmtex-converter 3)) - ((:or script-input script-output) (,tmtex-script-inout 4)) - (really-tiny (,tmtex-tiny 1)) - (very-tiny (,tmtex-tiny 1)) - (tiny (,tmtex-tiny 1)) - (really-small (,tmtex-scriptsize 1)) - (very-small (,tmtex-scriptsize 1)) - (smaller (,tmtex-footnotesize 1)) - (small (,tmtex-small 1)) - (flat-size (,tmtex-small 1)) - (normal-size (,tmtex-normalsize 1)) - (sharp-size (,tmtex-large 1)) - (large (,tmtex-large 1)) - (larger (,tmtex-Large 1)) - (very-large (,tmtex-LARGE 1)) - (really-large (,tmtex-LARGE 1)) - (really-huge (,tmtex-Huge 1)) - ((:or british bulgarian chinese croatian czech danish dutch english - esperanto finnish french german greek hungarian italian japanese - korean polish portuguese romanian russian slovak slovene spanish - swedish chineset ukrainian) - (,tmtex-specific-language 1)) - - (math (,tmtex-math 1)) - (text (,tmtex-text 1)) - (math-up (,tmtex-math-up 1)) - (math-ss (,tmtex-math-ss 1)) - (math-tt (,tmtex-math-tt 1)) - (math-bf (,tmtex-math-bf 1)) - (math-sl (,tmtex-math-sl 1)) - (math-it (,tmtex-math-it 1)) - (math-separator (,tmtex-mathpunct 1)) - (math-quantifier (,tmtex-mathord 1)) - (math-imply (,tmtex-mathbin 1)) - (math-or (,tmtex-mathbin 1)) - (math-and (,tmtex-mathbin 1)) - (math-not (,tmtex-mathord 1)) - (math-relation (,tmtex-mathrel 1)) - (math-union (,tmtex-mathbin 1)) - (math-intersection (,tmtex-mathbin 1)) - (math-exclude (,tmtex-mathbin 1)) - (math-plus (,tmtex-mathbin 1)) - (math-minus (,tmtex-mathbin 1)) - (math-times (,tmtex-mathbin 1)) - (math-over (,tmtex-mathbin 1)) - (math-big (,tmtex-mathop 1)) - (math-prefix (,tmtex-mathord 1)) - (math-postfix (,tmtex-mathord 1)) - (math-open (,tmtex-mathopen 1)) - (math-close (,tmtex-mathclose 1)) - (math-ordinary (,tmtex-mathord 1)) - (math-ignore (,tmtex-mathord 1)) - ((:or eqnarray eqnarray* leqnarray* - gather multline gather* multline* align - flalign alignat align* flalign* alignat*) (,tmtex-eqnarray 1)) - - (eq-number (,tmtex-default -1)) - (separating-space (,tmtex-hspace* 1)) - (application-space (,tmtex-hspace* 1)) - - ((:or code cpp-code mmx-code scm-code shell-code scilab-code verbatim-code) - (,tmtex-code-block 1)) - ((:or mmx cpp scm shell scilab) (,tmtex-code-inline 1)) - - (frame (,tmtex-frame 1)) - (colored-frame (,tmtex-colored-frame 2)) - (fcolorbox (,tmtex-fcolorbox 3)) - (rotate (,tmtex-rotate 2)) - (condensed (,tmtex-style-first 1)) - (translate (,tmtex-translate 3)) - (localize (,tmtex-localize 1)) - (render-key (,tmtex-render-key 1)) - (key (,tmtex-key 1)) - (key* (,tmtex-key* 1)) - (minipage (,tmtex-minipage 3)) - (latex_preview (,tmtex-mixed 2)) - (picture-mixed (,tmtex-mixed 2)) - (source-mixed (,tmtex-mixed 2)) - (listing (,tmtex-listing 1)) - (draw-over (,tmtex-make-eps 3)) - (draw-under (,tmtex-make-eps 3)) - (version-old (,tmtex-style-first 2)) - (version-both (,tmtex-style-second 2)) - (version-new (,tmtex-style-second 2)) - (the-index (,tmtex-theindex -1)) - (glossary (,tmtex-glossary 1)) - (glossary-explain (,tmtex-glossary 2)) - (glossary-2 (,tmtex-glossary-entry 3)) - (the-glossary (,tmtex-the-glossary 2)) - ((:or table-of-contents) (,tmtex-toc 2)) - (thebibliography (,tmtex-thebibliography 2)) - (bib-list (,tmtex-style-second 2)) - (bibitem* (,tmtex-bibitem* -1)) - ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2)) - (item (,tmtex-item 0)) - (item* (,tmtex-item-arg 1)) - (render-proof (,tmtex-render-proof 2)) - (nbsp (,tmtex-nbsp 0)) - (nbhyph (,tmtex-nbhyph 0)) - (hrule (,tmtex-hrule 0)) - (frac* (,tmtex-frac* 2)) - (hlink (,tmtex-hlink 2)) - (action (,tmtex-action -1)) - (href (,tmtex-href 1)) - (slink (,tmtex-href 1)) - (eqref (,tmtex-eqref 1)) - (smart-ref (,tmtex-smart-ref -1)) - (choose (,tmtex-choose 2)) - (tt (,tmtex-text-tt 1)) - ((:or strong em name samp abbr dfn kbd var acronym person) - (,tmtex-modifier 1)) - (render-line-number (,tmtex-render-line-number 2)) - (menu (,tmtex-menu -1)) - (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0)) - (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0)) - (cite-website (,(tmtex-rename 'citewebsite) 0)) - (tm-made (,(tmtex-rename 'tmmade) 0)) - (cite (,tmtex-cite -1)) - (nocite (,tmtex-nocite -1)) - (cite-TeXmacs (,tmtex-cite-TeXmacs -1)) - (cite-detail (,tmtex-cite-detail-hook 2)) - (cite-raw (,tmtex-cite-raw -1)) - (cite-raw* (,tmtex-cite-raw* -1)) - (cite-textual (,tmtex-cite-textual -1)) - (cite-textual* (,tmtex-cite-textual* -1)) - (cite-parenthesized (,tmtex-cite-parenthesized -1)) - (cite-parenthesized* (,tmtex-cite-parenthesized* -1)) - (citet (,tmtex-cite-textual -1)) - (citet* (,tmtex-cite-textual* -1)) - (citep (,tmtex-cite-parenthesized -1)) - (citep* (,tmtex-cite-parenthesized* -1)) - (render-cite (,tmtex-render-cite 1)) - ((:or cite-author cite-author-link) (,tmtex-cite-author 1)) - ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1)) - ((:or cite-year cite-year-link) (,tmtex-cite-year 1)) - (natbib-triple (,tmtex-natbib-triple 3)) - (natexlab (,tmtex-noop -1)) - - ;; FIXME: we should do something more useful with this information - (set-header (,tmtex-noop -1)) - (set-footer (,tmtex-noop -1)) - (set-this-page-header (,tmtex-noop -1)) - (set-this-page-footer (,tmtex-noop -1))) + ((:or section subsection subsubsection paragraph subparagraph part chapter) + (,tmtex-sectional 1) + ) ; + ((:or hide-preamble show-preamble) (,tmtex-default -1)) + (hide-part (,tmtex-hide-part -1)) + (show-part (,tmtex-show-part -1)) + ((:or doc-title-options author-data) (,tmtex-default -1)) + (appendix (,tmtex-appendix 1)) + (appendix* (,tmtex-appendix* 1)) + ((:or theorem + proposition + lemma + corollary + proof + axiom + definition + notation + conjecture + remark + note + example + convention + warning + acknowledgments + exercise + problem + question + solution + answer + quote-env + quotation + verse + theorem* + proposition* + lemma* + corollary* + axiom* + definition* + notation* + conjecture* + remark* + note* + example* + convention* + warning* + acknowledgments* + exercise* + problem* + question* + solution* + answer* + ) ;:or + (,tmtex-enunciation 1) + ) ; + (new-theorem (,tmtex-new-theorem 2)) + (new-remark (,tmtex-new-theorem 2)) + (new-exercise (,tmtex-new-theorem 2)) + (verbatim (,tmtex-verbatim 1)) + (padded-center (,tmtex-padded-center 1)) + (padded-left-aligned (,tmtex-padded-left-aligned 1)) + (padded-right-aligned (,tmtex-padded-right-aligned 1)) + (compact (,tmtex-compact 1)) + (compressed (,tmtex-compressed 1)) + (amplified (,tmtex-amplified 1)) + (indent (,tmtex-indent 1)) + (jump-in (,tmtex-jump-in 1)) + (algorithm-indent (,tmtex-indent 1)) + ((:or footnote wide-footnote) (,tmtex-footnote 1)) + (footnotemark (,tmtex-default 0)) + (footnotemark* (,tmtex-footnotemark 1)) + ((:or description + description-compact + description-aligned + description-dash + description-long + description-paragraphs + itemize + itemize-minus + itemize-dot + itemize-arrow + enumerate + enumerate-numeric + enumerate-numeric-bracket + enumerate-roman + enumerate-roman-bracket + enumerate-roman-paren + enumerate-Roman + enumerate-alpha + enumerate-alpha-bracket + enumerate-alpha-full-paren + enumerate-Alpha + ) ;:or + (,tmtex-list-env 1) + ) ; + ((:or folded + unfolded + folded-plain + unfolded-plain + folded-std + unfolded-std + folded-explain + unfolded-explain + folded-env + unfolded-env + folded-documentation + unfolded-documentation + folded-grouped + unfolded-grouped + summarized + detailed + summarized-plain + summarized-std + summarized-env + summarized-documentation + summarized-grouped + summarized-raw + summarized-tiny + detailed-plain + detailed-std + detailed-env + detailed-documentation + detailed-grouped + detailed-raw + detailed-tiny + unfolded-subsession + folded-subsession + folded-io + unfolded-io + input + output + errput + timing + ) ;:or + (,tmtex-tm -1) + ) ; + ((:or padded underlined overlined bothlined framed ornamented) + (,tmtex-ornamented 1) + ) ; + ((:or folded-io-math unfolded-io-math) (,tmtex-fold-io-math 3)) + (input-math (,tmtex-input-math 2)) + (session (,tmtex-session 3)) + ((:or converter-input converter-output) (,tmtex-converter 3)) + ((:or script-input script-output) (,tmtex-script-inout 4)) + (really-tiny (,tmtex-tiny 1)) + (very-tiny (,tmtex-tiny 1)) + (tiny (,tmtex-tiny 1)) + (really-small (,tmtex-scriptsize 1)) + (very-small (,tmtex-scriptsize 1)) + (smaller (,tmtex-footnotesize 1)) + (small (,tmtex-small 1)) + (flat-size (,tmtex-small 1)) + (normal-size (,tmtex-normalsize 1)) + (sharp-size (,tmtex-large 1)) + (large (,tmtex-large 1)) + (larger (,tmtex-Large 1)) + (very-large (,tmtex-LARGE 1)) + (really-large (,tmtex-LARGE 1)) + (really-huge (,tmtex-Huge 1)) + ((:or british + bulgarian + chinese + croatian + czech + danish + dutch + english + esperanto + finnish + french + german + greek + hungarian + italian + japanese + korean + polish + portuguese + romanian + russian + slovak + slovene + spanish + swedish + chineset + ukrainian + ) ;:or + (,tmtex-specific-language 1) + ) ; + + (math (,tmtex-math 1)) + (text (,tmtex-text 1)) + (math-up (,tmtex-math-up 1)) + (math-ss (,tmtex-math-ss 1)) + (math-tt (,tmtex-math-tt 1)) + (math-bf (,tmtex-math-bf 1)) + (math-sl (,tmtex-math-sl 1)) + (math-it (,tmtex-math-it 1)) + (math-separator (,tmtex-mathpunct 1)) + (math-quantifier (,tmtex-mathord 1)) + (math-imply (,tmtex-mathbin 1)) + (math-or (,tmtex-mathbin 1)) + (math-and (,tmtex-mathbin 1)) + (math-not (,tmtex-mathord 1)) + (math-relation (,tmtex-mathrel 1)) + (math-union (,tmtex-mathbin 1)) + (math-intersection (,tmtex-mathbin 1)) + (math-exclude (,tmtex-mathbin 1)) + (math-plus (,tmtex-mathbin 1)) + (math-minus (,tmtex-mathbin 1)) + (math-times (,tmtex-mathbin 1)) + (math-over (,tmtex-mathbin 1)) + (math-big (,tmtex-mathop 1)) + (math-prefix (,tmtex-mathord 1)) + (math-postfix (,tmtex-mathord 1)) + (math-open (,tmtex-mathopen 1)) + (math-close (,tmtex-mathclose 1)) + (math-ordinary (,tmtex-mathord 1)) + (math-ignore (,tmtex-mathord 1)) + ((:or eqnarray + eqnarray* + leqnarray* + gather + multline + gather* + multline* + align + flalign + alignat + align* + flalign* + alignat* + ) ;:or + (,tmtex-eqnarray 1) + ) ; + + (eq-number (,tmtex-default -1)) + (separating-space (,tmtex-hspace* 1)) + (application-space (,tmtex-hspace* 1)) + + ((:or code cpp-code mmx-code scm-code shell-code scilab-code verbatim-code) + (,tmtex-code-block 1) + ) ; + ((:or mmx cpp scm shell scilab) (,tmtex-code-inline 1)) + + (frame (,tmtex-frame 1)) + (colored-frame (,tmtex-colored-frame 2)) + (fcolorbox (,tmtex-fcolorbox 3)) + (rotate (,tmtex-rotate 2)) + (condensed (,tmtex-style-first 1)) + (translate (,tmtex-translate 3)) + (localize (,tmtex-localize 1)) + (render-key (,tmtex-render-key 1)) + (key (,tmtex-key 1)) + (key* (,tmtex-key* 1)) + (minipage (,tmtex-minipage 3)) + (latex_preview (,tmtex-mixed 2)) + (picture-mixed (,tmtex-mixed 2)) + (source-mixed (,tmtex-mixed 2)) + (listing (,tmtex-listing 1)) + (draw-over (,tmtex-make-eps 3)) + (draw-under (,tmtex-make-eps 3)) + (version-old (,tmtex-style-first 2)) + (version-both (,tmtex-style-second 2)) + (version-new (,tmtex-style-second 2)) + (the-index (,tmtex-theindex -1)) + (glossary (,tmtex-glossary 1)) + (glossary-explain (,tmtex-glossary 2)) + (glossary-2 (,tmtex-glossary-entry 3)) + (the-glossary (,tmtex-the-glossary 2)) + ((:or table-of-contents) (,tmtex-toc 2)) + (thebibliography (,tmtex-thebibliography 2)) + (bib-list (,tmtex-style-second 2)) + (bibitem* (,tmtex-bibitem* -1)) + ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2)) + (item (,tmtex-item 0)) + (item* (,tmtex-item-arg 1)) + (render-proof (,tmtex-render-proof 2)) + (nbsp (,tmtex-nbsp 0)) + (nbhyph (,tmtex-nbhyph 0)) + (hrule (,tmtex-hrule 0)) + (frac* (,tmtex-frac* 2)) + (hlink (,tmtex-hlink 2)) + (action (,tmtex-action -1)) + (href (,tmtex-href 1)) + (slink (,tmtex-href 1)) + (eqref (,tmtex-eqref 1)) + (smart-ref (,tmtex-smart-ref -1)) + (choose (,tmtex-choose 2)) + (tt (,tmtex-text-tt 1)) + ((:or strong em name samp abbr dfn kbd var acronym person) (,tmtex-modifier 1)) + (render-line-number (,tmtex-render-line-number 2)) + (menu (,tmtex-menu -1)) + (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0)) + (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0)) + (cite-website (,(tmtex-rename 'citewebsite) 0)) + (tm-made (,(tmtex-rename 'tmmade) 0)) + (cite (,tmtex-cite -1)) + (nocite (,tmtex-nocite -1)) + (cite-TeXmacs (,tmtex-cite-TeXmacs -1)) + (cite-detail (,tmtex-cite-detail-hook 2)) + (cite-raw (,tmtex-cite-raw -1)) + (cite-raw* (,tmtex-cite-raw* -1)) + (cite-textual (,tmtex-cite-textual -1)) + (cite-textual* (,tmtex-cite-textual* -1)) + (cite-parenthesized (,tmtex-cite-parenthesized -1)) + (cite-parenthesized* (,tmtex-cite-parenthesized* -1)) + (citet (,tmtex-cite-textual -1)) + (citet* (,tmtex-cite-textual* -1)) + (citep (,tmtex-cite-parenthesized -1)) + (citep* (,tmtex-cite-parenthesized* -1)) + (render-cite (,tmtex-render-cite 1)) + ((:or cite-author cite-author-link) (,tmtex-cite-author 1)) + ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1)) + ((:or cite-year cite-year-link) (,tmtex-cite-year 1)) + (natbib-triple (,tmtex-natbib-triple 3)) + (natexlab (,tmtex-noop -1)) + + ;; FIXME: we should do something more useful with this information + (set-header (,tmtex-noop -1)) + (set-footer (,tmtex-noop -1)) + (set-this-page-header (,tmtex-noop -1)) + (set-this-page-footer (,tmtex-noop -1)) +) ;logic-table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tags which are customized in particular style files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (tm-define (style-dependent-declare x) - (with (tag fun narg) x - (with fun+bis (symbol-append fun '+bis) + (with (tag fun narg) + x + (with fun+bis + (symbol-append fun '+bis) (if (== narg 2) `(begin - (when (not (defined? ',fun)) + (when (not (defined? (quote ,fun))) (tm-define (,fun s l) (tmtex-function (string->symbol s) l))) - (when (not (defined? ',fun+bis)) + (when (not (defined? (quote ,fun+bis))) (tm-define (,fun+bis s l) (,fun s l)))) `(begin - (when (not (defined? ',fun)) + (when (not (defined? (quote ,fun))) (tm-define (,fun t) (tmtex-function (string->symbol (car t)) (cdr t)))) - (when (not (defined? ',fun+bis)) + (when (not (defined? (quote ,fun+bis))) (tm-define (,fun+bis s l) - (,fun (append (list (string->symbol s)) l))))))))) + (,fun (append (list (string->symbol s)) l))))) + ) ;if + ) ;with + ) ;with +) ;tm-define (tm-define (style-dependent-transform x) - (with (tag fun narg) x - (with fun+bis (symbol-append fun '+bis) - `(,tag (,(list 'unquote fun+bis) -1))))) + (with (tag fun narg) + x + (with fun+bis (symbol-append fun '+bis) `(,tag + (,(list 'unquote fun+bis) ,-1))) + ) ;with +) ;tm-define (define-macro (tmtex-style-dependent . l) `(begin ,@(map style-dependent-declare l) - (logic-table tmtex-tmstyle% ,@(map style-dependent-transform l)))) + (logic-table tmtex-tmstyle% ,@(map style-dependent-transform l))) +) ;define-macro (tmtex-style-dependent ;; to be removed - (doc-data tmtex-doc-data 2) - (abstract-data tmtex-abstract-data 2) + (doc-data tmtex-doc-data 2) + (abstract-data tmtex-abstract-data 2) ;; abstract markup - (abstract tmtex-abstract 1) - (abstract-acm tmtex-abstract-acm 1) - (abstract-arxiv tmtex-abstract-arxiv 1) - (abstract-msc tmtex-abstract-msc 1) - (abstract-pacs tmtex-abstract-pacs 1) - (abstract-keywords tmtex-abstract-keywords 1) + (abstract tmtex-abstract 1) + (abstract-acm tmtex-abstract-acm 1) + (abstract-arxiv tmtex-abstract-arxiv 1) + (abstract-msc tmtex-abstract-msc 1) + (abstract-pacs tmtex-abstract-pacs 1) + (abstract-keywords tmtex-abstract-keywords 1) ;; metadata markup - (doc-title tmtex-doc-title 1) - (doc-running-title tmtex-doc-running-title 1) - (doc-subtitle tmtex-doc-subtitle 1) - (doc-note tmtex-doc-note 1) - (doc-misc tmtex-doc-misc 1) - (doc-date tmtex-doc-date 1) - (doc-running-author tmtex-doc-running-author 1) - (doc-author tmtex-doc-author 1) - (author-name tmtex-author-name 1) - (author-affiliation tmtex-author-affiliation 1) - (author-misc tmtex-author-misc 1) - (author-note tmtex-author-note 1) - (author-email tmtex-author-email 1) - (author-homepage tmtex-author-homepage 1) + (doc-title tmtex-doc-title 1) + (doc-running-title tmtex-doc-running-title 1) + (doc-subtitle tmtex-doc-subtitle 1) + (doc-note tmtex-doc-note 1) + (doc-misc tmtex-doc-misc 1) + (doc-date tmtex-doc-date 1) + (doc-running-author tmtex-doc-running-author 1) + (doc-author tmtex-doc-author 1) + (author-name tmtex-author-name 1) + (author-affiliation tmtex-author-affiliation 1) + (author-misc tmtex-author-misc 1) + (author-note tmtex-author-note 1) + (author-email tmtex-author-email 1) + (author-homepage tmtex-author-homepage 1) ;; references - (doc-subtitle-ref tmtex-doc-subtitle-ref 2) - (doc-date-ref tmtex-doc-date-ref 2) - (doc-note-ref tmtex-doc-note-ref 2) - (doc-misc-ref tmtex-doc-misc-ref 2) - (author-affiliation-ref tmtex-author-affiliation-ref 2) - (author-email-ref tmtex-author-email-ref 2) - (author-homepage-ref tmtex-author-homepage-ref 2) - (author-note-ref tmtex-author-note-ref 2) - (author-misc-ref tmtex-author-misc-ref 2) + (doc-subtitle-ref tmtex-doc-subtitle-ref 2) + (doc-date-ref tmtex-doc-date-ref 2) + (doc-note-ref tmtex-doc-note-ref 2) + (doc-misc-ref tmtex-doc-misc-ref 2) + (author-affiliation-ref tmtex-author-affiliation-ref 2) + (author-email-ref tmtex-author-email-ref 2) + (author-homepage-ref tmtex-author-homepage-ref 2) + (author-note-ref tmtex-author-note-ref 2) + (author-misc-ref tmtex-author-misc-ref 2) ;; labels - (doc-subtitle-label tmtex-doc-subtitle-label 2) - (doc-date-label tmtex-doc-date-label 2) - (doc-note-label tmtex-doc-note-label 2) - (doc-misc-label tmtex-doc-misc-label 2) + (doc-subtitle-label tmtex-doc-subtitle-label 2) + (doc-date-label tmtex-doc-date-label 2) + (doc-note-label tmtex-doc-note-label 2) + (doc-misc-label tmtex-doc-misc-label 2) (author-affiliation-label tmtex-author-affiliation-label 2) - (author-email-label tmtex-author-email-label 2) - (author-homepage-label tmtex-author-homepage-label 2) - (author-note-label tmtex-author-note-label 2) - (author-misc-label tmtex-author-misc-label 2) + (author-email-label tmtex-author-email-label 2) + (author-homepage-label tmtex-author-homepage-label 2) + (author-note-label tmtex-author-note-label 2) + (author-misc-label tmtex-author-misc-label 2) ;; misc ((:or equation equation*) tmtex-equation 2) - (bibliography tmtex-bib 4) - (elsevier-frontmatter tmtex-elsevier-frontmatter 2) - (conferenceinfo tmtex-acm-conferenceinfo 2) - (CopyrightYear tmtex-acm-copyright-year 2) - (slide tmtex-beamer-slide 2) - (tit tmtex-beamer-tit 2) - (crdata tmtex-acm-crdata 2)) + (bibliography tmtex-bib 4) + (elsevier-frontmatter tmtex-elsevier-frontmatter 2) + (conferenceinfo tmtex-acm-conferenceinfo 2) + (CopyrightYear tmtex-acm-copyright-year 2) + (slide tmtex-beamer-slide 2) + (tit tmtex-beamer-tit 2) + (crdata tmtex-acm-crdata 2) +) ;tmtex-style-dependent ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Protected tags ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (logic-group tmtex-protected% - a b c d i j k l o r t u v H L O P S - aa ae bf cr dh dj dp em fi ge gg ht if in it le lg ll lu lq mp mu - ne ng ni nu oe or pi pm rm rq sb sc sf sl sp ss th tt wd wp wr xi - AA AE DH DJ Im NG OE Pi Pr Re SS TH Xi) - -(logic-group tmtex-protected-symbol% - space) + a + b + c + d + i + j + k + l + o + r + t + u + v + H + L + O + P + S + aa + ae + bf + cr + dh + dj + dp + em + fi + ge + gg + ht + if + in + it + le + lg + ll + lu + lq + mp + mu + ne + ng + ni + nu + oe + or + pi + pm + rm + rq + sb + sc + sf + sl + sp + ss + th + tt + wd + wp + wr + xi + AA + AE + DH + DJ + Im + NG + OE + Pi + Pr + Re + SS + TH + Xi +) ;logic-group + +(logic-group tmtex-protected-symbol% space) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Expansion of all macros which are not recognized by LaTeX @@ -3431,81 +4696,171 @@ (define (user-definition? x) (or (and (func? x 'new-theorem 2) (string? (cadr x))) - (and (func? x 'assign 2) (string? (cadr x))))) + (and (func? x 'assign 2) (string? (cadr x))) + ) ;or +) ;define (define (collect-user-defs-sub t) (cond ((npair? t) (noop)) ((user-definition? t) - (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t)) - (else (for-each collect-user-defs-sub (cdr t))))) + (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t) + ) ; + (else (for-each collect-user-defs-sub (cdr t))) + ) ;cond +) ;define (define (collect-user-defs t) (set! tmtex-user-defs-table (make-ahash-table)) (collect-user-defs-sub (cons 'document (tmtex-filter-preamble t))) - (ahash-set->list tmtex-user-defs-table)) + (ahash-set->list tmtex-user-defs-table) +) ;define (define (as-string sym) - (with s (symbol->string sym) - (if (string-starts? s "begin-") - (substring s 6 (string-length s)) - s))) + (with s + (symbol->string sym) + (if (string-starts? s "begin-") (substring s 6 (string-length s)) s) + ) ;with +) ;define (define (logic-first-list name) (let* ((l1 (query (cons name '('first 'second)))) - (l2 (map (cut assoc-ref <> 'first) l1))) - (map as-string l2))) + (l2 (map (cut assoc-ref <> 'first) l1)) + ) ; + (map as-string l2) + ) ;let* +) ;define (define (collect-user-macros-in t h) (when (tm-compound? t) (when (tree-label-extension? (tm-label t)) - (ahash-set! h (symbol->string (tm-label t)) #t)) - (for-each (cut collect-user-macros-in <> h) (tm-children t)))) + (ahash-set! h (symbol->string (tm-label t)) #t) + ) ;when + (for-each (cut collect-user-macros-in <> h) (tm-children t)) + ) ;when +) ;define (define (collect-user-macros t) - (with h (make-ahash-table) - (collect-user-macros-in t h) - (ahash-set->list h))) + (with h (make-ahash-table) (collect-user-macros-in t h) (ahash-set->list h)) +) ;define (define (tmtex-env-macro name) - `(associate ,name (xmacro "x" (eval-args "x")))) + `(associate ,name (xmacro "x" (eval-args "x"))) +) ;define (define tmtex-always-expand ;; FIXME: find a cleaner way to handle these environments - (list "render-theorem" "render-remark" "render-exercise" "render-proof" - "algorithm" "algorithm*" "named-algorithm" "named-algorithm-old" - "specified-algorithm" "specified-algorithm*" - "named-specified-algorithm" "algorithm-body" "numbered" - - "short-item" "short-question" - "question-arabic" "question-alpha" "question-Alpha" - "question-roman" "question-Roman" "question-item" - "answer-arabic" "answer-alpha" "answer-Alpha" - "answer-roman" "answer-Roman" "answer-item" - - "gap" "gap-dots" "gap-underlined" "gap-box" - "gap-wide" "gap-dots-wide" "gap-underlined-wide" "gap-box-wide" - "gap-long" "gap-dots-long" "gap-underlined-long" "gap-box-long" - - "with-button-box" "with-button-box*" - "with-button-circle" "with-button-circle*" - "with-button-arabic" "with-button-alpha" "with-button-Alpha" - "with-button-roman" "with-button-Roman" - "mc-field" "mc-wide-field" "show-reply" "hide-reply" - "mc" "mc-monospaced" "mc-horizontal" "mc-vertical" - - "textual-table" "numeric-dot-table" - "calc-table" "calc-inert" "calc-input" "calc-output" "calc-ref" - "cell-inert" "cell-input" "cell-output" "cell-ref" - "cell-range" "cell-sum" "cell-plusses" "cell-commas" - - "tmdoc-title" "icon" "shortcut" "key" "prefix" - "menu" "render-menu" "submenu" "subsubmenu" "subsubsubmenu" - "markup" "tmstyle" "tmpackage" "tmdtd" "def-index" - "src-arg" "src-var" "scm-arg" "scm-args" - "descriptive-table" "tm-fragment" "framed-fragment" - "explain" "explain-synopsis" "explain-macro" - "small-envbox" "big-envbox" "small-focus" "big-focus" - "cursor" "math-cursor" "TeXmacs-version" "c++" "BibTeX")) + (list "render-theorem" + "render-remark" + "render-exercise" + "render-proof" + "algorithm" + "algorithm*" + "named-algorithm" + "named-algorithm-old" + "specified-algorithm" + "specified-algorithm*" + "named-specified-algorithm" + "algorithm-body" + "numbered" + + "short-item" + "short-question" + "question-arabic" + "question-alpha" + "question-Alpha" + "question-roman" + "question-Roman" + "question-item" + "answer-arabic" + "answer-alpha" + "answer-Alpha" + "answer-roman" + "answer-Roman" + "answer-item" + + "gap" + "gap-dots" + "gap-underlined" + "gap-box" + "gap-wide" + "gap-dots-wide" + "gap-underlined-wide" + "gap-box-wide" + "gap-long" + "gap-dots-long" + "gap-underlined-long" + "gap-box-long" + + "with-button-box" + "with-button-box*" + "with-button-circle" + "with-button-circle*" + "with-button-arabic" + "with-button-alpha" + "with-button-Alpha" + "with-button-roman" + "with-button-Roman" + "mc-field" + "mc-wide-field" + "show-reply" + "hide-reply" + "mc" + "mc-monospaced" + "mc-horizontal" + "mc-vertical" + + "textual-table" + "numeric-dot-table" + "calc-table" + "calc-inert" + "calc-input" + "calc-output" + "calc-ref" + "cell-inert" + "cell-input" + "cell-output" + "cell-ref" + "cell-range" + "cell-sum" + "cell-plusses" + "cell-commas" + + "tmdoc-title" + "icon" + "shortcut" + "key" + "prefix" + "menu" + "render-menu" + "submenu" + "subsubmenu" + "subsubsubmenu" + "markup" + "tmstyle" + "tmpackage" + "tmdtd" + "def-index" + "src-arg" + "src-var" + "scm-arg" + "scm-args" + "descriptive-table" + "tm-fragment" + "framed-fragment" + "explain" + "explain-synopsis" + "explain-macro" + "small-envbox" + "big-envbox" + "small-focus" + "big-focus" + "cursor" + "math-cursor" + "TeXmacs-version" + "c++" + "BibTeX" + ) ;list +) ;define (tm-define (tmtex-env-patch t l0) (let* ((st (tree->stree t)) @@ -3518,13 +4873,17 @@ (l6 (map as-string (collect-user-defs st))) (l7 (if (preference-on? "texmacs->latex:expand-user-macros") '() l6)) (l8 (list-difference (collect-user-macros st) - (list-union l0 l6 tmtex-always-expand))) + (list-union l0 l6 tmtex-always-expand) + ) ;list-difference + ) ;l8 (l9 (list-difference (list-union l1 l2 l5 l7 l8) l0)) - (l10 (list-filter l0 (lambda (s) (and (string? s) - (<= (string-length s) 2))))) + (l10 (list-filter l0 (lambda (s) (and (string? s) (<= (string-length s) 2))))) (l11 (list-difference l10 (list "tt" "em" "op"))) - (l12 (list-difference l9 l11))) - `(collection ,@(map tmtex-env-macro l12)))) + (l12 (list-difference l9 l11)) + ) ; + `(collection ,@(map tmtex-env-macro l12)) + ) ;let* +) ;tm-define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interface @@ -3534,48 +4893,65 @@ (cond ((not sty) (set! sty (list "article"))) ((string? sty) (set! sty (list sty))) ((func? sty 'tuple) (set! sty (cdr sty))) - ((null? sty) (set! sty '("article")))) - sty) + ((null? sty) (set! sty '("article"))) + ) ;cond + sty +) ;define (tm-define (tmtex-postprocess x) x) (tm-define (tmtex-postprocess-body x) x) (tm-define (texmacs->latex x opts) - ;;(display* "texmacs->latex [" opts "], " x "\n") + ;; (display* "texmacs->latex [" opts "], " x "\n") (if (tmfile? x) - (let* ((body (tmfile-extract x 'body)) - (style (tmtex-get-style (tmfile-extract x 'style))) - (main-style (or (tmtex-transform-style (car style)) "article")) - (lan (tmfile-language x)) - (init (tmfile-extract x 'initial)) - (att (tmfile-extract x 'attachments)) - (doc (list '!file body style lan init att - (url->string (get-texmacs-path))))) - (set! tmtex-cjk-document? - (in? lan '("chinese" "chineset" "japanese" "korean"))) - (latex-set-style main-style) - (latex-set-packages '()) - (latex-set-extra '()) - (set! tmtex-style (car style)) - (set! tmtex-packages (cdr style)) - (set! tmtex-languages (list lan)) - (set! tmtex-colors '()) - (set! tmtex-colormaps '()) - (import-tmtex-styles) - (tmtex-style-init body) - (set! doc (tmtex-style-preprocess doc)) - (with result (tmtex-postprocess (texmacs->latex doc opts)) - (set! tmtex-style "generic") - (set! tmtex-packages '()) - result)) - (let* ((x2 (tree->stree (tmtm-eqnumber->nonumber (stree->tree x)))) - (x3 (tmtm-match-brackets x2))) - (tmtex-initialize opts) - (with r (tmtex (tmpre-produce x3)) - (if tmtex-mathjax? - (set! r (latex-mathjax-pre r))) - (if (not tmtex-use-macros?) - (set! r (latex-expand-macros r))) - (if tmtex-mathjax? - (set! r (latex-mathjax r))) - r)))) + (let* ((body (tmfile-extract x 'body)) + (style (tmtex-get-style (tmfile-extract x 'style))) + (main-style (or (tmtex-transform-style (car style)) "article")) + (lan (tmfile-language x)) + (init (tmfile-extract x 'initial)) + (att (tmfile-extract x 'attachments)) + (doc (list '!file body style lan init att (url->string (get-texmacs-path)))) + ) ; + (set! tmtex-cjk-document? (in? lan '("chinese" + "chineset" + "japanese" + "korean"))) + (latex-set-style main-style) + (latex-set-packages '()) + (latex-set-extra '()) + (set! tmtex-style (car style)) + (set! tmtex-packages (cdr style)) + (set! tmtex-languages (list lan)) + (set! tmtex-colors '()) + (set! tmtex-colormaps '()) + (import-tmtex-styles) + (tmtex-style-init body) + (set! doc (tmtex-style-preprocess doc)) + (with result + (tmtex-postprocess (texmacs->latex doc opts)) + (set! tmtex-style "generic") + (set! tmtex-packages '()) + result + ) ;with + ) ;let* + (let* ((x2 (tree->stree (tmtm-eqnumber->nonumber (stree->tree x)))) + (x3 (tmtm-match-brackets x2)) + ) ; + (tmtex-initialize opts) + (set! tmtex-image-total (tmtex-count-images x3)) + (when (and (qt-gui?) (> tmtex-image-total 0)) + (latex-progress-start tmtex-image-total) + ) ;when + (with r + (tmtex (tmpre-produce x3)) + (if tmtex-mathjax? (set! r (latex-mathjax-pre r))) + (if (not tmtex-use-macros?) (set! r (latex-expand-macros r))) + (if tmtex-mathjax? (set! r (latex-mathjax r))) + (when (and (qt-gui?) (> tmtex-image-total 0)) + (latex-progress-end) + ) ;when + r + ) ;with + ) ;let* + ) ;if +) ;tm-define diff --git a/TeXmacs/tests/0624.scm b/TeXmacs/tests/0624.scm new file mode 100644 index 0000000000..1b80f6a90d --- /dev/null +++ b/TeXmacs/tests/0624.scm @@ -0,0 +1,206 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : 0624.scm +;; DESCRIPTION : Integration test for LaTeX export progress bar +;; COPYRIGHT : (C) 2026 Sisyphus +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(import (liii check)) + +(load "./TeXmacs/plugins/latex/progs/init-latex.scm") + +(check-set-mode! 'report-failed) + +;; Define tracking counters for spying on the progress bar API calls + +(define progress-start-count 0) + +(define progress-update-count 0) + +(define progress-end-count 0) + +(define (test-latex-progress-bar-integration) + (display "Verifying end-to-end LaTeX export progress bar integration...\n") + + ;; Reset counters + (set! progress-start-count 0) + (set! progress-update-count 0) + (set! progress-end-count 0) + + ;; Save original functions + (let ((orig-gui? qt-gui?) + (orig-start latex-progress-start) + (orig-update latex-progress-update) + (orig-end latex-progress-end) + ) ; + + ;; Override functions for testing + (set! qt-gui? (lambda () #t)) + (set! latex-progress-start + (lambda (total) + (set! progress-start-count total) + (display* "Spy: latex-progress-start: " total "\n") + ) ;lambda + ) ;set! + (set! latex-progress-update + (lambda (current) + (set! progress-update-count (+ progress-update-count 1)) + (display* "Spy: latex-progress-update: " current "\n") + ) ;lambda + ) ;set! + (set! latex-progress-end + (lambda () + (set! progress-end-count (+ progress-end-count 1)) + (display "Spy: latex-progress-end called\n") + ) ;lambda + ) ;set! + + ;; Export a document containing images to latex + (let* ((tmu-path "$TEXMACS_PATH/tests/tmu/0623_gnuplot_tuto.tmu") + (tmp-tex (url-temp)) + (dummy (load-buffer tmu-path)) + (dummy2 (buffer-export tmu-path tmp-tex "latex")) + ) ; + + (display* "DEBUG: tmp-tex exists? " (url-exists? tmp-tex) "\n") + + ;; Restore original functions + (set! qt-gui? orig-gui?) + (set! latex-progress-start orig-start) + (set! latex-progress-update orig-update) + (set! latex-progress-end orig-end) + + ;; Assert that the progress bar functions were indeed called! + (check (> progress-start-count 0) => #t) + (check (> progress-update-count 0) => #t) + (check (= progress-end-count 1) => #t) + (display "LaTeX progress bar integration verified successfully!\n") + ) ;let* + ) ;let +) ;define + +(define (test-quantum-latex-export) + (display "Verifying LaTeX export of quantum document...\n") + + ;; Reset counters + (set! progress-start-count 0) + (set! progress-update-count 0) + (set! progress-end-count 0) + + ;; Save original functions + (let ((orig-gui? qt-gui?) + (orig-start latex-progress-start) + (orig-update latex-progress-update) + (orig-end latex-progress-end) + ) ; + + ;; Override functions for testing + (set! qt-gui? (lambda () #t)) + (set! latex-progress-start + (lambda (total) + (set! progress-start-count total) + (display* "Spy: latex-progress-start: " total "\n") + ) ;lambda + ) ;set! + (set! latex-progress-update + (lambda (current) + (set! progress-update-count (+ progress-update-count 1)) + (display* "Spy: latex-progress-update: " current "\n") + ) ;lambda + ) ;set! + (set! latex-progress-end + (lambda () + (set! progress-end-count (+ progress-end-count 1)) + (display "Spy: latex-progress-end called\n") + ) ;lambda + ) ;set! + + ;; Export the quantum document to latex + (let* ((tmu-path "$TEXMACS_PATH/tests/tmu/0624_quantum.tmu") + (tmp-tex (url-temp)) + (dummy (load-buffer tmu-path)) + (dummy2 (buffer-export tmu-path tmp-tex "latex")) + (tex-content (string-load tmp-tex)) + ) ; + + (display* "DEBUG: tmp-tex exists? " (url-exists? tmp-tex) "\n") + + ;; Restore original functions + (set! qt-gui? orig-gui?) + (set! latex-progress-start orig-start) + (set! latex-progress-update orig-update) + (set! latex-progress-end orig-end) + + ;; Assert that the exported LaTeX file is not empty + (check (and (string? tex-content) (> (string-length tex-content) 0)) => #t) + + ;; Assert that the exported LaTeX file contains the required translations + (check (string-contains? tex-content "\\hbar") => #t) + (check (string-contains? tex-content "\\psi") => #t) + (check (string-contains? tex-content "\\langle") => #t) + (check (string-contains? tex-content "\\rangle") => #t) + (check (string-contains? tex-content "\\nabla") => #t) + + ;; Assert that tmtex-image-total is evaluated as greater than 0 + (check (> ((resolve-module '(convert latex tmtex)) 'tmtex-image-total) 0) => #t) + + ;; Assert that progress bar functions were triggered + (check (> progress-start-count 0) => #t) + (check (> progress-update-count 0) => #t) + (check (= progress-end-count 1) => #t) + + (display "Quantum LaTeX export verified successfully!\n") + ) ;let* + ) ;let +) ;define + +(define (test-progress-bar-boundary-safety) + (display "Verifying progress bar boundary safety on C++ side...\n") + + ;; 1. Calling (latex-progress-start 0) works safely without division-by-zero crashes on the C++ side. + (latex-progress-start 0) + (latex-progress-update 5) + (latex-progress-end) + (check #t => #t) + + ;; 2. Calling (latex-progress-start -5) works safely. + (latex-progress-start -5) + (latex-progress-update 5) + (latex-progress-end) + (check #t => #t) + + ;; 3. Calling (latex-progress-update -5) or (latex-progress-update 150) with values outside the total range is handled safely and gracefully. + (latex-progress-start 100) + (latex-progress-update -5) + (latex-progress-update 150) + (latex-progress-end) + (check #t => #t) + + ;; 4. Doing multiple sequential starts and ends (resetting flow) resets the internal state cleanly every time. + (latex-progress-start 10) + (latex-progress-update 2) + (latex-progress-start 20) + (latex-progress-update 5) + (latex-progress-end) + (latex-progress-end) + (check #t => #t) + + ;; 5. Calling (latex-progress-update 5) without start works safely. + (latex-progress-update 5) + (check #t => #t) + + (display "Progress bar boundary safety verified successfully!\n") +) ;define + +(tm-define (test_0624) + (display "Running test_0624...\n") + (test-latex-progress-bar-integration) + (test-quantum-latex-export) + (test-progress-bar-boundary-safety) + (check-report) +) ;tm-define diff --git a/TeXmacs/tests/tmu/0624_quantum.tmu b/TeXmacs/tests/tmu/0624_quantum.tmu new file mode 100644 index 0000000000..6e6d01c221 --- /dev/null +++ b/TeXmacs/tests/tmu/0624_quantum.tmu @@ -0,0 +1,335 @@ +> + +> + +<\body> + > + + <\framed> + + + <\equation*> + H=-|2 m>\-\> + + + > Bohr energy + + <\equation*> + E=->eV + + + + Hierarchy Bohr + + ||||||||||MC>>>||MC>>>||MC>>>||>|)>\>MC>>>>>>|> + + Fine structure = (spinless) relativistic + spin-orbit coupling\ + + <\problem*> + (6.11) Express Bohr energy in terms of > and > + + Page 149 Eq[4.70] + + <\equation*> + E=->|4\\>|)>|]>>=-|2>|4\\\C>|)>>=-MC\> + + + + + + In QM, Kinetic energy |2m>\-|>\>, where >=-\\|\>>, >|^>e>\>/\>> + + \; + + Relativistic kinetic energy + + <\equation*> + T=||)>>>-m c,p=|)>>> + + + Note that\ + + <\equation*> + pc+mc=vc|1-|)>>+mc=vc+mc|)>|)>|1-|)>> + + + gives us + + <\equation*> + T=c+mc>-m c=m c>|)>>-1|)>. + + + By Taylor expansion + + <\align> + |>|)>->|)>+\-1|]>>>|||2m >|\>>-|8mc>+\.>>>> + + + Therefore, + + <\equation*> + H=-|8mc>=|2 m>|)>|2m c>\-|10eV> + + + + + <\equation> + E>\|\\|H\|\|\> + + + l=0,m=0> + + l=0,1,m=0,\1> \ Degenerate case. + + <\question> + Why the non-degenerate correction can be used in hydrogen atom? + + + To answer Question, we prove the following theorem: + + <\theorem> + Given Hermitian operator > and ,H>|]>=0>, ,H|]>=0>. If >> and >> are the eigenstate of > with distinct eigenstates + + <\equation*> + \>=\\>,\>=\\>,and\\\ + + + then\ + + <\equation*> + |\>\|H\|\>|\>=0. + + + + <\proof> + Note that + + <\equation*> + ,H|]>=0\|\>\|,H|]>\|\>|\>=0 + + + which implies + + <\equation*> + |\>\|H\|\>|\>-|\>\|H\|\>|\>=0. + + + Therefore, + + <\equation*> + -\|)>|\>\|H\|\>|\>=0. + + + The proof is finished by the fact that -\\0>. + + + In the present case, + + <\equation*> + \L,L,H\p,H>=-|2 m>\-|4\\>. + + + We need + + <\equation*> + >,L|]>=0,>,L|]>=0. + + + This is known because >,L> and > share > as eigenstate. + + Also, we need + + <\equation> + ,L|]>=0,,L|]>=0. + + + To show Eq. holds, we note that + + <\equation*> + =A+B> + + + which implies + + <\equation*> + ,L|]>=p,L|]>+,L|]>p. + + + In page 167 Problem 4.19 (c), we proved ,L|]>=0>. + + + + <\align> + ,p|]>=>|,p|]>+,p|]>+,p|]>>>>> + + + where + + <\equation*> + L=x p-y p\>=>\>. + + + The last term ,p|]>> vanishes by definition of >. Thus, + + <\equation*> + ,p|]>=,p|]>p+p,p|]>+,p|]>p+p,p|]> + + + where + + <\equation*> + ,p|]>=,p|]>-,p|]>,and,p|]>=0 + + + and + + <\equation*> + ,p|]>=x,p|]>+|]>p=\\p. + + + Thus, + + <\equation*> + ,p|]>=0 + + + For >, >, >, > are equivalent. Similarly, =L+L+L>, we have ,p|]>=0>. Finally, Question is answered! + + Now, we evaluate |\\|H\|\|\>> + + >=2 m-|)>>\> + + <\equation*> + |p\\|p\|\>=|\\|-|)>\|\|\> + + + which imples + + <\equation*> + E>=-c>-2E|V|\>+|V|\>|)>, + + + where + + <\equation*> + |V|\>\|\\|\|\|\> + + + and + + <\equation*> + |V|\>\|\\|\|\|\>. + + + For Hydrogen atom, |4\\>> we evaluate |V|\>> by using Eq.[3.97]: Stationary vivid theorem in 1D + + <\equation*> + 2|T|\>=|xV|\x>|\> + + + In 3D: + + <\equation*> + 2|T|\>=|>\\V|\>.>\ + + + Because >|)>> has the spherical symmetry, so we use spherical coordinates + + <\equation*> + \V>|)>=-|4\\>|\r>|)>+|^>\+|^>\ + + + Thus, + + <\equation*> + 2|T|\>=|>\\V|\>=|4\\>|>>\|\>=|\>|\>=-|V|\>. + + + Note that + + <\equation*> + |T|\>+|V|\>=E. + + + Therefore, + + <\equation*> + |T|\>=-E>>||V|\>=2E>>||V|\>=|4\\>|)>|>|\>=+|)>na>>>>>>. + + + <\remark> + For hydrogen atom, |T|\>=-|V|\>>. For Harmonic oscillator |T|\>=|V|\>>. The result of the var vivid theorem is case by case, depend on >|)>>.\ + + + Finally, + + <\equation*> + E>=->-2E|)>+|4\\>+|)>na>|]>. + + + <\framed> + Express Bohr energy > in terms of Bohr radius. Bohr radius + + <\equation*> + a\\\|m> + + + [4.72]\ + + <\equation*> + E=|n>,E\->|4\\>|)> + + + <\equation*> + ||\>=>\|V|\>=2E=-|4\\>||\> + + + Therefore, + + <\equation*> + E=|4\\>>|\>>=|2m>>>|\>>. + + + <\align> + >=>|>+E+>|]>>>|||2 m c>+>|)>|>10E.>>>> + + + <\equation*> + E>=E+E>=->eV+|2 m c>+>|)> + + + + +<\initial> + <\collection> + + + + + +<\references> + <\collection> + > + > + > + > + > + > + > + + + +<\auxiliary> + <\collection> + <\associate|table> + |1>||>|> + + <\associate|toc> + |Recap Chapter 4.2 Hydrogen Atom |.>>>>|> > + + |math-font-series||1Spinless Relativistic Correction> |.>>>>|> + + |Recap |.>>>>|> > + + + diff --git a/devel/0624.md b/devel/0624.md new file mode 100644 index 0000000000..8c107a043c --- /dev/null +++ b/devel/0624.md @@ -0,0 +1,59 @@ +# [0624] 为 LaTeX 导出添加基于 Qt QProgressBar 的弹窗进度条支持，并实现平滑动画更新 + +Mogan 在导出包含大量图片（如数学公式、Gnuplot 绘图、图形剪裁等）的文档为 LaTeX 时，会逐一执行图片转换并渲染产生外部独立的 `.pdf` / `.eps` 等格式。当图片较多时，该导出过程需要一定的时间。 + +本项目参照 [0623.md](0623.md) 在 HTML 导出中的进度条实践，为 LaTeX 导出实现了完全自包含、美观且极具动感的 Qt QProgressBar 弹窗进度条。进度条实现了精美的插值微休眠平滑滑行动画（10% 级细粒度），消除了界面假死与视觉生硬感。同时对底层进行严密强隔离设计：进度条仅在 GUI 模式下启用，当从命令行、测试框架或 headless 模式下调用 tmu -> latex 时，保持 100% 绝对静默与安全。 + +## 1 相关文档 +- [0623.md](0623.md) - 参考的 HTML 进度条任务文档 + +## 2 任务相关的代码文件 +- `src/Plugins/Tex/tex.hpp` +- `src/Plugins/Tex/inittex.cpp` +- `src/Scheme/Plugins/glue_tex.lua` +- `TeXmacs/plugins/latex/progs/convert/latex/tmtex.scm` +- `TeXmacs/progs/convert/latex/tmtex.scm` +- `TeXmacs/tests/0624.scm` +- `TeXmacs/tests/tmu/0624_quantum.tmu` + +## 3 如何测试 + +### 3.1 确定性测试（集成测试） +运行新编写的 TDD 自动化集成测试，验证 LaTeX 导出在重度图片任务（如 Gnuplot 绘图）和真实复杂的量子 Notes 导出中，进度条各个阶段被正确触发，以及核心数学与算符在 LaTeX 下的精准转译： +```bash +xmake r 0624 +``` + +### 3.2 非确定性测试（文档验证） +1. 在 Mogan 中打开随 PR 提供的真实量子 Notes 测试用例 `TeXmacs/tests/tmu/0624_quantum.tmu`。 +2. 导出为 LaTeX，验证 GUI 界面居中弹出一个精美的带有取消按钮的 LaTeX 导出进度框，进度条伴随着每一个物理段落、表格、标题和公式的转译处理呈 10% 级极具动感的平滑滑行更新（即使没有任何外部图片转换）。 +3. 在命令行下直接运行 `-headless` 转换或测试，验证绝对静默、不出现任何弹窗且 100% 无崩溃： + ```bash + xmake r stem -headless -c TeXmacs/tests/tmu/0624_quantum.tmu /tmp/quantum.tex -q + ``` + +## 4 如何提交 + +提交前执行以下最少步骤： +1. 运行确定性测试，确保输出 `*** checks *** : 18 correct, 0 failed.`： + ```bash + xmake r 0624 + ``` + +## 5 What +1. **高内聚的 LaTeX 进度条实现**：完全在 TeX 插件内部（C++ 的 `src/Plugins/Tex/` 与 Scheme 的 `convert/latex/tmtex.scm`）进行开发，不染指、不修改任何不相关的外部插件（如 HTML 插件、PDF 插件等）的代码。 +2. **GUI 专属的 Qt 弹窗进度条**：在 LaTeX 导出过程中，为 GUI 环境增加基于自定义 `QDialog` 的弹窗进度条。在 C++ 侧，自定义 `QDialog` 采用 `QVBoxLayout` 与 `QHBoxLayout` 布局，包含 `QLabel`、`QProgressBar` 和 `QPushButton`（取消按钮），通过 QSS 样式表锁定外框颜色（`border: 1px solid grey;`），并在 `latex_progress_start` 中引入 `QThread::msleep(50)` 线程休眠，配合 `QCoreApplication::processEvents()` 强制刷新，彻底解决了 macOS 等平台下进度条重绘假死的缺陷。 +3. **命令行强隔离静默设计**：若在命令行或 headless 状态下调用 tmu -> latex 导出时，通过 `QApplication::instance()` 与 `qobject_cast` 严密防护，不展示任何进度条或弹窗，确保 100% 绝对静默、免崩溃安全运行。 +4. **引入百分比插值平滑动画**：进度条范围锁定为 `0-100`，并引入了基于 `(target - prev) / 10` 的百分比插值平滑动画机制，通过 15ms 的微休眠（`QThread::msleep(15)`）和强制重绘，将原本离散、生硬突跳的进度更新重构为 10% 级极佳细粒度的平滑滑行动画，彻底解决视觉生硬问题。 +5. **引入专属进度计数器 `tmtex-image-progress` 与多元素进度推演**：将原本用于生成图片文件名的 `tmtex-serial` 序号与进度条更新逻辑彻底解耦，引入专属、精确递增的 `tmtex-image-progress` 计数器。同时，将进度条解析器 `tmtex-count-images` 与更新钩子扩展到**所有主要物理和结构元素**（包括：段落 `para`、表格 `table`/`tformat`、公式与方程组 `equation`/`eqnarray`/`equation*`/`eqnarray*`、章节标题 `section`/`subsection`/`subsubsection` 以及各类图像 `image`/`graphics` 等），使得**即使导出完全不含图片的纯文本笔记，也能拥有完整展示排版精细进度、流畅步进的进度条动画**，彻底解决无图文档不弹进度条的缺陷。 +6. **真实的量子 Notes 导出转译与进度条双重验证**：引入了真实的物理笔记文档 `0624_quantum.tmu`，编写了专属的 `test-quantum-latex-export` 单元测试。该测试全自动运行 LaTeX 导出并载入转译结果，利用严格的断言验证物理数学算符（如 `\hbar`（普朗克常数）、`\psi`（波函数）、`\langle` 与 `\rangle`（狄拉克算符）、`\nabla`（哈密顿梯度算符））被 100% 精确转译。同时，测试对新引入的多元素进度机制进行验证，断言其在导出该纯文本笔记时完美触发了进度开始、多阶段递增与进度完成。 +7. **全面的弹窗内存泄漏防护与边界鲁棒性**：在 `inittex.cpp` 层的 `latex_progress_start` 方法中加入了极高密度的安全性判断。在初始化新弹窗前，会自动检查上一次是否由于用户主动取消或重复调用而存在未被析构的进度窗口，若存在则自动安全关闭并 delete，彻底消除潜在的内存泄漏风险。同时，编写了 `test-progress-bar-boundary-safety` 鲁棒性测试，直接对 `(latex-progress-start 0)`、`-5` 及超界百分比进行极限边界压力测试，确保 C++ 端绝对 100% 零崩溃、零假死运行。 + +## 6 Why +- **多图导出的性能体验**：在 LaTeX 导出多图（例如含有 Gnuplot 或复杂绘图公式的文档）时，计算和转换通常需要耗费数秒或十几秒，如果没有进度条提示，用户无法得知当前系统是正在全力导出还是发生了卡死，而添加进度条则能极大地提升产品体验与品质。 +- **命令行与 GUI 隔离**：Mogan 会经常被用于无界面的 headless 导出、测试或者持续集成（CI）。如果在 Scheme 侧或 C++ 侧强行弹出 `QDialog` 或实例化 QWidget，不仅会让 CLI 运行环境大打折扣，更会由于 Qt QGuiApplication 缺失而直接引发 `SIGABRT` 崩溃。所以必须在 C++ 侧对 `QApplication::instance()` 进行健全的类型和非空判断，提供强隔离防护。 + +## 7 How +1. **胶水层暴露 API**：在 `src/Scheme/Plugins/glue_tex.lua` 中声明 `latex-progress-start`、`latex-progress-update` 与 `latex-progress-end` 的绑定关系，并在 `tex.hpp` / `inittex.cpp` 中定义并实现其 Qt GUI 和 Headless 隔离逻辑。 +2. **精细的元素节点解析与计数**：在 `tmtex.scm` 中定义 `tmtex-count-images`，采用递归深度遍历，不仅精准判定图片、更兼顾段落、表格、公式、方程组与章节标题。并在 `texmacs->latex` 的开始与结束阶段，利用 `(latex-progress-start)` 与 `(latex-progress-end)` 分别声明进度状态生命周期。 +3. **多入口双端统一更新**：在 `tmtex-eps` / `tmtex-as-eps`（图片生成入口），以及 `tmtex-para`（段落）、`tmtex-table`（表格）、`tmtex-sectional`（章节）、`tmtex-equation`/`tmtex-eqnarray`（公式方程组）等关键结构变换入口，切入 `(tmtex-image-increment)` 计数累加器，确保每次翻译大段内容或处理结构时进度条数值被精确推动和步进渲染。 diff --git a/src/Plugins/Tex/inittex.cpp b/src/Plugins/Tex/inittex.cpp index 2d38e94ec5..2099733a43 100644 --- a/src/Plugins/Tex/inittex.cpp +++ b/src/Plugins/Tex/inittex.cpp @@ -66,3 +66,113 @@ latex_arity (string s) { if (command_arity->contains (s)) return command_arity[s]; else return latex_std_arity[s]; } + +#ifdef QTTEXMACS +#include +#include +#include +#include +#include +#include +#include +#include + +static QDialog* latex_progress_dialog= nullptr; +static int latex_progress_total = 0; +#endif + +void +latex_progress_start (int total) { +#ifdef QTTEXMACS + if (QApplication::instance () && + qobject_cast (QApplication::instance ())) { + if (latex_progress_dialog) { + latex_progress_dialog->close (); + delete latex_progress_dialog; + latex_progress_dialog= nullptr; + } + QWidget* main_window= QApplication::activeWindow (); + latex_progress_total= total; + + QDialog* dlg= new QDialog (main_window, Qt::Sheet); + dlg->setWindowTitle ("LaTeX Export"); + dlg->setMinimumWidth (400); + dlg->setWindowModality (Qt::WindowModal); + + QVBoxLayout* layout= new QVBoxLayout (dlg); + QLabel* label = new QLabel ("Exporting LaTeX...", dlg); + label->setAlignment (Qt::AlignCenter); + layout->addWidget (label); + + QProgressBar* bar= new QProgressBar (dlg); + bar->setRange (0, 100); + bar->setValue (0); + bar->setTextVisible (true); + bar->setMinimumHeight (20); + bar->setStyleSheet ("QProgressBar { border: 1px solid grey; border-radius: " + "5px; text-align: center; background-color: #f0f0f0; } " + "QProgressBar::chunk { background-color: #3498db; }"); + layout->addWidget (bar); + + QHBoxLayout* btnLayout= new QHBoxLayout (); + QPushButton* btn = new QPushButton ("Cancel", dlg); + btnLayout->addStretch (); + btnLayout->addWidget (btn); + layout->addLayout (btnLayout); + + QObject::connect (btn, &QPushButton::clicked, dlg, &QDialog::reject); + + dlg->show (); + dlg->repaint (); + QCoreApplication::processEvents (); + QThread::msleep (50); // 给 Qt 50ms 充分的时间完成第一帧渲染 + + latex_progress_dialog= dlg; + } +#else + (void) total; +#endif +} + +void +latex_progress_update (int current) { +#ifdef QTTEXMACS + if (latex_progress_dialog) { + QProgressBar* bar= latex_progress_dialog->findChild (); + if (bar) { + int target= 100; + if (latex_progress_total > 0) { + target= (current * 100) / latex_progress_total; + } + int prev= bar->value (); + if (target > prev) { + int step= (target - prev) / 10; + if (step < 1) step= 1; + for (int val= prev + step; val <= target; val+= step) { + bar->setValue (val); + bar->repaint (); + QCoreApplication::processEvents (); + QThread::msleep (15); + } + } + bar->setValue (target); + bar->repaint (); + } + latex_progress_dialog->repaint (); + QCoreApplication::processEvents (); + } +#else + (void) current; +#endif +} + +void +latex_progress_end () { +#ifdef QTTEXMACS + if (latex_progress_dialog) { + latex_progress_dialog->close (); + delete latex_progress_dialog; + latex_progress_dialog= nullptr; + } +#endif +} diff --git a/src/Plugins/Tex/tex.hpp b/src/Plugins/Tex/tex.hpp index d4152fa49d..59dd3c22ec 100644 --- a/src/Plugins/Tex/tex.hpp +++ b/src/Plugins/Tex/tex.hpp @@ -34,4 +34,8 @@ tree conservative_latex_to_texmacs (string s, bool as_pic); int number_latex_pages (url log); tree postprocess_metadata (tree t); +void latex_progress_start (int total); +void latex_progress_update (int current); +void latex_progress_end (); + #endif diff --git a/src/Scheme/Plugins/glue_tex.lua b/src/Scheme/Plugins/glue_tex.lua index ab4761793c..62f3f89526 100644 --- a/src/Scheme/Plugins/glue_tex.lua +++ b/src/Scheme/Plugins/glue_tex.lua @@ -100,6 +100,27 @@ function main() "url" } }, + { + scm_name = "latex-progress-start", + cpp_name = "latex_progress_start", + ret_type = "void", + arg_list = { + "int" + } + }, + { + scm_name = "latex-progress-update", + cpp_name = "latex_progress_update", + ret_type = "void", + arg_list = { + "int" + } + }, + { + scm_name = "latex-progress-end", + cpp_name = "latex_progress_end", + ret_type = "void" + }, } } end