From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Jun 2005 13:00:39 +0000
Subject: Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0
---
 skr/latex.skr | 1780 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 1780 insertions(+)
 create mode 100644 skr/latex.skr

(limited to 'skr/latex.skr')

diff --git a/skr/latex.skr b/skr/latex.skr
new file mode 100644
index 0000000..bc20493
--- /dev/null
+++ b/skr/latex.skr
@@ -0,0 +1,1780 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/latex.skr                        */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Tue Sep  2 09:46:09 2003                          */
+;*    Last change :  Thu May 26 12:59:47 2005 (serrano)                */
+;*    Copyright   :  2003-05 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    LaTeX Skribe engine                                              */
+;*    -------------------------------------------------------------    */
+;*    Implementation:                                                  */
+;*       common: @path ../src/common/api.src@                          */
+;*       bigloo: @path ../src/bigloo/api.bgl@                          */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/latexe.skb:ref@                           */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    latex-verbatim-encoding ...                                      */
+;*---------------------------------------------------------------------*/
+(define latex-verbatim-encoding
+   '((#\\ "{\\char92}")
+     (#\^ "{\\char94}")
+     (#\{ "\\{")
+     (#\} "\\}")
+     (#\& "\\&")
+     (#\$ "\\$")
+     (#\# "\\#")
+     (#\_ "\\_")
+     (#\% "\\%")
+     (#\~ "$_{\\mbox{\\char126}}$")
+     (#\ç "\\c{c}")
+     (#\Ç "\\c{C}")
+     (#\â "\\^{a}")
+     (#\Â "\\^{A}")
+     (#\à "\\`{a}")
+     (#\À "\\`{A}")
+     (#\é "\\'{e}")
+     (#\É "\\'{E}")
+     (#\è "\\`{e}")
+     (#\È "\\`{E}")
+     (#\ê "\\^{e}")
+     (#\Ê "\\^{E}")
+     (#\ù "\\`{u}")
+     (#\Ù "\\`{U}")
+     (#\û "\\^{u}")
+     (#\Û "\\^{U}")
+     (#\ø "{\\o}")
+     (#\ô "\\^{o}")
+     (#\Ô "\\^{O}")
+     (#\ö "\\\"{o}")
+     (#\Ö "\\\"{O}")
+     (#\î "\\^{\\i}")
+     (#\Î "\\^{I}")
+     (#\ï "\\\"{\\i}")
+     (#\Ï "\\\"{I}")
+     (#\] "{\\char93}")
+     (#\[ "{\\char91}")
+     (#\» "\\,{\\tiny{$^{\\gg}$}}")
+     (#\« "{\\tiny{$^{\\ll}$}}\\,")))
+
+;*---------------------------------------------------------------------*/
+;*    latex-encoding ...                                               */
+;*---------------------------------------------------------------------*/
+(define latex-encoding
+   (append '((#\| "$|$")
+	     (#\< "$<$")
+	     (#\> "$>$")
+	     (#\: "{\\char58}")
+	     (#\# "{\\char35}")
+	     (#\Newline " %\n"))
+	   latex-verbatim-encoding))
+		  
+;*---------------------------------------------------------------------*/
+;*    latex-tt-encoding ...                                            */
+;*---------------------------------------------------------------------*/
+(define latex-tt-encoding
+   (append '((#\. ".\\-")
+	     (#\/ "/\\-"))
+	   latex-encoding))
+		  
+;*---------------------------------------------------------------------*/
+;*    latex-pre-encoding ...                                           */
+;*---------------------------------------------------------------------*/
+(define latex-pre-encoding
+   (append '((#\Space "\\ ")
+	     (#\Newline "\\\\\n"))
+	   latex-encoding))
+
+;*---------------------------------------------------------------------*/
+;*    latex-symbol-table ...                                           */
+;*---------------------------------------------------------------------*/
+(define (latex-symbol-table math)
+   `(("iexcl" "!`")
+     ("cent" "c")
+     ("pound" "\\pounds")
+     ("yen" "Y")
+     ("section" "\\S")
+     ("mul" ,(math "^-"))
+     ("copyright" "\\copyright")
+     ("lguillemet" ,(math "\\ll"))
+     ("not" ,(math "\\neg"))
+     ("degree" ,(math "^{\\small{o}}"))
+     ("plusminus" ,(math "\\pm"))
+     ("micro" ,(math "\\mu"))
+     ("paragraph" "\\P")
+     ("middot" ,(math "\\cdot"))
+     ("rguillemet" ,(math "\\gg"))
+     ("1/4" ,(math "\\frac{1}{4}"))
+     ("1/2" ,(math "\\frac{1}{2}"))
+     ("3/4" ,(math "\\frac{3}{4}"))
+     ("iquestion" "?`")
+     ("Agrave" "\\`{A}")
+     ("Aacute" "\\'{A}")
+     ("Acircumflex" "\\^{A}")
+     ("Atilde" "\\~{A}")
+     ("Amul" "\\\"{A}")
+     ("Aring" "{\\AA}")
+     ("AEligature" "{\\AE}")
+     ("Oeligature" "{\\OE}")
+     ("Ccedilla" "{\\c{C}}")
+     ("Egrave" "{\\`{E}}")
+     ("Eacute" "{\\'{E}}")
+     ("Ecircumflex" "{\\^{E}}")
+     ("Euml" "\\\"{E}")
+     ("Igrave" "{\\`{I}}")
+     ("Iacute" "{\\'{I}}")
+     ("Icircumflex" "{\\^{I}}")
+     ("Iuml" "\\\"{I}")
+     ("ETH" "D")
+     ("Ntilde" "\\~{N}")
+     ("Ograve" "\\`{O}")
+     ("Oacute" "\\'{O}")
+     ("Ocurcumflex" "\\^{O}")
+     ("Otilde" "\\~{O}")
+     ("Ouml" "\\\"{O}")
+     ("times" ,(math "\\times"))
+     ("Oslash" "\\O")
+     ("Ugrave" "\\`{U}")
+     ("Uacute" "\\'{U}")
+     ("Ucircumflex" "\\^{U}")
+     ("Uuml" "\\\"{U}")
+     ("Yacute" "\\'{Y}")
+     ("szlig" "\\ss")
+     ("agrave" "\\`{a}")
+     ("aacute" "\\'{a}")
+     ("acircumflex" "\\^{a}")
+     ("atilde" "\\~{a}")
+     ("amul" "\\\"{a}")
+     ("aring" "\\aa")
+     ("aeligature" "\\ae")
+     ("oeligature" "{\\oe}")
+     ("ccedilla" "{\\c{c}}")
+     ("egrave" "{\\`{e}}")
+     ("eacute" "{\\'{e}}")
+     ("ecircumflex" "{\\^{e}}")
+     ("euml" "\\\"{e}")
+     ("igrave" "{\\`{\\i}}")
+     ("iacute" "{\\'{\\i}}")
+     ("icircumflex" "{\\^{\\i}}")
+     ("iuml" "\\\"{\\i}")
+     ("ntilde" "\\~{n}")
+     ("ograve" "\\`{o}")
+     ("oacute" "\\'{o}")
+     ("ocurcumflex" "\\^{o}")
+     ("otilde" "\\~{o}")
+     ("ouml" "\\\"{o}")
+     ("divide" ,(math "\\div"))
+     ("oslash" "\\o")
+     ("ugrave" "\\`{u}")
+     ("uacute" "\\'{u}")
+     ("ucircumflex" "\\^{u}")
+     ("uuml" "\\\"{u}")
+     ("yacute" "\\'{y}")
+     ("ymul" "\\\"{y}")
+     ;; Greek
+     ("Alpha" "A")
+     ("Beta" "B")
+     ("Gamma" ,(math "\\Gamma"))
+     ("Delta" ,(math "\\Delta"))
+     ("Epsilon" "E")
+     ("Zeta" "Z")
+     ("Eta" "H")
+     ("Theta" ,(math "\\Theta"))
+     ("Iota" "I")
+     ("Kappa" "K")
+     ("Lambda" ,(math "\\Lambda"))
+     ("Mu" "M")
+     ("Nu" "N")
+     ("Xi" ,(math "\\Xi"))
+     ("Omicron" "O")
+     ("Pi" ,(math "\\Pi"))
+     ("Rho" "P")
+     ("Sigma" ,(math "\\Sigma"))
+     ("Tau" "T")
+     ("Upsilon" ,(math "\\Upsilon"))
+     ("Phi" ,(math "\\Phi"))
+     ("Chi" "X")
+     ("Psi" ,(math "\\Psi"))
+     ("Omega" ,(math "\\Omega"))
+     ("alpha" ,(math "\\alpha"))
+     ("beta" ,(math "\\beta"))
+     ("gamma" ,(math "\\gamma"))
+     ("delta" ,(math "\\delta"))
+     ("epsilon" ,(math "\\varepsilon"))
+     ("zeta" ,(math "\\zeta"))
+     ("eta" ,(math "\\eta"))
+     ("theta" ,(math "\\theta"))
+     ("iota" ,(math "\\iota"))
+     ("kappa" ,(math "\\kappa"))
+     ("lambda" ,(math "\\lambda"))
+     ("mu" ,(math "\\mu"))
+     ("nu" ,(math "\\nu"))
+     ("xi" ,(math "\\xi"))
+     ("omicron" ,(math "\\o"))
+     ("pi" ,(math "\\pi"))
+     ("rho" ,(math "\\rho"))
+     ("sigmaf" ,(math "\\varsigma"))
+     ("sigma" ,(math "\\sigma"))
+     ("tau" ,(math "\\tau"))
+     ("upsilon" ,(math "\\upsilon"))
+     ("phi" ,(math "\\varphi"))
+     ("chi" ,(math "\\chi"))
+     ("psi" ,(math "\\psi"))
+     ("omega" ,(math "\\omega"))
+     ("thetasym" ,(math "\\vartheta"))
+     ("piv" ,(math "\\varpi"))
+     ;; punctuation
+     ("bullet" ,(math "\\bullet"))
+     ("ellipsis" ,(math "\\ldots"))
+     ("weierp" ,(math "\\wp"))
+     ("image" ,(math "\\Im"))
+     ("real" ,(math "\\Re"))
+     ("tm" ,(math "^{\\sc\\tiny{tm}}"))
+     ("alef" ,(math "\\aleph"))
+     ("<-" ,(math "\\leftarrow"))
+     ("<--" ,(math "\\longleftarrow"))
+     ("uparrow" ,(math "\\uparrow"))
+     ("->" ,(math "\\rightarrow"))
+     ("-->" ,(math "\\longrightarrow"))
+     ("downarrow" ,(math "\\downarrow"))
+     ("<->" ,(math "\\leftrightarrow"))
+     ("<-->" ,(math "\\longleftrightarrow"))
+     ("<+" ,(math "\\hookleftarrow"))
+     ("<=" ,(math "\\Leftarrow"))
+     ("<==" ,(math "\\Longleftarrow"))
+     ("Uparrow" ,(math "\\Uparrow"))
+     ("=>" ,(math "\\Rightarrow"))
+     ("==>" ,(math "\\Longrightarrow"))
+     ("Downarrow" ,(math "\\Downarrow"))
+     ("<=>" ,(math "\\Leftrightarrow"))
+     ("<==>" ,(math "\\Longleftrightarrow"))
+     ;; Mathematical operators
+     ("forall" ,(math "\\forall"))
+     ("partial" ,(math "\\partial"))
+     ("exists" ,(math "\\exists"))
+     ("emptyset" ,(math "\\emptyset"))
+     ("infinity" ,(math "\\infty"))
+     ("nabla" ,(math "\\nabla"))
+     ("in" ,(math "\\in"))
+     ("notin" ,(math "\\notin"))
+     ("ni" ,(math "\\ni"))
+     ("prod" ,(math "\\Pi"))
+     ("sum" ,(math "\\Sigma"))
+     ("asterisk" ,(math "\\ast"))
+     ("sqrt" ,(math "\\surd"))
+     ("propto" ,(math "\\propto"))
+     ("angle" ,(math "\\angle"))
+     ("and" ,(math "\\wedge"))
+     ("or" ,(math "\\vee"))
+     ("cap" ,(math "\\cap"))
+     ("cup" ,(math "\\cup"))
+     ("integral" ,(math "\\int"))
+     ("models" ,(math "\\models"))
+     ("vdash" ,(math "\\vdash"))
+     ("dashv" ,(math "\\dashv"))
+     ("sim" ,(math "\\sim"))
+     ("cong" ,(math "\\cong"))
+     ("approx" ,(math "\\approx"))
+     ("neq" ,(math "\\neq"))
+     ("equiv" ,(math "\\equiv"))
+     ("le" ,(math "\\leq"))
+     ("ge" ,(math "\\geq"))
+     ("subset" ,(math "\\subset"))
+     ("supset" ,(math "\\supset"))
+     ("subseteq" ,(math "\\subseteq"))
+     ("supseteq" ,(math "\\supseteq"))
+     ("oplus" ,(math "\\oplus"))
+     ("otimes" ,(math "\\otimes"))
+     ("perp" ,(math "\\perp"))
+     ("mid" ,(math "\\mid"))
+     ("lceil" ,(math "\\lceil"))
+     ("rceil" ,(math "\\rceil"))
+     ("lfloor" ,(math "\\lfloor"))
+     ("rfloor" ,(math "\\rfloor"))
+     ("langle" ,(math "\\langle"))
+     ("rangle" ,(math "\\rangle"))
+     ;; Misc
+     ("loz" ,(math "\\diamond"))
+     ("spades" ,(math "\\spadesuit"))
+     ("clubs" ,(math "\\clubsuit"))
+     ("hearts" ,(math "\\heartsuit"))
+     ("diams" ,(math "\\diamondsuit"))
+     ("euro" "\\euro{}")
+     ;; LaTeX
+     ("dag" "\\dag")
+     ("ddag" "\\ddag")
+     ("circ" ,(math "\\circ"))
+     ("top" ,(math "\\top"))
+     ("bottom" ,(math "\\bot"))
+     ("lhd" ,(math "\\triangleleft"))
+     ("rhd" ,(math "\\triangleright"))
+     ("parallel" ,(math "\\parallel"))))
+
+;*---------------------------------------------------------------------*/
+;*    latex-engine ...                                                 */
+;*---------------------------------------------------------------------*/
+(define latex-engine
+   (default-engine-set!
+      (make-engine 'latex
+	 :version 1.0
+	 :format "latex"
+	 :delegate (find-engine 'base)
+	 :filter (make-string-replace latex-encoding)
+	 :custom '((documentclass "\\documentclass{article}")
+		   (usepackage "\\usepackage{epsfig}\n")
+		   (predocument "\\newdimen\\oldframetabcolsep\n\\newdimen\\oldcolortabcolsep\n\\newdimen\\oldpretabcolsep\n")
+		   (postdocument #f)
+		   (maketitle "\\date{}\n\\maketitle")
+		   (%font-size 0)
+		   ;; color
+		   (color #t)
+		   (color-usepackage "\\usepackage{color}\n")
+		   ;; hyperref
+		   (hyperref #t)
+		   (hyperref-usepackage "\\usepackage[setpagesize=false]{hyperref}\n")
+		   ;; source fontification
+		   (source-color #t)
+		   (source-comment-color "#ffa600")
+		   (source-error-color "red")
+		   (source-define-color "#6959cf")
+		   (source-module-color "#1919af")
+		   (source-markup-color "#1919af")
+		   (source-thread-color "#ad4386")
+		   (source-string-color "red")
+		   (source-bracket-color "red")
+		   (source-type-color "#00cf00")
+		   (image-format ("eps"))
+		   (index-page-ref #t))
+	 :symbol-table (latex-symbol-table 
+			(lambda (m)
+			   (format "\\begin{math}~a\\end{math}" m))))))
+
+;*---------------------------------------------------------------------*/
+;*    latex-title-engine ...                                           */
+;*---------------------------------------------------------------------*/
+(define latex-title-engine
+   (make-engine 'latex-title
+      :version 1.0
+      :format "latex-title"
+      :delegate latex-engine
+      :filter (make-string-replace latex-encoding)
+      :symbol-table (latex-symbol-table (lambda (m) (format "$~a$" m)))))
+
+;*---------------------------------------------------------------------*/
+;*    latex-color? ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (latex-color? e)
+   (engine-custom e 'color))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (LaTeX #!key (space #t))
+   (if (engine-format? "latex")
+       (! (if space "\\LaTeX\\ " "\\LaTeX"))
+       "LaTeX"))
+
+;*---------------------------------------------------------------------*/
+;*    TeX ...                                                          */
+;*---------------------------------------------------------------------*/
+(define-markup (TeX #!key (space #t))
+   (if (engine-format? "latex")
+       (! (if space "\\TeX\\ " "\\TeX"))
+       "TeX"))
+
+;*---------------------------------------------------------------------*/
+;*    latex ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (!latex fmt #!rest opt)
+   (if (engine-format? "latex")
+       (apply ! fmt opt)
+       #f))
+   
+;*---------------------------------------------------------------------*/
+;*    latex-width ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (latex-width width)
+   (if (and (number? width) (inexact? width))
+       (string-append (number->string (/ width 100.)) "\\linewidth")
+       (string-append (number->string width) "pt")))
+
+;*---------------------------------------------------------------------*/
+;*    latex-font-size ...                                              */
+;*---------------------------------------------------------------------*/
+(define (latex-font-size size)
+   (case size
+      ((4) "Huge")
+      ((3) "huge")
+      ((2) "Large")
+      ((1) "large")
+      ((0) "normalsize")
+      ((-1) "small")
+      ((-2) "footnotesize")
+      ((-3) "scriptsize")
+      ((-4) "tiny")
+      (else (if (number? size)
+		(if (< size 0) "tiny" "Huge")
+		"normalsize"))))
+
+;*---------------------------------------------------------------------*/
+;*    *skribe-latex-color-table* ...                                   */
+;*---------------------------------------------------------------------*/
+(define *skribe-latex-color-table* #f)
+
+;*---------------------------------------------------------------------*/
+;*    latex-declare-color ...                                          */
+;*---------------------------------------------------------------------*/
+(define (latex-declare-color name rgb)
+   (printf "\\definecolor{~a}{rgb}{~a}\n" name rgb))
+
+;*---------------------------------------------------------------------*/
+;*    skribe-get-latex-color ...                                       */
+;*---------------------------------------------------------------------*/
+(define (skribe-get-latex-color spec)
+   (let ((c (and (hashtable? *skribe-latex-color-table*)
+		 (hashtable-get *skribe-latex-color-table* spec))))
+      (if (not (string? c))
+	  (skribe-error 'latex "Can't find color" spec)
+	  c)))
+
+;*---------------------------------------------------------------------*/
+;*    skribe-color->latex-rgb ...                                      */
+;*---------------------------------------------------------------------*/
+(define (skribe-color->latex-rgb spec)
+   (receive (r g b)
+      (skribe-color->rgb spec)
+      (cond
+	 ((and (= r 0) (= g 0) (= b 0))
+	  "0.,0.,0.")
+	 ((and (= r #xff) (= g #xff) (= b #xff))
+	  "1.,1.,1.")
+	 (else
+	  (let ((ff (exact->inexact #xff)))
+	    (format "~a,~a,~a"
+		    (number->string (/ r ff))
+		    (number->string (/ g ff))
+		    (number->string (/ b ff))))))))
+
+;*---------------------------------------------------------------------*/
+;*    skribe-latex-declare-colors ...                                  */
+;*---------------------------------------------------------------------*/
+(define (skribe-latex-declare-colors colors)
+   (set! *skribe-latex-color-table* (make-hashtable))
+   (for-each (lambda (spec)
+		(let ((old (hashtable-get *skribe-latex-color-table* spec)))
+		   (if (not (string? old))
+		       (let ((name (symbol->string (gensym 'c))))
+			  ;; bind the color 
+			  (hashtable-put! *skribe-latex-color-table* spec name)
+			  ;; and emit a latex declaration
+			  (latex-declare-color 
+			   name 
+			   (skribe-color->latex-rgb spec))))))
+	     colors))
+
+;*---------------------------------------------------------------------*/
+;*    &~ ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer '&~
+   :before "~"
+   :action #f)
+
+;*---------------------------------------------------------------------*/
+;*    &latex-table-start                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-start
+   :options '()
+   :action (lambda (n e)
+	      (let ((width (markup-option n 'width)))
+		 (if (number? width)
+		     (printf "\\begin{tabular*}{~a}" (latex-width width))
+		     (display "\\begin{tabular}")))))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-table-stop                                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-stop
+   :options '()
+   :action (lambda (n e)
+	      (let ((width (markup-option n 'width)))
+		 (if (number? width)
+		 (display "\\end{tabular*}\n")
+		 (display "\\end{tabular}\n")))))
+   
+;*---------------------------------------------------------------------*/
+;*    document ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+   :options '(:title :author :ending :env)
+   :before (lambda (n e)
+	      ;; documentclass
+	      (let ((dc (engine-custom e 'documentclass)))
+		 (if dc
+		     (begin (display dc) (newline))
+		     (display "\\documentclass{article}\n")))
+	      (if (latex-color? e)
+		  (display (engine-custom e 'color-usepackage)))
+	      (if (engine-custom e 'hyperref)
+		  (display (engine-custom e 'hyperref-usepackage)))
+	      ;; usepackage
+	      (let ((pa (engine-custom e 'usepackage)))
+		 (if pa (begin (display pa) (newline))))
+	      ;; colors
+	      (if (latex-color? e)
+		  (begin
+		     (skribe-use-color! (engine-custom e 'source-comment-color))
+		     (skribe-use-color! (engine-custom e 'source-define-color))
+		     (skribe-use-color! (engine-custom e 'source-module-color))
+		     (skribe-use-color! (engine-custom e 'source-markup-color))
+		     (skribe-use-color! (engine-custom e 'source-thread-color))
+		     (skribe-use-color! (engine-custom e 'source-string-color))
+		     (skribe-use-color! (engine-custom e 'source-bracket-color))
+		     (skribe-use-color! (engine-custom e 'source-type-color))
+		     (display "\n%% colors\n")
+		     (skribe-latex-declare-colors (skribe-get-used-colors))
+		     (display "\n\n")))
+	      ;; predocument
+	      (let ((pd (engine-custom e 'predocument)))
+		 (when pd (display pd) (newline)))
+	      ;; title
+	      (let ((t (markup-option n :title)))
+		 (when t
+		    (skribe-eval (new markup
+				    (markup '&latex-title)
+				    (body t))
+				 e
+				 :env `((parent ,n)))))
+	      ;; author
+	      (let ((a (markup-option n :author)))
+		 (when a
+		    (skribe-eval (new markup
+				    (markup '&latex-author)
+				    (body a))
+				 e
+				 :env `((parent ,n)))))
+	      ;; document
+	      (display "\\begin{document}\n")
+	      ;; postdocument
+	      (let ((pd (engine-custom e 'postdocument)))
+		 (if pd (begin (display pd) (newline))))
+	      ;; maketitle
+	      (let ((mt (engine-custom e 'maketitle)))
+		 (if mt (begin (display mt) (newline)))))
+   :action (lambda (n e)
+	      (output (markup-body n) e))
+   :after (lambda (n e)
+	     (display "\n\\end{document}\n")))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-title ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-title
+   :before "\\title{"
+   :after "}\n")
+
+;*---------------------------------------------------------------------*/
+;*    &latex-author ...                                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-author
+   :before "\\author{\\centerline{\n"
+   :action (lambda (n e)
+	      (let ((body (markup-body n)))
+		 (if (pair? body)
+		     (begin
+			(output (new markup
+				   (markup '&latex-table-start)
+				   (class "&latex-author-table"))
+				e)
+			(printf "{~a}\n" (make-string (length body) #\c))
+			(let loop ((as body))
+			   (output (car as) e)
+			   (if (pair? (cdr as))
+			       (begin
+				  (display " & ")
+				  (loop (cdr as)))))
+			(display "\\\\\n")
+			(output (new markup
+				   (markup '&latex-table-stop)
+				   (class "&latex-author-table"))
+				e))
+		     (output body e))))
+   :after "}}\n")
+		 
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :before (lambda (n e)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "author"))
+		      e)
+	      (printf "{~a}\n"
+		      (case (markup-option n :align)
+			 ((left) "l")
+			 ((right) "r")
+			 (else "c"))))
+   :action (lambda (n e)
+	      (let ((name (markup-option n :name))
+		    (title (markup-option n :title))
+		    (affiliation (markup-option n :affiliation))
+		    (email (markup-option n :email))
+		    (url (markup-option n :url))
+		    (address (markup-option n :address))
+		    (phone (markup-option n :phone)))
+		 (define (row n)
+		    (output n e)
+		    (display "\\\\\n"))
+		 ;; name
+		 (if name (row name))
+		 ;; title
+		 (if title (row title))
+		 ;; affiliation
+		 (if affiliation (row affiliation))
+		 ;; address
+		 (cond
+		    ((pair? address)
+		     (for-each row address))
+		    ((string? address)
+		     (row address)))
+		 ;; telephone
+		 (if phone (row phone))
+		 ;; email
+		 (if email (row email))
+		 ;; url
+		 (if url (row url))))
+   :after (lambda (n e)
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "author"))
+		     e)))
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :predicate (lambda (n e) (markup-option n :photo))
+   :before (lambda (n e)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "author"))
+		      e)
+	      (printf "{cc}\n"))
+   :action (lambda (n e)
+	      (let ((photo (markup-option n :photo)))
+		 (output photo e)
+		 (display " & ")
+		 (markup-option-add! n :photo #f)
+		 (output n e)
+		 (markup-option-add! n :photo photo)
+		 (display "\\\\\n")))
+   :after (lambda (n e)
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "author"))
+		     e)))
+
+;*---------------------------------------------------------------------*/
+;*    toc ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'toc
+   :options '()
+   :action (lambda (n e) (display "\\tableofcontents\n")))
+
+;*---------------------------------------------------------------------*/
+;*    latex-block-before ...                                           */
+;*---------------------------------------------------------------------*/
+(define (latex-block-before m)
+   (lambda (n e)
+      (let ((num (markup-option n :number)))
+	 (printf "\n\n%% ~a\n" (string-canonicalize (markup-ident n)))
+	 (printf "\\~a~a{" m (if (not num) "*" ""))
+	 (output (markup-option n :title) latex-title-engine)
+	 (display "}\n")
+	 (when num
+	    (printf "\\label{~a}\n" (string-canonicalize (markup-ident n)))))))
+
+;*---------------------------------------------------------------------*/
+;*    section ... .. @label chapter@                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'chapter
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'chapter))
+
+;*---------------------------------------------------------------------*/
+;*    section ... . @label section@                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'section
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'section))
+
+;*---------------------------------------------------------------------*/
+;*    subsection ... @label subsection@                                */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsection
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'subsection))
+
+;*---------------------------------------------------------------------*/
+;*    subsubsection ... @label subsubsection@                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsubsection
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'subsubsection))
+
+;*---------------------------------------------------------------------*/
+;*    paragraph ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'paragraph
+   :options '(:title :number :toc :env)
+   :before (lambda (n e)
+	      (when (and (>= (skribe-debug) 2) (location? (ast-loc n)))
+		 (printf "\n\\makebox[\\linewidth][l]{\\hspace{-1.5cm}\\footnotesize{$\\triangleright$\\textit{~a}}}\n" 
+			 (ast-location n)))
+	      (display "\\noindent "))
+   :after "\\par\n")
+
+;*---------------------------------------------------------------------*/
+;*    footnote ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'footnote
+   :before "\\footnote{"
+   :after "}")
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'linebreak
+   :action (lambda (n e)
+	      (display "\\makebox[\\linewidth]{}")))
+
+;*---------------------------------------------------------------------*/
+;*    hrule ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'hrule 
+   :options '()
+   :before "\\hrulefill"
+   :action #f)
+
+;*---------------------------------------------------------------------*/
+;*    latex-color-counter                                              */
+;*---------------------------------------------------------------------*/
+(define latex-color-counter 1)
+
+;*---------------------------------------------------------------------*/
+;*    latex-color ...                                                  */
+;*---------------------------------------------------------------------*/
+(define latex-color 
+   (lambda (bg fg n e)
+      (if (not (latex-color? e))
+	  (output n e)
+	  (begin
+	     (if bg
+		 (printf "\\setbox~a \\vbox \\bgroup " latex-color-counter))
+	     (set! latex-color-counter (+ latex-color-counter 1))
+	     (if fg
+		 (begin
+		    (printf "\\textcolor{~a}{" (skribe-get-latex-color fg))
+		    (output n e)
+		    (display "}"))
+		 (output n e))
+	     (set! latex-color-counter (- latex-color-counter 1))
+	     (if bg
+		 (printf "\\egroup\\colorbox{~a}{\\box~a}%\n"
+			 (skribe-get-latex-color bg) latex-color-counter))))))
+   
+;*---------------------------------------------------------------------*/
+;*    color ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'color
+   :options '(:bg :fg :width)
+   :action (lambda (n e) 
+	      (let* ((w (markup-option n :width))
+		     (bg (markup-option n :bg))
+		     (fg (markup-option n :fg))
+		     (m (markup-option n :margin))
+		     (tw (cond
+			    ((not w)
+			     #f)
+			    ((and (integer? w) (exact? w))
+			     w)
+			    ((real? w)
+			     (latex-width w)))))
+		 (when bg 
+		    (display "\\setlength{\\oldcolortabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n")
+		    (when m
+		       (printf "\\addtolength{\\tabcolsep}{~a}" 
+			       (latex-width m)))
+		    (output (new markup
+			       (markup '&latex-table-start)
+			       (class "color"))
+			    e)
+		    (if tw
+			(printf "{p{~a}}\n" tw)
+			(printf "{l}\n")))
+		 (latex-color bg fg (markup-body n) e)
+		 (when bg 
+		    (output (new markup
+			       (markup '&latex-table-stop)
+			       (class "color"))
+			    e)
+		    (display "\\setlength{\\tabcolsep}{\\oldcolortabcolsep}\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'frame
+   :options '(:width :border :margin)
+   :before (lambda (n e)
+	      (display "\\setlength{\\oldframetabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}")
+	      (let ((m (markup-option n :margin)))
+		 (when m
+		    (printf "\\addtolength{\\tabcolsep}{~a}" (latex-width m))))
+	      (newline))
+   :action (lambda (n e) 
+	      (let* ((b (markup-option n :border))
+		     (w (markup-option n :width))
+		     (tw (cond
+			    ((not w)
+			     ".96\\linewidth")
+			    ((and (integer? w) (exact? w))
+			     w)
+			    ((real? w)
+			     (latex-width w)))))
+		 (output (new markup
+			    (markup '&latex-table-start)
+			    (class "frame"))
+			 e)
+		 (if (and (integer? b) (> b 0))
+		     (begin
+			(printf "{|p{~a}|}\\hline\n" tw)
+			(output (markup-body n) e)
+			(display "\\\\\\hline\n"))
+		     (begin
+			(printf "{p{~a}}\n" tw)
+			(output (markup-body n) e)))
+		 (output (new markup
+			    (markup '&latex-table-stop)
+			    (class "author"))
+			 e)))
+   :after "\\setlength{\\tabcolsep}{\\oldframetabcolsep}\n")
+
+;*---------------------------------------------------------------------*/
+;*    font ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'font
+   :options '(:size)
+   :action (lambda (n e) 
+	      (let* ((size (markup-option n :size))
+		     (cs (let ((n (engine-custom e '%font-size)))
+			    (if (number? n)
+				n 
+				0)))
+		     (ns (cond
+			    ((and (integer? size) (exact? size))
+			     (if (> size 0)
+				 size
+				 (+ cs size)))
+			    ((and (number? size) (inexact? size))
+			     (+ cs (inexact->exact size)))
+			    ((string? size)
+			     (let ((nb (string->number size)))
+				(if (not (number? nb))
+				    (skribe-error 
+				     'font
+				     (format "Illegal font size ~s" size)
+				     nb)
+				    (+ cs nb))))))
+		     (ne (make-engine (gensym 'latex)
+				      :delegate e
+				      :filter (engine-filter e)
+				      :symbol-table (engine-symbol-table e)
+				      :custom `((%font-size ,ns)
+						,@(engine-customs e)))))
+		 (printf "{\\~a{" (latex-font-size ns))
+		 (output (markup-body n) ne)
+		 (display "}}"))))
+
+;*---------------------------------------------------------------------*/
+;*    flush ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'flush
+   :options '(:side)
+   :before (lambda (n e)
+	      (case (markup-option n :side)
+		 ((center)
+		  (display "\\begin{center}\n"))
+		 ((left)
+		  (display "\\begin{flushleft}"))
+		 ((right)
+		  (display "\\begin{flushright}"))))
+   :after (lambda (n e)
+	     (case (markup-option n :side)
+		((center)
+		 (display "\\end{center}\n"))
+		((left)
+		 (display "\\end{flushleft}\n"))
+		((right)
+		 (display "\\end{flushright}\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+   :before "\\begin{center}\n"
+   :after "\\end{center}\n")
+
+;*---------------------------------------------------------------------*/
+;*    pre ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'pre
+   :before (lambda (n e)
+	      (printf "\\setlength{\\oldpretabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n{\\setbox~a \\vbox \n\\bgroup\n{\\noindent \\texttt{"
+		      latex-color-counter)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "pre"))
+		      e)
+	      (display "{l}\n")
+	      (set! latex-color-counter (+ latex-color-counter 1)))
+   :action (lambda (n e)
+	      (let ((ne (make-engine
+			   (gensym 'latex)
+			   :delegate e
+			   :filter (make-string-replace latex-pre-encoding)
+			   :symbol-table (engine-symbol-table e)
+			   :custom (engine-customs e))))
+		 (output (markup-body n) ne)))
+   :after (lambda (n e)
+	     (set! latex-color-counter (- latex-color-counter 1))
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "pre"))
+		     e)
+	     (printf "}}\n\\egroup{\\box~a}}%\n\\setlength{\\tabcolsep}{\\oldpretabcolsep}\n" latex-color-counter)))
+
+;*---------------------------------------------------------------------*/
+;*    prog ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'prog
+   :options '(:line :mark)
+   :before (lambda (n e)
+	      (printf "\\setlength{\\oldpretabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n{\\setbox~a \\vbox \\bgroup\n{\\noindent \\texttt{"
+		      latex-color-counter)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "pre"))
+		      e)
+	      (display "{l}\n")
+	      (set! latex-color-counter (+ latex-color-counter 1)))
+   :action (lambda (n e)
+	      (let ((ne (make-engine
+			   (gensym 'latex)
+			   :delegate e
+			   :filter (make-string-replace latex-pre-encoding)
+			   :symbol-table (engine-symbol-table e)
+			   :custom (engine-customs e))))
+		 (output (markup-body n) ne)))
+   :after (lambda (n e)
+	     (set! latex-color-counter (- latex-color-counter 1))
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "prog"))
+		     e)
+	     (printf "}}\n\\egroup{\\box~a}}%\n\\setlength{\\tabcolsep}{\\oldpretabcolsep}\n" latex-color-counter)))
+
+;*---------------------------------------------------------------------*/
+;*    &prog-line ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&prog-line
+   :before (lambda (n e)
+	      (let ((n (markup-ident n)))
+		 (if n (skribe-eval (it (list n) ": ") e))))
+   :after "\\\\\n")
+
+;*---------------------------------------------------------------------*/
+;*    itemize ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'itemize
+   :options '(:symbol)	       
+   :before "\\begin{itemize}\n"
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display " \\item ")
+			   (output item e)
+			   (newline))
+			(markup-body n)))
+   :after "\\end{itemize} ")
+
+(markup-writer 'itemize
+   :predicate (lambda (n e) (markup-option n :symbol))
+   :options '(:symbol)	       
+   :before (lambda (n e)
+	      (display "\\begin{list}{")
+	      (output (markup-option n :symbol) e)
+	      (display "}{}")
+	      (newline))
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display " \\item ")
+			   (output item e)
+			   (newline))
+			(markup-body n)))
+   :after "\\end{list}\n")
+
+;*---------------------------------------------------------------------*/
+;*    enumerate ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'enumerate
+   :options '(:symbol)	       
+   :before "\\begin{enumerate}\n"
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display " \\item ")
+			   (output item e)
+			   (newline))
+			(markup-body n)))
+   :after "\\end{enumerate}\n")
+
+;*---------------------------------------------------------------------*/
+;*    description ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'description
+   :options '(:symbol)	       
+   :before "\\begin{description}\n"
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (let ((k (markup-option item :key)))
+			      (for-each (lambda (i)
+					   (display " \\item[")
+					   (output i e)
+					   (display "]\n"))
+					(if (pair? k) k (list k)))
+			      (output (markup-body item) e)))
+			(markup-body n)))
+   :after "\\end{description}\n")
+
+;*---------------------------------------------------------------------*/
+;*    item ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'item
+   :options '(:key)	       
+   :action (lambda (n e)
+	      (let ((k (markup-option n :key)))
+		 (if k
+		     (begin
+			(display "[")
+			(output k e)
+			(display "] "))))
+	      (output (markup-body n) e)))
+
+;*---------------------------------------------------------------------*/
+;*    blockquote ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'blockquote
+   :before "\n\\begin{quote}\n"
+   :after  "\n\\end{quote}")
+
+;*---------------------------------------------------------------------*/
+;*    figure ... @label figure@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'figure
+   :options '(:legend :number :multicolumns)
+   :action (lambda (n e)
+	      (let ((ident (markup-ident n))
+		    (number (markup-option n :number))
+		    (legend (markup-option n :legend))
+		    (mc (markup-option n :multicolumns)))
+		 (display (if mc
+			      "\\begin{figure*}[!th]\n"
+			      "\\begin{figure}[ht]\n"))
+		 (output (markup-body n) e)
+		 (printf "\\caption{\\label{~a}" (string-canonicalize ident))
+		 (output legend e)
+		 (display (if mc
+			      "}\\end{figure*}\n"
+			      "}\\end{figure}\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    table-column-number ...                                          */
+;*    -------------------------------------------------------------    */
+;*    Computes how many columns are contained in a table.              */
+;*---------------------------------------------------------------------*/
+(define (table-column-number t)
+   (define (row-columns row)
+      (let luup ((cells (markup-body row))
+		 (nbcols 0))
+	 (cond
+	   ((null? cells)
+	     nbcols)
+	   ((pair? cells)
+	    (luup (cdr cells)
+		  (+ nbcols (markup-option (car cells) :colspan))))
+	   (else
+	    (skribe-type-error 'tr "Illegal tr body, " row "pair")))))
+   (let loop ((rows (markup-body t))
+	      (nbcols 0))
+      (if (null? rows)
+	  nbcols
+	  (loop (cdr rows)
+		(max (row-columns (car rows)) nbcols)))))
+
+;*---------------------------------------------------------------------*/
+;*    table ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'table
+   :options '(:width :frame :rules :cellstyle)
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (frame (markup-option n :frame))
+		    (rules (markup-option n :rules))
+		    (cstyle (markup-option n :cellstyle))
+		    (nbcols (table-column-number n))
+		    (id (markup-ident n))
+		    (cla (markup-class n))
+		    (rows (markup-body n)))
+		 ;; the table header
+		 (output (new markup
+			    (markup '&latex-table-start)
+			    (class "table")
+			    (options `((width ,width))))
+			 e)
+		 ;; store the actual number of columns
+		 (markup-option-add! n '&nbcols nbcols)
+		 ;; compute the table header
+		 (let ((cols (cond
+				((= nbcols 0)
+				 (skribe-error 'table
+					       "Illegal empty table"
+					       n))
+				((or (not width) (= nbcols 1))
+				 (make-string nbcols #\c))
+				(else
+				 (let ((v (make-vector 
+					   (- nbcols 1)
+					   "@{\\extracolsep{\\fill}}c")))
+				    (apply string-append
+					   (cons "c" (vector->list v))))))))
+		    (case frame
+		       ((none)
+			(printf "{~a}\n" cols))
+		       ((border box)
+			(printf "{|~a|}" cols)
+			(markup-option-add! n '&lhs #t)
+			(markup-option-add! n '&rhs #t)
+			(output (new markup
+				   (markup '&latex-table-hline)
+				   (parent n)
+				   (ident (format "~a-above" id))
+				   (class "table-line-above"))
+				e))
+		       ((above hsides)
+			(printf "{~a}" cols)
+			(output (new markup
+				   (markup '&latex-table-hline)
+				   (parent n)
+				   (ident (format "~a-above" id))
+				   (class "table-line-above"))
+				e))
+		       ((vsides)
+			(markup-option-add! n '&lhs #t)
+			(markup-option-add! n '&rhs #t)
+			(printf "{|~a|}\n" cols))
+		       ((lhs)
+			(markup-option-add! n '&lhs #t)
+			(printf "{|~a}\n" cols))
+		       ((rhs)
+			(markup-option-add! n '&rhs #t)
+			(printf "{~a|}\n" cols))
+		       (else
+			(printf "{~a}\n" cols)))
+		    ;; mark each row with appropriate '&tl (top-line)
+		    ;; and &bl (bottom-line) options
+		    (when (pair? rows)
+		       (if (and (memq rules '(rows all))
+				(or (not (eq? cstyle 'collapse))
+				    (not (memq frame '(border box above hsides)))))
+			   (let ((frow (car rows)))
+			      (if (is-markup? frow 'tr)
+				  (markup-option-add! frow '&tl #t))))
+		       (if (eq? rules 'header)
+			   (let ((frow (car rows)))
+			      (if (is-markup? frow 'tr)
+				  (markup-option-add! frow '&bl #t))))
+		       (when (and (pair? (cdr rows))
+				  (memq rules '(rows all)))
+			  (for-each (lambda (row)
+				       (if (is-markup? row 'tr)
+					   (markup-option-add! row '&bl #t)))
+				    rows)
+			  (markup-option-add! (car (last-pair rows)) '&bl #f))
+		       (if (and (memq rules '(rows all))
+				(or (not (eq? cstyle 'collapse))
+				    (not (memq frame '(border box above hsides)))))
+			   (let ((lrow (car (last-pair rows))))
+			      (if (is-markup? lrow 'tr)
+				  (markup-option-add! lrow '&bl #t))))))))
+   :after (lambda (n e)
+	     (case (markup-option n :frame)
+		((hsides below box border)
+		 (output (new markup
+			    (markup '&latex-table-hline)
+			    (parent n)
+			    (ident (format "~a-below" (markup-ident n)))
+			    (class "table-hline-below"))
+			 e)))
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "table")
+			(options `((width ,(markup-option n :width)))))
+		     e)))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-table-hline                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-hline
+   :action "\\hline\n")
+
+;*---------------------------------------------------------------------*/
+;*    tr ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tr
+   :options '()
+   :action (lambda (n e)
+	      (let* ((parent (ast-parent n))
+		     (_ (if (not (is-markup? parent 'table))
+			    (skribe-type-error 'tr "Illegal parent, " parent
+					       "#<table>")))
+		     (nbcols (markup-option parent '&nbcols))
+		     (lhs (markup-option parent '&lhs))
+		     (rhs (markup-option parent '&rhs))
+		     (rules (markup-option parent :rules))
+		     (collapse (eq? (markup-option parent :cellstyle) 
+				    'collapse))
+		     (vrules (memq rules '(cols all)))
+		     (cells (markup-body n)))
+		 (if (markup-option n '&tl)
+		     (output (new markup
+				(markup '&latex-table-hline)
+				(parent n)
+				(ident (markup-ident n))
+				(class (markup-class n)))
+			     e))
+		 (if (> nbcols 0)
+		     (let laap ((nbc nbcols)
+				(cs cells))
+			(if (null? cs)
+			    (when (> nbc 1)
+			       (display " & ")
+			       (laap (- nbc 1) cs))
+			    (let* ((c (car cs))
+				   (nc (- nbc (markup-option c :colspan))))
+			       (when (= nbcols nbc)
+				  (cond
+				     ((and lhs vrules (not collapse))
+				      (markup-option-add! c '&lhs "||"))
+				     ((or lhs vrules)
+				      (markup-option-add! c '&lhs #\|))))
+			       (when (= nc 0)
+				  (cond
+				     ((and rhs vrules (not collapse))
+				      (markup-option-add! c '&rhs "||"))
+				     ((or rhs vrules)
+				      (markup-option-add! c '&rhs #\|))))
+			       (when (and vrules (> nc 0) (< nc nbcols))
+				  (markup-option-add! c '&rhs #\|))
+			       (output c e)
+			       (when (> nc 0)
+				  (display " & ")
+				  (laap nc (cdr cs)))))))))
+   :after (lambda (n e)
+	     (display "\\\\")
+	     (if (markup-option n '&bl)
+		 (output (new markup
+			    (markup '&latex-table-hline)
+			    (parent n)
+			    (ident (markup-ident n))
+			    (class (markup-class n)))
+			 e)
+		 (newline))))
+
+;*---------------------------------------------------------------------*/
+;*    tc                                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tc
+   :options '(:width :align :valign :colspan)
+   :action (lambda (n e)
+	      (let ((id (markup-ident n))
+		    (cla (markup-class n)))
+		 (let* ((o0 (markup-body n))
+			(o1 (if (eq? (markup-option n 'markup) 'th)
+				(new markup
+				   (markup '&latex-th)
+				   (parent n)
+				   (ident id)
+				   (class cla)
+				   (options (markup-options n))
+				   (body o0))
+				o0))
+			(o2 (if (markup-option n :width)
+				(new markup
+				   (markup '&latex-tc-parbox)
+				   (parent n)
+				   (ident id)
+				   (class cla)
+				   (options (markup-options n))
+				   (body o1))
+				o1))
+			(o3 (if (or (> (markup-option n :colspan) 1)
+				    (not (eq? (markup-option n :align) 
+					      'center))
+				    (markup-option n '&lhs)
+				    (markup-option n '&rhs))
+				(new markup
+				   (markup '&latex-tc-multicolumn)
+				   (parent n)
+				   (ident id)
+				   (class cla)
+				   (options (markup-options n))
+				   (body o2))
+				o2)))
+		    (output o3 e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-th ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-th
+   :before "\\textsf{"
+   :after "}")
+
+;*---------------------------------------------------------------------*/
+;*    &latex-tc-parbox ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-tc-parbox
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (valign (markup-option n :valign)))
+		 (printf "\\parbox{~a}{" (latex-width width))))
+   :after "}")
+		 
+;*---------------------------------------------------------------------*/
+;*    &latex-tc-multicolumn ...                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-tc-multicolumn
+   :before (lambda (n e)
+	      (let ((colspan (markup-option n :colspan))
+		    (lhs (or (markup-option n '&lhs) ""))
+		    (rhs (or (markup-option n '&rhs) ""))
+		    (align (case (markup-option n :align)
+			      ((left) #\l)
+			      ((center) #\c)
+			      ((right) #\r)
+			      (else #\c))))
+		 (printf "\\multicolumn{~a}{~a~a~a}{" colspan lhs align rhs)))
+   :after "}")
+
+;*---------------------------------------------------------------------*/
+;*    image ... @label image@                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'image
+   :options '(:file :url :width :height :zoom)
+   :action (lambda (n e)
+	      (let* ((file (markup-option n :file))
+		     (url (markup-option n :url))
+		     (width (markup-option n :width))
+		     (height (markup-option n :height))
+		     (zoom (markup-option n :zoom))
+		     (body (markup-body n))
+		     (efmt (engine-custom e 'image-format))
+		     (img (or url (convert-image file 
+						 (if (list? efmt) 
+						     efmt
+						     '("eps"))))))
+		 (if (not (string? img))
+		     (skribe-error 'latex "Illegal image" file)
+		     (begin
+			(printf "\\epsfig{file=~a" (strip-ref-base img))
+			(if width (printf ", width=~a" (latex-width width)))
+			(if height (printf ", height=~apt" height))
+			(if zoom (printf ", zoom=\"~a\"" zoom))
+			(display "}"))))))
+
+;*---------------------------------------------------------------------*/
+;*    Ornaments ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'roman :before "{\\textrm{" :after "}}")
+(markup-writer 'bold :before "{\\textbf{" :after "}}")
+(markup-writer 'underline :before  "{\\underline{" :after "}}")
+(markup-writer 'emph :before "{\\em{" :after "}}")
+(markup-writer 'it :before "{\\textit{" :after "}}")
+(markup-writer 'code :before "{\\texttt{" :after "}}")
+(markup-writer 'var :before "{\\texttt{" :after "}}")
+(markup-writer 'sc :before "{\\sc{" :after "}}")
+(markup-writer 'sf :before "{\\sf{" :after "}}")
+(markup-writer 'sub :before "\\begin{math}\\sb{\\mbox{" :after "}}\\end{math}")
+(markup-writer 'sup :before "\\begin{math}\\sp{\\mbox{" :after "}}\\end{math}")
+
+(markup-writer 'tt
+   :before "{\\texttt{"
+   :action (lambda (n e)
+	      (let ((ne (make-engine
+			   (gensym 'latex)
+			   :delegate e
+			   :filter (make-string-replace latex-tt-encoding)
+			   :custom (engine-customs e)
+			   :symbol-table (engine-symbol-table e))))
+		 (output (markup-body n) ne)))
+   :after "}}")
+
+;*---------------------------------------------------------------------*/
+;*    q ... @label q@                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'q
+   :before "``"
+   :after "''")
+
+;*---------------------------------------------------------------------*/
+;*    mailto ... @label mailto@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+   :options '(:text)
+   :before "{\\texttt{"
+   :action (lambda (n e)
+	      (let ((text (markup-option n :text)))
+		 (output (or text (markup-body n)) e)))
+   :after "}}")
+
+;*---------------------------------------------------------------------*/
+;*    mark ... @label mark@                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mark
+   :before (lambda (n e)
+	      (printf "\\label{~a}" (string-canonicalize (markup-ident n)))))
+
+;*---------------------------------------------------------------------*/
+;*    ref ... @label ref@                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer 'ref
+   :options '(:text :chapter :section :subsection :subsubsection :figure :mark :handle :page)
+   :action (lambda (n e)
+	      (let ((t (markup-option n :text)))
+		 (if t
+		     (begin
+			(output t e)
+			(output "~" e (markup-writer-get '&~ e))))))
+   :after (lambda (n e)
+	     (let* ((c (handle-ast (markup-body n)))
+		    (id (markup-ident c)))
+		(if (markup-option n :page)
+		    (printf "\\begin{math}{\\pageref{~a}}\\end{math}" 
+			    (string-canonicalize id))
+		    (printf "\\ref{~a}" 
+			    (string-canonicalize id))))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e)
+	      (output (markup-option (handle-ast (markup-body n)) :title) e))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref+ ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref+
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e) 
+	      (let loop ((rs (markup-body n)))
+		 (cond
+		    ((null? rs)
+		     #f)
+		    (else
+		     (if (is-markup? (car rs) 'bib-ref)
+			 (invoke (writer-action (markup-writer-get 'bib-ref e))
+				 (car rs)
+				 e)
+			 (output (car rs) e))
+		     (if (pair? (cdr rs))
+			 (begin
+			    (display ",")
+			    (loop (cdr rs))))))))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    url-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :action (lambda (n e) 
+	      (let ((text (markup-option n :text))
+		    (url (markup-option n :url)))
+		 (if (not text)
+		     (output url e)
+		     (output text e)))))
+
+;*---------------------------------------------------------------------*/
+;*    url-ref hyperref ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :predicate (lambda (n e)
+		 (engine-custom e 'hyperref))
+   :action (lambda (n e) 
+	      (let ((body (markup-option n :text))
+		    (url (markup-option n :url)))
+		 (if (and body (not (equal? body url)))
+		     (begin
+			(display "\\href{")
+			(display url)
+			(display "}{")
+			(output body e)
+			(display "}"))
+		     (begin
+			(display "\\href{")
+			(display url)
+			(printf "}{~a}" url))))))
+
+;*---------------------------------------------------------------------*/
+;*    line-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+   :options '(:offset)
+   :before "{\\textit{"
+   :action (lambda (n e)
+	      (let ((o (markup-option n :offset))
+		    (v (string->number (markup-option n :text))))
+		 (cond
+		    ((and (number? o) (number? v))
+		     (display (+ o v)))
+		    (else
+		     (display v)))))
+   :after "}}")
+
+;*---------------------------------------------------------------------*/
+;*    &the-bibliography ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-bibliography
+   :before (lambda (n e)
+	      (display "{%
+\\sloppy
+\\sfcode`\\.=1000\\relax
+\\newdimen\\bibindent
+\\bibindent=0em
+\\begin{list}{}{%
+        \\settowidth\\labelwidth{[21]}%
+        \\leftmargin\\labelwidth
+        \\advance\\leftmargin\\labelsep
+        \\advance\\leftmargin\\bibindent
+        \\itemindent -\\bibindent
+        \\listparindent \\itemindent
+        \\itemsep 0pt
+    }%\n"))
+   :after (lambda (n e)
+	     (display "\n\\end{list}}\n")))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry
+   :options '(:title)
+   :action (lambda (n e)
+	      (output n e (markup-writer-get '&bib-entry-label e))
+	      (output n e (markup-writer-get '&bib-entry-body e)))
+   :after "\n")
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-title ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+   :predicate (lambda (n e)
+		 (engine-custom e 'hyperref))
+   :action (lambda (n e)
+	      (let* ((t (bold (markup-body n)))
+		     (en (handle-ast (ast-parent n)))
+		     (url (markup-option en 'url))
+		     (ht (if url (ref :url (markup-body url) :text t) t)))
+		 (skribe-eval ht e))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-label ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before "\\item[{\\char91}"
+   :action (lambda (n e) (output (markup-option n :title) e))
+   :after "{\\char93}] ")
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-url ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-url
+   :action (lambda (n e)
+	      (let* ((en (handle-ast (ast-parent n)))
+		     (url (markup-option en 'url))
+		     (t (bold (markup-body url))))
+		 (skribe-eval (ref :url (markup-body url) :text t) e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-comment ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (it (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+	      
+;*---------------------------------------------------------------------*/
+;*    &source-line-comment ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-line-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+	      
+;*---------------------------------------------------------------------*/
+;*    &source-keyword ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-keyword
+   :action (lambda (n e)
+	      (skribe-eval (underline (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &source-error ...                                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-error
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-error-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'error-color) cc)
+			     (color :fg cc (underline n1))
+			     (underline n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-define ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-define
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-define-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-module ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-module
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-module-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-markup ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-markup
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-markup-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-thread ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-thread
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-thread-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-string ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-string
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-string-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-bracket ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-bracket
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-bracket-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-type ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-key ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-key
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-type ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg "red" (bold n1))
+			     (bold n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
-- 
cgit v1.2.3