
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MODULE      : tmtex.scm
;; DESCRIPTION : conversion of TeXmacs trees into TeX/LaTeX trees
;; COPYRIGHT   : (C) 2002  Joris van der Hoeven
;;
;; 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 <http://www.gnu.org/licenses/gpl-3.0.html>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(texmacs-module (convert latex tmtex)
  (:use (convert tools tmpre)
	(convert tools old-tmtable)
	(convert tools tmlength)
	(convert rewrite tmtm-brackets)
	(convert latex texout)
	(convert latex latex-tools)))

(use-modules (ice-9 format))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tm-define tmtex-style "generic")
(tm-define tmtex-packages '())
(tm-define tmtex-provided-packages '())
(tm-define tmtex-replace-style? #t)
(define tmtex-src (make-ahash-table))
(define tmtex-env (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)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Style
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(texmacs-modes
  (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-style%           (in? tmtex-style '("acmconf" "sig-alternate")))
  (sig-alternate-style% (in? tmtex-style '("sig-alternate")) acm-style%)
  (ams-style%           (in? tmtex-style '("amsart")))
  (revtex-style%        (in? tmtex-style '("aip" "aps")))
  (aip-style%           (in? tmtex-style '("aip")) revtex-style%)
  (aps-style%           (in? tmtex-style '("aps")) revtex-style%)
  (springer-style%      (in? tmtex-style '("svjour" "llncs")))
  (svjour-style%        (in? tmtex-style '("svjour")) springer-style%)
  (llncs-style%         (in? tmtex-style '("llncs"))  springer-style%)
  (svmono-style%        (in? tmtex-style '("svmono")))
  (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%)
  (beamer-style%        (in? tmtex-style '("beamer")))
  (natbib-package%      (in? "cite-author-year" tmtex-packages)))

(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)))
        ((or (springer-style?) (svmono-style?))
         (import-from (convert latex tmtex-springer)))
         (else (noop))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialization from options
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-initialize opts)
  (set! tmtex-ref-cnt 1)
  (set! tmtex-env (make-ahash-table))
  (set! tmtex-dynamic (make-ahash-table))
  (set! tmtex-serial 0)
  (set! tmtex-auto-produce 0)
  (set! tmtex-auto-consume 0)
  (if (== (url-suffix current-save-target) "tex")
      (begin
	(set! tmtex-image-root-url (url-unglue current-save-target 4))
	(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")))
  (set! tmtex-appendices? #f)
  (set! tmtex-replace-style?
    (== (assoc-ref opts "texmacs->latex:replace-style") "on"))
  (set! tmtex-indirect-bib?
    (== (assoc-ref opts "texmacs->latex:indirect-bib") "on"))
  (set! tmtex-use-macros?
    (== (assoc-ref opts "texmacs->latex:use-macros") "on"))
  (set! tmtex-use-unicode?
    (== (assoc-ref opts "texmacs->latex:encoding") "utf-8"))
  (set! tmtex-use-catcodes? 
    (== (assoc-ref opts "texmacs->latex:encoding") "cork"))
  (set! tmtex-use-ascii? 
    (== (assoc-ref opts "texmacs->latex:encoding") "ascii")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(logic-table tmtex-table-props%
  (block ("" "l" "" #t))
  (block* ("" "c" "" #t))
  (tabular ("" "l" "" #f))
  (tabular* ("" "c" "" #f))
  (matrix ((,(string->symbol "left(")) "c" (,(string->symbol "right)")) #f))
  (det ((left|) "c" (right|) #f))
  (stack ("" "c" "" #f))
  (choice ((left\{) "l" (right.) #f)))

(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)
  (("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)
  (("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 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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Manipulation of the environment
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-env-list var)
  (let ((r (ahash-ref tmtex-env var)))
    (if r r '())))

(define (tmtex-env-get var)
  (let ((val (tmtex-env-list var)))
    (if (null? val) #f
	(car val))))

(define (tmtex-env-get-previous var)
  (let ((val (tmtex-env-list var)))
    (if (or (null? val) (null? (cdr val))) #f
	(cadr val))))

(define (tmtex-math-mode?)
  (== (tmtex-env-get "mode") "math"))

(tm-define (tmtex-env-set var val)
  (ahash-set! tmtex-env var (cons val (tmtex-env-list var))))

(tm-define (tmtex-env-reset var)
  (let ((val (tmtex-env-list var)))
    (if (nnull? val)
	(ahash-set! tmtex-env var (cdr val)))))

(tm-define (tmtex-env-assign var val)
  (tmtex-env-reset var)
  (tmtex-env-set var val))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Frequently used TeX construction subroutines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tm-define (tmtex-concat-sep l)
  (set! l (list-intersperse l '(!concat (tmsep) " ")))
  (if (null? l) '() `((!concat ,@l))))

(tm-define (tmtex-concat-Sep l)
  (set! l (list-intersperse l '(!concat (tmSep) " ")))
  (if (null? l) '() `((!concat ,@l))))

(define (tex-concat-similar l)
  (if (or (null? l) (null? (cdr l))) l
      (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))))))

(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))))))

(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)))))

(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))))))

(tm-define (tex-concat* l)
  (:synopsis "Variant of tex-concat which concatenates adjacent strings")
  (tex-concat (tex-concat-strings l)))

(define tex-apply
  (lambda l
    (if (or (tmtex-math-mode?) (logic-in? (car l) tmpre-sectional%)) l
	(list '!group l))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Strings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (string-starts? s r)
  (and (>= (string-length s) (string-length r))
       (== (substring s 0 (string-length r)) r)))

(define (tmtex-modified-token op s i)
  (tex-apply op
   (if (= (string-length s) (+ i 1))
       (substring s i (string-length s))
       (tex-apply (string->symbol (substring s i (string-length s)))))))

(define (tmtex-token-sub s group?)
  (cond ((== s "less") #\<)
	((== s "gtr") #\>)
	((== s "box") (list 'Box))
	((== s "||") (list '|))
	((string-starts? s "cal-") (tmtex-modified-token 'mathcal s 4))
	((string-starts? s "frak-") (tmtex-modified-token 'mathfrak s 5))
	((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4))
	((string-starts? s "b-cal-")
	 (tex-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 (string-starts? s "#") (not tmtex-use-catcodes?)) 
	 	(let* ((qs (string-append "<" s ">"))
		       (cv (string-convert qs "Cork" "UTF-8")))
		   (list '!widechar (string->symbol cv))))
	((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 ((ss (list (string->symbol s))))
		(cond ((not (logic-in? (car ss) latex-symbol%))
		       (display* "TeXmacs] non converted symbol: " s "\n")
		       "")
		      (group? (list '!group ss))
		      (else (list '!symbol ss)))))))

(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))))

(define (tmtex-text-sub head l)
  (append (string->list head) (tmtex-text-list (cdr l))))

(define (tmtex-special-char? c)
  (string-index "#$%&_{}" c))

(define (tmtex-break-char? c)
  (string-index "+ -:=,?;()[]{}<>/" c))

(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))))

(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 #\21) (tmtex-text-sub "''" l))
	      ((== c #\22) (tmtex-text-sub ",," l))
	      ((== c #\25) (tmtex-text-sub "--" l))
	      ((== c #\26) (tmtex-text-sub "---" l))
	      (else 
		(cons
		  (if (or tmtex-use-unicode? tmtex-use-ascii?)
		    (list (string-convert (char->string c) "Cork" "UTF-8")) c)
		    (tmtex-text-list (cdr l))))))))

(define (tmtex-math-operator l)
  (receive (p q) (list-break l (lambda (c) (not (char-alphabetic? c))))
    (let* ((op (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 (tex-apply 'tmop op) tail)))))

(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 #\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?)
                    (list (string-convert (char->string c) "Cork" "UTF-8")) c)
                  (cons c (tmtex-math-list (cdr l)))))))))

(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)))))))
            
(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))))))

(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)))))))

(define (tmtex-string 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)))

(define (string-convert* what from to)
  (with c (string->list what)
    (apply string-append
           (map (lambda (x) (string-convert (char->string x) from to)) c))))

(define (tmtex-verb-string s)
  (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)))
    (tex-concat r)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entire files
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tm-define (tmtex-transform-style x)
  (cond ((in? x '("article" "book" "letter")) x)
	((in? x '("generic" "exam")) "article")
	((== x "seminar") "slides")
	((in? x '("tmarticle" "tmdoc" "mmxdoc")) "article")
	((in? x '("tmbook" "tmmanual")) "book")
	((in? x '("svjour")) "article")
	((not tmtex-replace-style?) x)
	(else #f)))

(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))))

(define (macro-definition? x)
  (and (func? x 'assign 2)
       (string? (cadr x))
       (func? (caddr x) 'macro)))

(define (tmtex-filter-preamble l)
  (cond ((or (nlist? l) (null? l)) '())
	((macro-definition? l) (list l))
	((== (car l) 'hide-preamble) (cdadr l))
	(else (append-map tmtex-filter-preamble (cdr l)))))

(define (tmtex-filter-body l)
  (cond ((or (nlist? l) (null? l)) l)
	((== (car l) 'assign) "")
	((== (car l) 'hide-preamble) "")
	(else (cons (car l) (map tmtex-filter-body (cdr l))))))

(define (tmtex-apply-init body init)
  ;;(display* "init= " init "\n")
  (cond ((== (assoc-ref init "language") "verbatim")
	 (with init* (assoc-remove! init "language")
	   (tmtex-apply-init `(verbatim ,body) init*)))
	(else body)))

(define (make-tree-src-hash t)
  (let* ((col (if (and (list>0? t) (list? (cdr t))) (cdr t) '()))
         (col (filter (lambda (x)
                        (and (func? x 'associate)
                             (func? (cAr x) 'latex-tree-src))) col))
         (l   (map (lambda (x)
                     (let ((key  (second (cAr x)))
                           (val (third  (cAr x))))
                       (list key val))) col)))
    (for-each (lambda (x) (ahash-set! tmtex-src (car x) (cdr x))) l)
    ;; (display* (ahash-table->list tmtex-src) "\n\n")
    tmtex-src))

(define (tmtex-file l)
  (let* ((doc (car l))
	 (styles (cadr l))
	 (lang (caddr l))
	 (init (or (cadddr l) '(collection)))
	 (init-bis (if (list>1? init)
                     (map (lambda (x) (cons (cadr x) (caddr x))) (cdr init))
                     '()))
         (att (or (cadddr (cdr l)) '()))
	 (doc-preamble (tmtex-filter-preamble doc))
	 (doc-body-pre (tmtex-filter-body doc))
	 (doc-body (tmtex-apply-init doc-body-pre init-bis)))
    (if (== (get-preference "texmacs->latex:expand-user-macros") "on")
	(set! doc-preamble '()))
    (set! tmtex-src (make-ahash-table))
    (if (and
          (== (get-preference "latex->texmacs:preserve-source") "on")
          (nnull? att))
      (begin
        (make-tree-src-hash att)
        ;... TODO : the preamble and end of the document are critical !
        ))
    (if (null? styles) (tmtex doc)
	(let* ((styles* (tmtex-filter-styles styles))
	       (preamble* (ahash-with tmtex-env :preamble #t
			    (map-in-order tmtex doc-preamble)))
               (body* (tmtex doc-body)))
	  (list '!file body* styles* lang init preamble*)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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-second l) (tmtex (cadr l)))
(define (tmtex-hide-part s l) "")
(define (tmtex-show-part s l) (tmtex (cadr l)))

(define (tmtex-noop l) "")

(define (tmtex-error l)
  (display* "TeXmacs] error in conversion: " l "\n")
  "")

(define (tmtex-document l)
  (cons '!document (tmtex-list l)))

(define (tmtex-date l)
  (tmtex-default "tmdate" l))

(define (tmtex-para l)
  (cons '!paragraph (tmtex-list l)))

(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))))

(define (tmtex-surround l)
  (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)))))

(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)))))

(define (tmtex-no-space-after? x)
  (and (string? x) (!= x "")
       (in? (string-ref x 0) '(#\( #\[))))

(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-before? (car tail))
                (tmtex-no-space-after? head))
	    (cons head tail)
	    (cons* head " " tail)))))

(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)))
	 (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))))))

(define (tmtex-concat l)
  ;;(display* "l= " l "\n")
  (set! l (pre-brackets-recurse l))
  (if (tmtex-math-mode?)
      (tex-concat (tmtex-math-concat-spaces (tmtex-list l)))
      (tex-concat (tmtex-list (tmtex-rewrite-no-break l)))))

(define (tmtex-rigid l)
  (tmtex-function '!group l))

(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-new-line l) (tex-apply '!newline))
(define (tmtex-next-line l) (list '!nextline))
(define (tmtex-no-break l) '(!group (nobreak)))
(define (tmtex-emdash l) "---")

(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 "spc") (string-replace s "spc" "em"))
	  ((string-ends? s "par") (string-replace s "par" "\\columnwidth"))
	  (else s))))

(define (tmtex-hrule l) (list 'tmhrule))

(define (tmtex-hspace l)
  (let ((s (if (= (length l) 1) (car l) (cadr l))))
    (cond ((== s "1fn") (list 'quad))
	  ((== s "-0.6spc") '(!concat (!) (!) (!)))
	  ((== s "-0.4spc") '(!concat (!) (!)))
	  ((== s "-0.2spc") '(!concat (!)))
	  ((== s "0.2spc") (list (string->symbol ",")))
	  ((== s "0.4spc") (list (string->symbol ":")))
	  ((== s "0.6spc") (list (string->symbol ";")))
	  (else (tex-apply 'hspace (tmtex-decode-length s))))))

(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))))))

(define (tmtex-space l)
  (tmtex-hspace (list (car l))))

(define (tmtex-float-make size type position x capt)
  (let* ((body (tmtex x))
	 (caption (tmtex capt))
	 (body* `(!paragraph ,body (caption ,caption))))
    (cond ((and (== size "big") (== type "figure"))
	   `((!begin "figure" (!option ,position)) ,body*))
	  ((and (== size "big") (== type "table"))
	   `((!begin "table" (!option ,position)) ,body*))
	  (else (list 'tmfloat position size type body caption)))))

(define (tmtex-float-table? x)
  (or (func? x 'small-table 2) (func? x 'big-table 2)))

(define (tmtex-float-figure? x)
  (or (func? x 'small-figure 2) (func? x 'big-figure 2)))

(define (tmtex-float-size l)
  (if (list? l)
      (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big")
      "big"))

(define (tmtex-float-sub position l)
  (cond ((func? l 'document 1) (tmtex-float-sub position (cadr l)))
	((tmtex-float-figure? l)
	 (tmtex-float-make (tmtex-float-size l) "figure" position (cadr l)
	   (caddr l)))
	((tmtex-float-table? l)
	 (tmtex-float-make (tmtex-float-size l) "table" position (cadr l)
	   (caddr l)))
	(else (tmtex-float-make "big" "figure" position l ""))))

(define (tmtex-float l)
  (tmtex-float-sub (force-string (cadr l)) (caddr l)))

(define (tmtex-htab l)
  (tex-apply 'hspace* (list 'fill)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make brackets small when necessary
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (disable-large? x level)
  (cond ((string? x) #t)
        ((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))))
        ((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))
        (else #f)))

(define (make-small s)
  (cond ((nstring? s) "<nobracket>")
	((== s ".") "<nobracket>")
	((<= (string-length s) 1) s)
	(else (string-append "<" s ">"))))

(define (make-small-bracket x)
  (if (tm-in? x '(left mid right)) (make-small (cadr x)) x))

(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))))))

(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))))))

(define (pre-brackets-recurse l)
  (with r (pre-brackets l)
    (if (== r l) r
        (pre-brackets-recurse r))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mathematics
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (convert-around x)
  (with d (downgrade-brackets x)
    (tmtex-concat (if (pair? d) (cdr d) (list d)))))

(define (tmtex-around l)
  (convert-around (cons 'around l)))

(define (tmtex-around* l)
  (convert-around (cons 'around* l)))

(define (tmtex-big-around l)
  (convert-around (cons 'big-around l)))

(define (tmtex-large-decode s)
  (cond ((nstring? s) ".")
        ((in? s '("(" ")" "[" "]" "|" "/" ".")) s)
	((== s "||") "\\|")
	((== s "\\") "\\backslash")
	(else (string-append "\\" s))))

(define (tmtex-left l)
  (let* ((s (tmtex-large-decode (car l)))
	 (n (if (> (length l) 1) (string->number (cadr l)) 0))
	 (b (cond ((= n 1) "bigl")
		  ((= n 2) "Bigl")
		  ((= n 3) "biggl")
		  ((= n 4) "Biggl")
		  (else "left"))))
    (list (string->symbol (string-append b s)))))

(define (tmtex-mid l)
  (let* ((s (tmtex-large-decode (car l)))
	 (n (if (> (length l) 1) (string->number (cadr l)) 0))
	 (b (cond ((= n 1) "bigm")
		  ((= n 2) "Bigm")
		  ((= n 3) "biggm")
		  ((= n 4) "Biggm")
		  (else "middle"))))
    (list (string->symbol (string-append b s)))))

(define (tmtex-right l)
  (let* ((s (tmtex-large-decode (car l)))
	 (n (if (> (length l) 1) (string->number (cadr l)) 0))
	 (b (cond ((= n 1) "bigr")
		  ((= n 2) "Bigr")
		  ((= n 3) "biggr")
		  ((= n 4) "Biggr")
		  (else "right"))))
    (list (string->symbol (string-append b s)))))

(define (tmtex-big-decode s)
  (cond ((nstring? s) "bignone")
        ((in? s '("sum" "prod" "int" "oint" "coprod")) s)
	((== s "amalg") "coprod")
	((== s "pluscup") "uplus")
	((== s ".") "bignone")
	(else (string-append "big" s))))

(define (tmtex-big l)
  (list (string->symbol (tmtex-big-decode (car l)))))

(define (tmtex-decode-long-arrow s)
  (cond ((nstring? s) 'xrightarrow)
        ((and (string-starts? s "<rubber-") (string-ends? 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)))
        (else 'xrightarrow)))

(define (tmtex-long-arrow l)
  (with cmd (tmtex-decode-long-arrow (car l))
    (if (== (length l) 2)
        (list cmd (tmtex (cadr l)))
        (list cmd (list '!option (tmtex (caddr l))) (tmtex (cadr l))))))

(define (tmtex-prime-list l)
  (if (null? l) l
      (cond ((== (car l) #\<)
	     (receive (p q) (list-break (cdr l) (lambda (c) (== c #\>)))
	       (let ((next (if (null? q) '() (cdr q))))
		 (cons (list '!sup (list (string->symbol (list->string p))))
		       (tmtex-prime-list next)))))
	    ((== (car l) #\') (cons "'" (tmtex-prime-list (cdr l))))
	    ((== (car l) #\`)
	     (cons (list '!sup (list 'backprime))
		   (tmtex-prime-list (cdr l))))
	    (else (cons (list '!sup (char->string (car l)))
			(tmtex-prime-list (cdr l)))))))

(define (tmtex-lprime l)
  (tmtex (list 'concat (list 'text "") (list 'rprime (car l)))))

(define (tmtex-rprime l)
  (tex-concat (tmtex-prime-list (string->list (car l)))))

(define (tmtex-below l)
  (list 'underset (tmtex (cadr l)) (tmtex (car l))))

(define (tmtex-above l)
  (list 'overset (tmtex (cadr l)) (tmtex (car l))))

(define (tmtex-lsub l)
  (tmtex (list 'concat (list 'text "") (list 'rsub (car l)))))

(define (tmtex-lsup l)
  (tmtex (list 'concat (list 'text "") (list 'rsup (car l)))))

(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))))))

(define (tmtex-script which script)
  (with r (tmtex script)
    (if (tmtex-contains-table? r)
	(list which (list 'tmscript r))
	(list which r))))

(define (tmtex-rsub l)
  (if (tmtex-math-mode?)
      (tmtex-script '!sub (car l))
      (list 'tmrsub (tmtex (car l)))))

(define (tmtex-rsup l)
  (if (tmtex-math-mode?)
      (tmtex-script '!sup (car l))
      (list 'tmrsup (tmtex (car l)))))

(define (tmtex-modulo l)
      (tmtex-script 'mod (car l)))

(define (tmtex-frac l)
  (tmtex-function 'frac l))

(define (tmtex-sqrt l)
  (if (= (length l) 1)
      (tmtex-function 'sqrt l)
      (list 'sqrt
	    (list '!option (tmtex (cadr l)))
	    (tmtex (car l)))))

(define (tmtex-token? s)
  (or (= (string-length s) 1)
      (and (!= s "")
	   (== (string-ref s 0) #\<)
	   (== (string-index s #\>) (- (string-length s) 1)))))
       
(define (tmtex-wide-star? x)
  (cond ((func? x 'wide* 1) (tmtex-wide-star? (cadr x)))
	((nstring? x) #t)
	(else (not (tmtex-token? x)))))

(define (tmtex-wide-star l)
  (let ((wide (tmtex-wide-star? (car l)))
	(arg (tmtex (car l)))
	(acc (cadr l)))
    (if (and (string? acc) (string-starts? acc "<wide-"))
	(set! acc (string-append "<" (substring acc 6 (string-length acc)))))
    (cond ((nstring? acc) arg)
	  ((== acc "~")
	   (tmtex-below (list (car l) (list 'mbox (list 'textasciitilde)))))
	  ((== acc "<bar>") (list 'underline arg))
	  ((in? acc '("<underbrace>" "<underbrace*>"))
	   (list 'underbrace arg))
	  ((in? acc '("<overbrace>" "<overbrace*>"))
	   (tmtex-below `(,(car l) (text (downbracefill)))))
	  ;; imperfect translations
	  ((in? acc '("<squnderbrace>" "<squnderbrace*>"))
	   (list 'underbrace arg))
	  ((in? acc '("<sqoverbrace>" "<sqoverbrace*>"))
	   (tmtex-below `(,(car l) (text (downbracefill)))))
	  (else
	   (display* "TeXmacs] non converted accent below: " acc "\n")
	   arg))))

(define (tmtex-wide? x)
  (cond ((func? x 'wide 1) (tmtex-wide? (cadr x)))
	((nstring? x) #t)
	(else (not (tmtex-token? x)))))

(define (tmtex-wide l)
  (let ((wide (tmtex-wide? (car l)))
	(arg (tmtex (car l)))
	(acc (cadr l)))
    (if (and (string? acc) (string-starts? acc "<wide-"))
	(set! acc (string-append "<" (substring acc 6 (string-length acc)))))
    (cond ((nstring? acc) arg)
	  ((in? acc '("<hat>" "^")) (list (if wide 'widehat 'hat) arg))
	  ((in? acc '("<tilde>" "~")) (list (if wide 'widetilde 'tilde) arg))
	  ((== (cadr l) "<wide-bar>") (list 'overline arg))
	  ((== acc "<bar>") (list (if wide 'overline 'bar) arg))
	  ((== acc "<vect>") (list (if wide 'overrightarrow 'vec) arg))
	  ((== acc "<breve>") (list 'breve arg))
	  ((== acc "<invbreve>") (list 'invbreve arg))
	  ((== acc "<check>") (list 'check arg))
	  ((== acc "<acute>") (list 'acute arg))
	  ((== acc "<grave>") (list 'grave arg))
	  ((== acc "<dot>") (list 'dot arg))
	  ((== acc "<ddot>") (list 'ddot arg))
	  ((== acc "<dddot>") (list 'dddot arg))
	  ((== acc "<ddddot>") (list 'ddddot arg))
	  ((in? acc '("<overbrace>" "<overbrace*>"))
	   (list 'overbrace arg))
	  ((in? acc '("<underbrace>" "<underbrace*>"))
	   (tmtex-above `(,(car l) (text (upbracefill)))))
	  ;; FIXME: imperfect translations
	  ((== acc "<abovering>") (list 'dot arg))
	  ((in? acc '("<sqoverbrace>" "<sqoverbrace*>"))
	   (list 'overbrace arg))
	  ((in? acc '("<squnderbrace>" "<squnderbrace*>"))
	   (tmtex-above `(,(car l) (text (upbracefill)))))
	  (else
	   (display* "TeXmacs] non converted accent: " acc "\n")
	   arg))))

(define (tmtex-neg l)
  (tmtex-function 'not l))

(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))))

(define (tmtex-tree-eps l)
  (tmtex-eps (cons 'tree l)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-table-rows-assemble tb bb rows)
  (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)))))))

(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))))

(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)))))))
 
(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))))

(define (tmtex-table-apply key x)
  (let* ((props (logic-ref tmtex-table-props% key)))
    (if props
	(let* ((env (if (tmtex-math-mode?) 'array 'tabular))
	       (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 (list '!begin (symbol->string env) (tmtex-table-args p)))
	       (r (tmtex-table-make p)))
	  (tex-concat (list before (list e r) after)))
	(list (list '!begin (symbol->string key))
	      (tmtex-table-make (tmtable-parser x))))))

(define (tmtex-tformat l)
  (tmtex-table-apply 'tabular (cons 'tformat l)))

(define (tmtex-table l)
  (tmtex-table-apply 'tabular (cons 'table l)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Local and global environment changes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-get-with-cmd var val)
  (logic-ref tex-with-cmd% (list var val)))

(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))))

(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))))))

(define (tmtex-make-parmod x y z arg)
  (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)))
      arg
      (list (list '!begin "tmparmod" x y z) arg)))

(define (tmtex-make-parsep x arg)
  (set! x (tmlength->texlength x))
  (list (list '!begin "tmparsep" x) arg))

(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))
	      (else arg)))
      (let ((w (tmtex-get-with-cmd var val))
	    (a (tmtex-get-assign-cmd var val)))
	(cond (w (list w arg))
	      (a (list '!group (tex-concat (list (list a) " " arg))))
	      ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg))
	      ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg))
	      ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg))
	      ((== "par-par-sep" var) (tmtex-make-parsep val arg))
              ((== var "language")
               `(!group (!concat (selectlanguage ,val) " " ,arg)))
	      ((== var "color")
               ;; TODO: define color when necessary
	        (if (and (= (string-length val) 7) (char=? (string-ref val 0) #\#))
		  (let* ((r (quotient (* (string->number (substring val 1 3) 16) 1000) 255))
			 (g (quotient (* (string->number (substring val 3 5) 16) 1000) 255))
			 (b (quotient (* (string->number (substring val 5 7) 16) 1000) 255))
			 (rgb (format #f "~,,-3f,~,,-3f,~,,-3f" r g b)))
		    (list '!group (tex-concat (list (list 'color (list '!option "rgb") rgb) " " arg))))
		  (list '!group (tex-concat (list (list 'color val) " " arg)))))
	      (else arg)))))

(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)))
		(tmtex-env-set var val)
		(let ((r (tmtex-with-one var val (tmtex-with next))))
		  (tmtex-env-reset var)
		  r)))))

(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=? c #\0) (cons* #\z #\e #\r #\o r))
	      ((char=? c #\1) (cons* #\o #\n #\e r))
	      ((char=? c #\2) (cons* #\t #\w #\o r))
	      ((and (char=? c #\*) (null? (cdr l))) (list c))
	      (else r)))))

(define (tmtex-var-name var)
  (cond ((nstring? var) "")
	((logic-in? (string->symbol var) tmtex-protected%)
	 (string-append "tm" var))
	((<= (string-length var) 1) var)
	(else (list->string (tmtex-var-name-sub (string->list var))))))

(define (tmtex-tex-arg l)
  (cons '!arg l))

(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)))))

(define (tmtex-args-sub l args)
  (if (null? l) l
      (cons (tmtex-args (car l) args)
	    (tmtex-args-sub (cdr l) args))))

(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))))

(define (tmtex-assign l)
  (let ((var (tmtex-var-name (car 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 'newcommand (string-append "\\" var)
			     (tmtex val)))))
		((or (func? val 'macro) (func? val 'func))
		 (if (null? (cddr val))
		     (list 'newcommand (string-append "\\" var)
			   (tmtex (cAr val)))
		     (list 'newcommand (string-append "\\" var)
			   (list '!option (number->string (- (length val) 2)))
			   (tmtex (tmtex-args (cAr val) (cDdr val))))))
		(else (list 'newcommand (string-append "\\" var)
			    (tmtex val)))))
	"")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Other primitives
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-quote l)
  (tmtex (car l)))

(define (tmtex-label l)
  (list 'label (force-string (car l))))

(define (tmtex-reference l)
  (list 'ref (force-string (car l))))

(define (tmtex-pageref l)
  (list 'pageref (force-string (car l))))

(define (tmtex-specific l)
  (cond ((== (car l) "latex") (tmtex-tt (cadr l)))
	((== (car l) "image") (tmtex-eps (cadr l)))
	(else
          (begin
            (display* "TeXmacs] non converted specific content: \n" l "\n")
            ""))))

(define (tmtex-eps-names)
  (set! tmtex-serial (+ tmtex-serial 1))
  (let* ((postfix (string-append "-" (number->string tmtex-serial) ".eps"))
	 (name-url (url-glue tmtex-image-root-url postfix))
	 (name-string (string-append tmtex-image-root-string postfix)))
    (values name-url name-string)))

(define (tmtex-eps x)
  (if (tmtex-math-mode?) (set! x `(with "mode" "math" ,x)))
  (receive (name-url name-string) (tmtex-eps-names)
    (print-snippet name-url x)
    (list 'includegraphics name-string)))

(define (tmtex-graphics l)
  (tmtex-eps (cons 'graphics l)))

(define (tmtex-as-eps name)
  (with u (url-relative current-save-target (unix->url name))
    (if (or (string-ends? name ".ps")
	    (string-ends? name ".eps")
	    (not (url-exists? u)))
	(list 'includegraphics name)
	(let* ((suffix (url-suffix u))
	       (fm (string-append (format-from-suffix suffix) "-file")))
	  (receive (name-url name-string) (tmtex-eps-names)
	    (convert-to-file u fm "postscript-file" name-url)
	    (list 'includegraphics name-string))))))

(define (tmtex-image-length 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)))))

(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))))
    (cond ((== s "") 0.0)
	  ((string-ends? s "%")
	   (with x (string->number (string-drop-right s 1))
	     (if x (/ x 100.0) 0)))
	  ((in? unit '("w" "h")) (or val 0))
	  (else #f))))

(define (tmtex-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)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Matadatas of documents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tm-define (tmtex-doc-title t)
  `(title ,(tmtex (cadr t))))

(tm-define (tmtex-doc-running-title t)
  `(tmrunningtitle ,(tmtex (cadr t))))

(tm-define (tmtex-doc-subtitle t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmsubtitle ,(tmtex (cadr t))))

(tm-define (tmtex-doc-note t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmnote ,(tmtex (cadr t))))

(tm-define (tmtex-doc-misc t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmmisc ,(tmtex (cadr t))))

(tm-define (tmtex-doc-date t)
  `(date ,(tmtex (cadr t))))

(tm-define (tmtex-doc-running-author t)
  `(tmrunningauthor ,(tmtex (cadr t))))

(tm-define (tmtex-author-name t)
  `(author ,(tmtex (cadr t))))

(tm-define (tmtex-author-affiliation t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmaffiliation ,(tmtex (cadr t))))

(tm-define (tmtex-author-email t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmemail ,(tmtex (cadr t))))

(tm-define (tmtex-author-homepage t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmhomepage ,(tmtex (cadr t))))

(tm-define (tmtex-author-note t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmnote ,(tmtex (cadr t))))

(tm-define (tmtex-author-misc t)
  (set! t (tmtex-remove-line-feeds t))
  `(tmmisc ,(tmtex (cadr t))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Usefull macros for metadata presentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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*)))

(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)))))

(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)))))))

(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?))))

(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?))))

;;  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))))

(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?))))

(define (add-refs l n tag tr tl global-counter?)
  (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*))
             (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?)))))

(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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Authors metadata presentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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 ,@affiliations ,@emails ,@urls ,@notes ,@miscs)))
    (if (null? result) '()
      `(author (!paragraph ,@result)))))

(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*))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Document metadata presentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tm-define (tmtex-prepare-doc-data l)
  (set! l (map tmtex-replace-documents l))
  l)

(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)))))))

(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)
     ,@(tmtex-append-authors authors)
     ,@dates
     (maketitle)))

(tm-define (tmtex-get-title-option l)
  (apply append (map cdr (tmtex-select-args-by-func 'doc-title-options l))))

(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))
         (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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Abstract metadata presentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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))))

(tm-define (tmtex-abstract-acm t)
  (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
    `(!concat (tmacm) ,@(map (lambda (x) `(!group ,x)) args))))

(tm-define (tmtex-abstract-arxiv t)
  (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
    `(!concat (tmarxiv) ,@(map (lambda (x) `(!group ,x)) args))))

(tm-define (tmtex-abstract-msc t)
  (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
    `(!concat (tmmsc) ,@(map (lambda (x) `(!group ,x)) args))))

(tm-define (tmtex-abstract-pacs t)
  (with args (list-intersperse (map tmtex (cdr t)) '(tmsep))
    `(!concat (tmpacs) ,@(map (lambda (x) `(!group ,x)) args))))

(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))))

(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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TeXmacs style primitives
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-std-env s l)
  (if (== s "quote-env") (set! s "quote"))
  (list (list '!begin s) (tmtex (car l))))

(define (tmtex-appendix s l)
  (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)))))

(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))))))

(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 'with)
         (begin
           (display* "TeXmacs] lost <with> in verbatim content: " (cDr x) "\n")
           (tmtex-tt (cAr x))))
	(else
          (begin
	    (display* "TeXmacs] non converted verbatim content: \n" x "\n")
            ""))))

(define (unescape-angles l)
  (cond ((string? l)
         (string-replace (string-replace l "<less>" "<") "<gtr>" ">"))
        ((symbol? l) l)
        (else (map unescape-angles l))))

(define (escape-braces l)
  (cond ((string? l) (string-replace (string-replace l "{" "\\{") "}" "\\}"))
        ((symbol? l) l)
        (else (map escape-braces l))))

(define (escape-backslashes l)
  (cond ((string? l) (string-replace l "\\" "\\textbackslash "))
        ((symbol? l) l)
        (else (map escape-backslashes l))))

(define (tmtex-new-theorem s l)
  (ahash-set! tmtex-dynamic (string->symbol (car l)) 'environment)
  `(newtheorem ,@l))

(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)))))

(define (tmtex-verbatim* s l)
  (if (func? (car l) 'document)
      (list '!verbatim* (tmtex-tt (car l)))
      (list 'tmverbatim (tmtex (car l)))))

(define (tmtex-code-inline s l)
  (with lang `((!option ,s))
    `(tmcodeinline ,@lang ,(tmtex (car l)))))

(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))))

(define (tmtex-mixed s l)
  (set! l (unescape-angles l))
    (list '!unindent (list '!verbatim* (tmtex-tt (cadr 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))))

(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))))

(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 "")))

(define (tmtex-number l)
  (tmtex-default 
    (tmtex-number-renderer (cdr l))
    (list (tmtex-number-counter (car l)))))

(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)))))

(define (tmtex-indent s l)
  (list (list '!begin "tmindent") (tmtex (car l))))

(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)))))

(define (tmtex-tiny s l)
  (tex-apply 'tiny (tmtex (car l))))

(define (tmtex-scriptsize s l)
  (tex-apply 'scriptsize (tmtex (car l))))

(define (tmtex-footnotesize s l)
  (tex-apply 'footnotesize (tmtex (car l))))

(define (tmtex-normalsize s l)
  (tex-apply 'normalsize (tmtex (car l))))

(define (tmtex-large s l)
  (tex-apply 'large (tmtex (car l))))

(define (tmtex-Large s l)
  (tex-apply 'Large (tmtex (car l))))

(define (tmtex-LARGE s l)
  (tex-apply 'LARGE (tmtex (car l))))

(define (tmtex-Huge s l)
  (list 'Huge (tmtex (car l))))

(tm-define (tmtex-equation s l)
  (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))))

(define (tmtex-eqnarray s l)
  (tmtex-env-set "mode" "math")
  (let ((r (tmtex-table-apply (string->symbol s) (car l))))
    (tmtex-env-reset "mode")
    r))

(define (tmtex-math s l)
  (tmtex `(with "mode" "math" ,(car l))))

(define (tmtex-textual x)
  (tmtex-env-set "mode" "text")
  (with r (tmtex x)
    (tmtex-env-reset "mode")
    r))

(define (tmtex-math-up s l)
  (list 'mathrm (tmtex-textual (car l))))

(define (tmtex-math-ss s l)
  (list 'mathsf (tmtex-textual (car l))))

(define (tmtex-math-tt s l)
  (list 'mathtt (tmtex-textual (car l))))

(define (tmtex-math-bf s l)
  (list 'mathbf (tmtex-textual (car l))))

(define (tmtex-math-sl s l)
  (list 'mathsl (tmtex-textual (car l))))

(define (tmtex-math-it s l)
  (list 'mathit (tmtex-textual (car l))))

(define (tmtex-mathord s l)
  (list 'mathord (tmtex (car l))))

(define (tmtex-mathbin s l)
  (list 'mathbin (tmtex (car l))))

(define (tmtex-mathrel s l)
  (list 'mathrel (tmtex (car l))))

(define (tmtex-mathopen s l)
  (list 'mathopen (tmtex (car l))))

(define (tmtex-mathclose s l)
  (list 'mathclose (tmtex (car l))))

(define (tmtex-mathpunct s l)
  (list 'mathpunct (tmtex (car l))))

(define (tmtex-mathop s l)
  (list 'mathop (tmtex (car l))))

(define (tmtex-syntax s l)
  (tmtex (car l)))

(define (tmtex-theindex s l)
    (list 'printindex))

(define (tmtex-toc s l)
  (tex-apply 'tableofcontents))

(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))))
	((func? doc 'bib-list 2) (tmtex-bib-sub (cAr doc)))
	(else (map tmtex-bib-sub doc))))

(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)))))

(define (tmtex-bib s l)
  (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-bib-max doc)))
	(tmtex (list 'thebibliography max doc)))))

(define (tmtex-thebibliography s l)
  (list (list '!begin s (car l)) (tmtex (cadr l))))

(define (tmtex-bibitem* 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: \n"
                      (list s l) "\n")
            ""))))

(define (tmtex-figure s l)
  (tmtex-float-sub "h" (cons (string->symbol s) l)))

(define (tmtex-item s l)
  (tex-concat (list (list 'item) " ")))

(define (tmtex-item-arg s l)
  (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " ")))

(define (tmtex-render-proof s l)
  (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l))))

(define (tmtex-nbsp s l)
  '(!nbsp))

(define (tmtex-nbhyph s l)
  '(!nbhyph))

(define (tmtex-session s l)
  (tmtex (cAr l)))

(define (tmtex-input s l)
  (let ((prompt (car l)) (x (cadr l)))
    (tex-concat
     (list '(noindent)
	   `(!group (!concat (color "red") (ttfamily ,(tmtex prompt))))
	   (cond ((func? x 'math 1)
		  (tmtex-env-set "mode" "math")
		  (let ((r (tmtex (cadr x))))
		    (tmtex-env-reset "mode")
		    `(!math (!group (!concat (color "blue") ,r)))))
		 (else `(!group (!concat (color "blue")
					 (!verb ,(tmtex-tt x))))))
	   '(smallskip)))))

(define (tmtex-output s l)
  (tex-concat
   (list '(noindent)
	 (list '!group (list 'ttfamily (tmtex (car l))))
	 '(medskip))))

(define (escape-backslashes-in-url l)
  (cond ((string? l) (string-replace l "\\" "\\\\"))
        ((symbol? l) l)
        (else (map escape-backslashes-in-url l))))

(define (tmtex-hyperref u)
  (tmtex-tt (escape-backslashes-in-url u)))

(define (tmtex-hlink s l)
  (list 'href (tmtex-hyperref (cadr l)) (tmtex (car l))))

(define (tmtex-href s l)
  (list 'url (tmtex-verb-string (car l))))

(define (tmtex-action s l)
  (list 'tmaction (tmtex (car l)) (tmtex (cadr l))))

(define (tmtex-choose s l)
  (list 'binom (tmtex (car l)) (tmtex (cadr l))))

(define (tmtex-modifier s l)
  (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l))))

(define (tmtex-menu-one x)
  (tmtex (list 'samp x)))

(define (tmtex-menu-list l)
  (if (null? l) l
      (cons* (list '!math (list 'rightarrow))
	     (tmtex-menu-one (car l))
	     (tmtex-menu-list (cdr l)))))

(define (tmtex-menu s l)
  (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l)))))

(define ((tmtex-rename into) s l)
  (tmtex-apply into (tmtex-list l)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Citations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-cite-list l)
  (cond ((null? l) "")
	;((nstring? (car l)) (tmtex-cite-list (cdr l)))
	((null? (cdr l)) (car l))
	(else (string-append (car l) "," (tmtex-cite-list (cdr 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)))

(define (tmtex-nocite s l)
  (tex-apply 'nocite (tmtex-cite-list l)))

(tm-define (tmtex-cite-detail s l)
  (tex-apply 'cite `(!option ,(tmtex (cadr l))) (tmtex (car l))))

(tm-define (tmtex-cite-detail s l)
  (:mode natbib-package?)
  (tex-apply 'citetext `(!concat (citealp ,(tmtex (car l))) ", "
				 ,(tmtex (cadr l)))))

(define (tmtex-cite-raw s l)
  (tex-apply 'citealp (tmtex-cite-list l)))

(define (tmtex-cite-raw* s l)
  (tex-apply 'citealp* (tmtex-cite-list l)))

(define (tmtex-cite-textual s l)
  (tex-apply 'citet (tmtex-cite-list l)))

(define (tmtex-cite-textual* s l)
  (tex-apply 'citet* (tmtex-cite-list l)))

(define (tmtex-cite-parenthesized s l)
  (tex-apply 'citep (tmtex-cite-list l)))

(define (tmtex-cite-parenthesized* s l)
  (tex-apply 'citep* (tmtex-cite-list l)))

(define (tmtex-render-cite s l)
  (tex-apply 'citetext (tmtex (car l))))

(define (tmtex-cite-author s l)
  (tex-apply 'citeauthor (tmtex (car l))))

(define (tmtex-cite-author* s l)
  (tex-apply 'citeauthor* (tmtex (car l))))

(define (tmtex-cite-year s l)
  (tex-apply 'citeyear (tmtex (car l))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Glossaries
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-glossary s l)
  (with nr (+ tmtex-auto-produce 1)
    (set! tmtex-auto-produce nr)
    `(label ,(string-append "autolab" (number->string nr)))))

(define (tmtex-glossary-entry s l)
  (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)))))

(define (tmtex-the-glossary s l)
  `(!document
      (,(if (latex-book-style?) 'chapter* 'section*) "Glossary")
      ((!begin "theglossary" ,(car l)) ,(tmtex (cadr l)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The main conversion routines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-apply key args)
  (let ((n (length args))
	(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))
          (r (r args))
          (else
            (let ((p (logic-ref tmtex-tmstyle% key)))
              (if (and p (or (= (cadr p) -1) (= (cadr p) n)))
                ((car p) (symbol->string key) args)
                (if (and p (= (cadr p) -2))
                  ((car p) `(,key ,@args))
                  (if (and (= n 1)
                           (or (func? (car args) 'tformat)
                               (func? (car args) 'table)))
                    (tmtex-table-apply key (car args))
                    (tmtex-function key args)))))))))

(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)))))))

(define (tmtex-compound l)
  (if (string? (car l))
      (tmtex-apply (string->symbol (car l)) (cdr l))
      ""))

(define (tmtex-list l)
  (map-in-order tmtex l))

(tm-define (tmtex x)
  (with src (ahash-ref tmtex-src x)
    ;; (display* x "\n ---> " src "\n\n")
    (cond ((not (not src)) (list '!verbatim* (tmtex-tt (car src))))
          ((string? x) (tmtex-string x))
          (else (tmtex-apply (car x) (cdr x))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Dispatching
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(logic-dispatcher tmtex-methods%
  ((:or unknown uninit error raw-data) tmtex-error)
  (document tmtex-document)
  (para tmtex-para)
  (surround tmtex-surround)
  (concat tmtex-concat)
  (rigid tmtex-rigid)
  (hidden tmtex-noop)
  (hrule tmtex-hrule)
  (hspace tmtex-hspace)
  (vspace* tmtex-noop)
  (vspace tmtex-vspace)
  (space tmtex-space)
  (htab tmtex-htab)
  (move tmtex-noop)
  (resize tmtex-noop)
  (repeat tmtex-noop)
  (float tmtex-float)
  ((:or datoms dlines dpages dbox) tmtex-noop)

  (number tmtex-number)
  (change-case tmtex-change-case)
  (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-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-lprime)
  (rprime tmtex-rprime)
  (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)
  (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 translate find-file
	is-tuple look-up
	equal unequal less lesseq greater greatereq) tmtex-noop)

  (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)
  (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
	apply begin end func env) tmtex-noop)
  
  (shown tmtex-id)
  (!file tmtex-file)
  (!arg tmtex-tex-arg))
      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Expansion of all macros which are not recognized by LaTeX
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(logic-table tmtex-tmstyle%
  ((: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))
  ((:or theorem proposition lemma corollary proof axiom definition
	notation conjecture remark note example exercise problem warning
	convention quote-env quotation verse solution question answer
	acknowledgments)
   (,tmtex-std-env 1))
  (new-theorem (,tmtex-new-theorem 2))
  (verbatim (,tmtex-verbatim 1))
  (center (,tmtex-std-env 1))
  (indent (,tmtex-indent 1))
  ((:or description description-compact description-aligned
	description-dash description-long
	itemize itemize-minus itemize-dot itemize-arrow
	enumerate enumerate-numeric enumerate-roman enumerate-Roman
	enumerate-alpha enumerate-Alpha)
   (,tmtex-list-env 1))
  (really-tiny (,tmtex-tiny 1))
  (very-tiny (,tmtex-tiny 1))
  (really-small (,tmtex-scriptsize 1))
  (very-small (,tmtex-scriptsize 1))
  (smaller (,tmtex-footnotesize 1))
  (flat-size (,tmtex-footnotesize 1))
  (normal-size (,tmtex-normalsize 1))
  (sharp-size (,tmtex-large 1))
  (larger (,tmtex-Large 1))
  (very-large (,tmtex-LARGE 1))
  (really-large (,tmtex-LARGE 1))
  (really-huge (,tmtex-Huge 1))

  (math (,tmtex-math 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*) (,tmtex-eqnarray 1))
  (eq-number (,tmtex-default -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))

  (minipage (,tmtex-minipage 3))
  (latex_preview (,tmtex-mixed 2))
  (picture-mixed (,tmtex-mixed 2))
  (source-mixed (,tmtex-mixed 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))
  (bibliography (,tmtex-bib 4))
  (thebibliography (,tmtex-thebibliography 2))
  (bib-list (,tmtex-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))
  (session (,tmtex-session -1))
  (input (,tmtex-input 2))
  (output (,tmtex-output 1))
  (hlink (,tmtex-hlink 2))
  (action (,tmtex-action -1))
  (href (,tmtex-href 1))
  (choose (,tmtex-choose 2))
  ((:or strong em tt name samp abbr dfn kbd var acronym person)
   (,tmtex-modifier 1))
  (menu (,tmtex-menu -1))
  (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0))
  (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0))
  (cite (,tmtex-cite -1))
  (nocite (,tmtex-nocite -1))
  (cite-detail (,tmtex-cite-detail 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))
  (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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)
      (if (== narg 2)
        `(begin
           (when (not (defined? ',fun))
             (tm-define (,fun s l) (tmtex-function (string->symbol s) l)))
           (when (not (defined? ',fun+bis))
             (tm-define (,fun+bis s l) (,fun s l))))
        `(begin
           (when (not (defined? ',fun))
             (tm-define (,fun t)
               (tmtex-function (string->symbol (car t)) (cdr t))))
           (when (not (defined? ',fun+bis))
             (tm-define (,fun+bis s l)
               (,fun (append (list (string->symbol s)) l)))))))))

(tm-define (style-dependent-transform x)
  (with (tag fun narg) x
    (with fun+bis (symbol-append fun '+bis)
      `(,tag (,(list 'unquote fun+bis) -1)))))

(define-macro (tmtex-style-dependent . l)
  `(begin
     ,@(map style-dependent-declare l)
     (logic-table tmtex-tmstyle% ,@(map style-dependent-transform l))))

(tmtex-style-dependent
  ;; to be removed
  (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)
  ;; 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)
  ;; 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)
  ;; 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)
  (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)
  ;; misc
  ((:or equation equation*) tmtex-equation 2)
  (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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 to tt wd wp wr xi
  AA AE DH DJ Im NG OE Pi Pr Re SS TH Xi)
      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Expansion of all macros which are not recognized by LaTeX
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define tmtex-user-defs-table (make-ahash-table))

(define (user-definition? x)
  (or
    (and (func? x 'new-theorem 2) (string? (cadr x)))
    (and (func? x 'assign 2) (string? (cadr x)))))

(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)))))

(define (collect-user-defs t)
  (if (== (get-preference "texmacs->latex:expand-user-macros") "on") '()
      (begin
	(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))))

(define (as-string sym)
  (with s (symbol->string sym)
    (if (string-starts? s "begin-")
	(substring s 6 (string-length s))
	s)))

(define (logic-first-list name)
  (let* ((l1 (query (cons name '('first 'second))))
	 (l2 (map (cut assoc-ref <> 'first) l1)))
    (map as-string l2)))

(define (tmtex-env-macro name)
  `(associate ,name (xmacro "x" (eval-args "x"))))

(tm-define (tmtex-env-patch t)
  (let* ((l1 (logic-first-list 'tmtex-methods%))
	 (l2 (logic-first-list 'tmtex-tmstyle%))
	 (l3 (map as-string (logic-apply-list '(latex-tag%))))
	 (l4 (map as-string (logic-apply-list '(latex-symbol%))))
	 (l5 (list-difference l3 l4))
	 (l6 (map as-string (collect-user-defs (tree->stree t))))
	 (l7 (list-difference (list-union l2 (list-union l5 l6)) l1)))
    `(collection ,@(map tmtex-env-macro l7))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (tmtex-get-style sty)
  (cond ((not sty) (set! sty (list "generic")))
	((string? sty) (set! sty (list sty)))
	((func? sty 'tuple) (set! sty (cdr sty)))
	((null? sty) (set! sty '("article"))))
  (if (== (car sty) "generic") (set! sty (cons "article" (cdr sty))))
  sty)

(tm-define (texmacs->latex x opts)
  ;;(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-init x "language"))
	     (init (tmfile-extract x 'initial))
	     (att (tmfile-extract x 'attachments))
	     (doc (list '!file body style lan init att
                        (url->string (get-texmacs-path)))))
	(latex-set-style main-style)
	(latex-set-packages '())
	(set! tmtex-style (car style))
	(set! tmtex-packages (cdr style))
        (import-tmtex-styles)
	(tmtex-style-init body)
        (set! doc (tmtex-style-preprocess doc))
	(with result (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 (not tmtex-use-macros?)
	      (set! r (latex-expand-macros r)))
          r))))
