summary refs log tree commit diff
path: root/skr
diff options
context:
space:
mode:
authorLudovic Court`es2005-06-15 13:00:39 +0000
committerLudovic Court`es2005-06-15 13:00:39 +0000
commitfc42fe56a57eace2dbdb31574c2e161f0eacf839 (patch)
tree18111570156cb0e3df0d81c8d104517a2263fd2c /skr
downloadskribilo-fc42fe56a57eace2dbdb31574c2e161f0eacf839.tar.gz
skribilo-fc42fe56a57eace2dbdb31574c2e161f0eacf839.tar.lz
skribilo-fc42fe56a57eace2dbdb31574c2e161f0eacf839.zip
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
Diffstat (limited to 'skr')
-rw-r--r--skr/Makefile43
-rw-r--r--skr/acmproc.skr155
-rw-r--r--skr/base.skr464
-rw-r--r--skr/context.skr1380
-rw-r--r--skr/french.skr19
-rw-r--r--skr/html.skr2251
-rw-r--r--skr/html4.skr165
-rw-r--r--skr/jfp.skr317
-rw-r--r--skr/latex-simple.skr101
-rw-r--r--skr/latex.skr1780
-rw-r--r--skr/letter.skr146
-rw-r--r--skr/lncs.skr147
-rw-r--r--skr/scribe.skr229
-rw-r--r--skr/sigplan.skr155
-rw-r--r--skr/skribe.skr76
-rw-r--r--skr/slide.skr664
-rw-r--r--skr/web-article.skr230
-rw-r--r--skr/web-book.skr107
-rw-r--r--skr/xml.skr111
19 files changed, 8540 insertions, 0 deletions
diff --git a/skr/Makefile b/skr/Makefile
new file mode 100644
index 0000000..dcc3e77
--- /dev/null
+++ b/skr/Makefile
@@ -0,0 +1,43 @@
+#*=====================================================================*/
+#*    serrano/prgm/project/skribe/skr/Makefile                         */
+#*    -------------------------------------------------------------    */
+#*    Author      :  Manuel Serrano                                    */
+#*    Creation    :  Sat Oct 25 08:21:20 2003                          */
+#*    Last change :  Wed May 18 15:34:21 2005 (serrano)                */
+#*    Copyright   :  2003-05 Manuel Serrano                            */
+#*    -------------------------------------------------------------    */
+#*    The Skribe SKR Makefile                                          */
+#*=====================================================================*/
+include ../etc/Makefile.config
+include ../etc/$(SYSTEM)/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#*    POPULATION                                                       */
+#*---------------------------------------------------------------------*/
+POPULATION= acmproc.skr sigplan.skr jfp.skr \
+            slide.skr web-book.skr web-article.skr \
+	    base.skr latex.skr scribe.skr xml.skr \
+	    html.skr html4.skr lncs.skr skribe.skr \
+	    letter.skr french.skr latex-simple.skr context.skr Makefile
+
+#*---------------------------------------------------------------------*/
+#*    pop                                                              */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+	@ echo $(POPULATION:%=skr/%)
+
+#*---------------------------------------------------------------------*/
+#*    Install/Uinstall                                                 */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install: $(DESTDIR)$(INSTALL_SKRDIR)
+	cp *.skr $(DESTDIR)$(INSTALL_SKRDIR) && chmod $(BMASK) $(DESTDIR)$(INSTALL_SKRDIR)/*
+
+uninstall:
+
+$(DESTDIR)$(INSTALL_SKRDIR):
+	mkdir -p $(DESTDIR)$(INSTALL_SKRDIR) && chmod a+rx $(DESTDIR)$(INSTALL_SKRDIR)
+
diff --git a/skr/acmproc.skr b/skr/acmproc.skr
new file mode 100644
index 0000000..4accc7c
--- /dev/null
+++ b/skr/acmproc.skr
@@ -0,0 +1,155 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/acmproc.skr                      */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sun Sep 28 14:40:38 2003                          */
+;*    Last change :  Thu Jun  2 10:55:39 2005 (serrano)                */
+;*    Copyright   :  2003-05 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Skribe style for ACMPROC articles.                           */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le
+		       'documentclass
+		       "\\documentclass[letterpaper]{acmproc}")
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :before (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (printf "\\numberofauthors{~a}\n\\author{\n"
+			    (if (pair? body) (length body) 1))))
+      :action (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (for-each (lambda (a)
+				 (display "\\alignauthor\n")
+				 (output a e))
+			      (if (pair? body) body (list body)))))
+      :after "}\n")
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (writer-action old-author)))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category le
+      :options '(:index :section :subsection)
+      :before (lambda (n e)
+		 (display "\\category{")
+		 (display (markup-option n :index))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :section))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :subsection))
+		 (display "}\n["))
+      :after "]\n")
+   (markup-writer '&acm-terms le
+      :before "\\terms{"
+      :after "}")
+   (markup-writer '&acm-keywords le
+      :before "\\keywords{"
+      :after "}")
+   (markup-writer '&acm-copyright le
+      :action (lambda (n e)
+		 (display "\\conferenceinfo{")
+		 (output (markup-option n :conference) e)
+		 (display ",} {")
+		 (output (markup-option n :location) e)
+		 (display "}\n")
+		 (display "\\CopyrightYear{")
+		 (output (markup-option n :year) e)
+		 (display "}\n")
+		 (display "\\crdata{")
+		 (output (markup-option n :crdata) e)
+		 (display "}\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-acmproc-abstract he
+      :action (lambda (n e)
+		 (let* ((ebg (engine-custom e 'abstract-background))
+			(bg (or (and (string? ebg) 
+				     (> (string-length ebg) 0))
+				ebg
+				"#cccccc"))
+			(exp (p (center (color :bg bg :width 90. 
+					   (markup-body n))))))
+		    (skribe-eval exp e))))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category :action #f)
+   (markup-writer '&acm-terms :action #f)
+   (markup-writer '&acm-keywords :action #f)
+   (markup-writer '&acm-copyright :action #f))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key (class "abstract") postscript)
+   (if (engine-format? "latex")
+       (section :number #f :title "ABSTRACT" (p (the-body opt)))
+       (let ((a (new markup
+		   (markup '&html-acmproc-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+		       postscript))
+		(section :number #f :toc #f :class class :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+		   (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-category ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-category #!rest opt #!key index section subsection)
+   (new markup
+      (markup '&acm-category)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-terms ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-terms #!rest opt)
+   (new markup
+      (markup '&acm-terms)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-keywords ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-keywords #!rest opt)
+   (new markup
+      (markup '&acm-keywords)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-copyright ...                                                */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-copyright #!rest opt #!key conference location year crdata)
+   (let* ((le (find-engine 'latex))
+	  (cop (format "\\conferenceinfo{~a,} {~a}
+\\CopyrightYear{~a}
+\\crdata{~a}\n" conference location year crdata))
+	  (old (engine-custom le 'predocument)))
+      (if (string? old)
+	  (engine-custom-set! le 'predocument (string-append cop old))
+	  (engine-custom-set! le 'predocument cop))))
+   
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (if (engine-format? "latex")
+	     (font :size -1 (flush :side 'left (the-bibliography)))
+	     (section :title "References"
+                      (font :size -1 (the-bibliography))))))
diff --git a/skr/base.skr b/skr/base.skr
new file mode 100644
index 0000000..ec987ec
--- /dev/null
+++ b/skr/base.skr
@@ -0,0 +1,464 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/base.skr                         */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sat Jul 26 12:39:30 2003                          */
+;*    Last change :  Wed Oct 27 11:24:20 2004 (eg)                     */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    BASE Skribe engine                                               */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    base-engine ...                                                  */
+;*---------------------------------------------------------------------*/
+(define base-engine
+   (default-engine-set!
+      (make-engine 'base
+		   :version 'plain
+		   :symbol-table '(("iexcl" "!")
+				   ("cent" "c")
+				   ("lguillemet" "\"")
+				   ("not" "!")
+				   ("registered" "(r)")
+				   ("degree" "o")
+				   ("plusminus" "+/-")
+				   ("micro" "o")
+				   ("paragraph" "p")
+				   ("middot" ".")
+				   ("rguillemet" "\"")
+				   ("iquestion" "?")
+				   ("Agrave" "À")
+				   ("Aacute" "A")
+				   ("Acircumflex" "Â")
+				   ("Atilde" "A")
+				   ("Amul" "A")
+				   ("Aring" "A")
+				   ("AEligature" "AE")
+				   ("Oeligature" "OE")
+				   ("Ccedilla" "Ç")
+				   ("Egrave" "È")
+				   ("Eacute" "É")
+				   ("Ecircumflex" "Ê")
+				   ("Euml" "E")
+				   ("Igrave" "I")
+				   ("Iacute" "I")
+				   ("Icircumflex" "Î")
+				   ("Iuml" "I")
+				   ("ETH" "D")
+				   ("Ntilde" "N")
+				   ("Ograve" "O")
+				   ("Oacute" "O")
+				   ("Ocurcumflex" "O")
+				   ("Otilde" "O")
+				   ("Ouml" "O")
+				   ("times" "x")
+				   ("Oslash" "O")
+				   ("Ugrave" "Ù")
+				   ("Uacute" "U")
+				   ("Ucircumflex" "Û")
+				   ("Uuml" "Ü")
+				   ("Yacute" "Y")
+				   ("agrave" "à")
+				   ("aacute" "a")
+				   ("acircumflex" "â")
+				   ("atilde" "a")
+				   ("amul" "a")
+				   ("aring" "a")
+				   ("aeligature" "æ")
+				   ("oeligature" "oe")
+				   ("ccedilla" "ç")
+				   ("egrave" "è")
+				   ("eacute" "é")
+				   ("ecircumflex" "ê")
+				   ("euml" "e")
+				   ("igrave" "i")
+				   ("iacute" "i")
+				   ("icircumflex" "î")
+				   ("iuml" "i")
+				   ("ntilde" "n")
+				   ("ograve" "o")
+				   ("oacute" "o")
+				   ("ocurcumflex" "o")
+				   ("otilde" "o")
+				   ("ouml" "o")
+				   ("divide" "/")
+				   ("oslash" "o")
+				   ("ugrave" "ù")
+				   ("uacute" "u")
+				   ("ucircumflex" "û")
+				   ("uuml" "ü")
+				   ("yacute" "y")
+				   ("ymul" "y")
+				   ;; punctuation
+				   ("bullet" ".")
+				   ("ellipsis" "...")
+				   ("<-" "<-")
+				   ("<--" "<--")
+				   ("uparrow" "^;")
+				   ("->" "->")
+				   ("-->" "-->")
+				   ("downarrow" "v")
+				   ("<->" "<->")
+				   ("<-->" "<-->")
+				   ("<+" "<+")
+				   ("<=" "<=;")
+				   ("<==" "<==")
+				   ("Uparrow" "^")
+				   ("=>" "=>")
+				   ("==>" "==>")
+				   ("Downarrow" "v")
+				   ("<=>" "<=>")
+				   ("<==>" "<==>")
+				   ;; Mathematical operators 
+				   ("asterisk" "*")
+				   ("angle" "<")
+				   ("and" "^;")
+				   ("or" "v")
+				   ("models" "|=")
+				   ("vdash" "|-")
+				   ("dashv" "-|")
+				   ("sim" "~")
+				   ("mid" "|")
+				   ("langle" "<")
+				   ("rangle" ">")
+				   ;; LaTeX 
+				   ("circ" "o")
+				   ("top" "T")
+				   ("lhd" "<")
+				   ("rhd" ">")
+				   ("parallel" "||")))))
+   
+;*---------------------------------------------------------------------*/
+;*    mark ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'symbol
+   :action (lambda (n e)
+	      (let* ((s (markup-body n))
+		     (c (assoc s (engine-symbol-table e))))
+		 (if (pair? c)
+		     (display (cadr c))
+		     (output s e)))))
+
+;*---------------------------------------------------------------------*/
+;*    unref ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'unref
+   :options 'all
+   :action (lambda (n e)
+	      (let* ((s (markup-option n :skribe))
+		     (k (markup-option n 'kind))
+		     (f (cond
+			   (s
+			    (format "?~a@~a " k s))
+			   (else
+			    (format "?~a " k))))
+		     (msg (list f (markup-body n)))
+		     (n (list "[" (color :fg "red" (bold msg)) "]")))
+		 (skribe-eval n e))))
+
+;*---------------------------------------------------------------------*/
+;*    &the-bibliography ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-bibliography
+   :before (lambda (n e)
+	      (let ((w (markup-writer-get 'table e)))
+		 (and (writer? w) (invoke (writer-before w) n e))))
+   :action (lambda (n e)
+	      (when (pair? (markup-body n))
+		 (for-each (lambda (i) (output i e)) (markup-body n))))
+   :after (lambda (n e)
+	     (let ((w (markup-writer-get 'table e)))
+		(and (writer? w) (invoke (writer-after w) n e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry
+   :options '(:title)
+   :before (lambda (n e)
+	      (invoke (writer-before (markup-writer-get 'tr e)) n e))
+   :action (lambda (n e)
+	      (let ((wtc (markup-writer-get 'tc e)))
+		 ;; the label
+		 (markup-option-add! n :valign 'top)
+		 (markup-option-add! n :align 'right)
+		 (invoke (writer-before wtc) n e)
+		 (output n e (markup-writer-get '&bib-entry-label e))
+		 (invoke (writer-after wtc) n e)
+		 ;; the body
+		 (markup-option-add! n :valign 'top)
+		 (markup-option-add! n :align 'left)
+		 (invoke (writer-before wtc) n e)
+		 (output n e (markup-writer-get '&bib-entry-body))
+		 (invoke (writer-after wtc) n e)))
+   :after (lambda (n e)
+	     (invoke (writer-after (markup-writer-get 'tr e)) n e)))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-label ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before "["
+   :action (lambda (n e) (output (markup-option n :title) e))
+   :after "]")
+	     
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-body ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-body
+   :action (lambda (n e)
+	      (define (output-fields descr)
+		 (let loop ((descr descr)
+			    (pending #f)
+			    (armed #f))
+		    (cond
+		       ((null? descr)
+			'done)
+		       ((pair? (car descr))
+			(if (eq? (caar descr) 'or)
+			    (let ((o1 (cadr (car descr))))
+			       (if (markup-option n o1)
+				   (loop (cons o1 (cdr descr)) 
+					 pending 
+					 #t)
+				   (let ((o2 (caddr (car descr))))
+				      (loop (cons o2 (cdr descr)) 
+					    pending
+					    armed))))
+			    (let ((o (markup-option n (cadr (car descr)))))
+			       (if o
+				   (begin
+				      (if (and pending armed)
+					  (output pending e))
+				      (output (caar descr) e)
+				      (output o e)
+				      (if (pair? (cddr (car descr)))
+					  (output (caddr (car descr)) e))
+				      (loop (cdr descr) #f #t))
+				   (loop (cdr descr) pending armed)))))
+		       ((symbol? (car descr))
+			(let ((o (markup-option n (car descr))))
+			   (if o 
+			       (begin
+				  (if (and armed pending)
+				      (output pending e))
+				  (output o e)
+				  (loop (cdr descr) #f #t))
+			       (loop (cdr descr) pending armed))))
+		       ((null? (cdr descr))
+			(output (car descr) e))
+		       ((string? (car descr))
+			(loop (cdr descr) 
+			      (if pending pending (car descr))
+			      armed))
+		       (else
+			(skribe-error 'output-bib-fields
+				      "Illegal description"
+				      (car descr))))))
+	      (output-fields
+	       (case (markup-option n 'kind)
+		  ((techreport)
+		   `(author " -- " (or title url documenturl) " -- " 
+			    number ", " institution ", "
+			    address ", " month ", " year ", " 
+			    ("pp. " pages) "."))
+		  ((article)
+		   `(author " -- " (or title url documenturl) " -- " 
+			    journal ", " volume "" ("(" number ")") ", "
+			    address ", " month ", " year ", "
+			    ("pp. " pages) "."))
+		  ((inproceedings)
+		   `(author " -- " (or title url documenturl) " -- " 
+			    booktitle ", " series ", " ("(" number ")") ", "
+			    address ", " month ", " year ", "
+			    ("pp. " pages) "."))
+		  ((book)
+		   '(author " -- " (or title url documenturl) " -- " 
+			    publisher ", " address
+			    ", " month ", " year ", " ("pp. " pages) "."))
+		  ((phdthesis)
+		   '(author " -- " (or title url documenturl) " -- " type ", " 
+			    school ", " address
+			    ", " month ", " year"."))
+		  ((misc)
+		   '(author " -- " (or title url documenturl) " -- "
+			    publisher ", " address
+			    ", " month ", " year"."))
+		  (else
+		   '(author " -- " (or title url documenturl) " -- "
+			    publisher ", " address
+			    ", " month ", " year ", " ("pp. " pages) "."))))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-ident ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-ident
+   :action (lambda (n e)
+	      (output (markup-option n 'number) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-title ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+   :action (lambda (n e)
+	      (skribe-eval (bold (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-publisher ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-publisher
+   :action (lambda (n e)
+	      (skribe-eval (it (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &the-index ...  @label the-index@                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index
+   :options '(:column)
+   :before (lambda (n e)
+	      (output (markup-option n 'header) e))
+   :action (lambda (n e)
+	      (define (make-mark-entry n fst)
+		 (let ((l (tr :class 'index-mark-entry
+			     (td :colspan 2 :align 'left 
+				(bold (it (sf n)))))))
+		    (if fst
+			(list l)
+			(list (tr (td :colspan 2)) l))))
+	      (define (make-primary-entry n p)
+		 (let* ((note (markup-option n :note))
+			(b (markup-body n))
+			(c (if note 
+			       (list b
+				     (it (list " (" note ")")))
+			       b)))
+		    (when p 
+		       (markup-option-add! b :text 
+					   (list (markup-option b :text) 
+						 ", p."))
+		       (markup-option-add! b :page #t))
+		    (tr :class 'index-primary-entry
+		       (td :colspan 2 :valign 'top :align 'left c))))
+	      (define (make-secondary-entry n p)
+		 (let* ((note (markup-option n :note))
+			(b (markup-body n))
+			(bb (markup-body b)))
+		    (cond
+		       ((not (or bb (is-markup? b 'url-ref)))
+			(skribe-error 'the-index 
+				      "Illegal entry"
+				      b))
+		       (note
+			(let ((r (if bb
+				     (it (ref :class "the-index-secondary"
+					    :handle bb
+					    :page p
+					    :text (if p 
+						      (list note ", p.")
+						      note)))
+				     (it (ref :class "the-index-secondary"
+					    :url (markup-option b :url)
+					    :page p
+					    :text (if p 
+						      (list note ", p.")
+						      note))))))
+			   (tr :class 'index-secondary-entry
+			      (td :valign 'top :align 'right :width 1. " ...")
+			      (td :valign 'top :align 'left r))))
+		       (else
+			(let ((r (if bb
+				     (ref :class "the-index-secondary"
+					:handle bb 
+					:page p 
+					:text (if p " ..., p." " ..."))
+				     (ref :class "the-index-secondary"
+					:url (markup-option b :url)
+					:page p 
+					:text (if p " ..., p." " ...")))))
+			   (tr :class 'index-secondary-entry
+			      (td :valign 'top :align 'right :width 1.)
+			      (td :valign 'top :align 'left r)))))))
+	      (define (make-column ie p)
+		 (let loop ((ie ie)
+			    (f #t))
+		    (cond
+		       ((null? ie)
+			'())
+		       ((not (pair? (car ie)))
+			(append (make-mark-entry (car ie) f) 
+				(loop (cdr ie) #f)))
+		       (else
+			(cons (make-primary-entry (caar ie) p)
+			      (append (map (lambda (x) 
+					      (make-secondary-entry x p))
+					   (cdar ie))
+				      (loop (cdr ie) #f)))))))
+	      (define (make-sub-tables ie nc p)
+		 (let* ((l (length ie))
+			(w (/ 100. nc))
+			(iepc (let ((d (/ l nc)))
+				 (if (integer? d) 
+				     (inexact->exact d)
+				     (+ 1 (inexact->exact (truncate d))))))
+			(split (list-split ie iepc)))
+		    (tr (map (lambda (ies)
+				(td :valign 'top :width w
+				   (if (pair? ies)
+				       (table :width 100. (make-column ies p))
+				       "")))
+			     split))))
+	      (let* ((ie (markup-body n))
+		     (nc (markup-option n :column))
+		     (loc (ast-loc n))
+		     (pref (eq? (engine-custom e 'index-page-ref) #t))
+		     (t (cond
+			   ((null? ie)
+			    "")
+			   ((or (not (integer? nc)) (= nc 1))
+			    (table :width 100. 
+			       :&skribe-eval-location loc 
+			       :class "index-table"
+			       (make-column ie pref)))
+			   (else
+			    (table :width 100.
+			       :&skribe-eval-location loc 
+			       :class "index-table"
+			       (make-sub-tables ie nc pref))))))
+		 (output (skribe-eval t e) e))))
+
+;*---------------------------------------------------------------------*/
+;*    &the-index-header ...                                            */
+;*    -------------------------------------------------------------    */
+;*    The index header is only useful for targets that support         */
+;*    hyperlinks such as HTML.                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index-header 
+   :action (lambda (n e) #f))
+
+;*---------------------------------------------------------------------*/
+;*    &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")
+
+;*---------------------------------------------------------------------*/
+;*    line-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+   :options '(:offset)
+   :action (lambda (n e)
+	      (let ((o (markup-option n :offset))
+		    (n (markup-ident (handle-body (markup-body n)))))
+		 (skribe-eval (it (if (integer? o) (+ o n) n)) e))))
+
+
+
+;;;; A VIRER (mais handle-body n'est pas défini)
+(markup-writer 'line-ref
+   :options '(:offset)
+   :action #f)
diff --git a/skr/context.skr b/skr/context.skr
new file mode 100644
index 0000000..5bc5316
--- /dev/null
+++ b/skr/context.skr
@@ -0,0 +1,1380 @@
+;;;;
+;;;; context.skr	-- ConTeXt mode for Skribe
+;;;; 
+;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;; 
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
+;;;; USA.
+;;;; 
+;;;;           Author: Erick Gallesio [eg@essi.fr]
+;;;;    Creation date: 23-Sep-2004 17:21 (eg)
+;;;; Last file update:  3-Nov-2004 12:54 (eg)
+;;;;
+
+;;;; ======================================================================
+;;;; 	context-customs ...
+;;;; ======================================================================
+(define context-customs
+  '((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")
+    (index-page-ref #t)
+    (image-format ("jpg"))
+    (font-size 11)
+    (font-type "roman")
+    (user-style #f)
+    (document-style "book")))
+
+;;;; ======================================================================
+;;;; 	context-encoding ...
+;;;; ======================================================================
+(define context-encoding 
+  '((#\# "\\type{#}")
+    (#\| "\\type{|}")
+    (#\{ "$\\{$")
+    (#\} "$\\}$")
+    (#\~ "\\type{~}")
+    (#\& "\\type{&}")
+    (#\_ "\\type{_}")
+    (#\^ "\\type{^}")
+    (#\[ "\\type{[}")
+    (#\] "\\type{]}")
+    (#\< "\\type{<}")
+    (#\> "\\type{>}")
+    (#\$ "\\type{$}")
+    (#\% "\\%")
+    (#\\ "$\\backslash$")))
+
+;;;; ======================================================================
+;;;; 	context-pre-encoding ...
+;;;; ======================================================================
+(define context-pre-encoding 
+  (append '((#\space "~")
+	    (#\~ "\\type{~}"))
+	  context-encoding))
+
+
+;;;; ======================================================================
+;;;; 	context-symbol-table ...
+;;;; ======================================================================
+(define (context-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{}")
+     ;; ConTeXt
+     ("dag" "\\dag")
+     ("ddag" "\\ddag")
+     ("circ" ,(math "\\circ"))
+     ("top" ,(math "\\top"))
+     ("bottom" ,(math "\\bot"))
+     ("lhd" ,(math "\\triangleleft"))
+     ("rhd" ,(math "\\triangleright"))
+     ("parallel" ,(math "\\parallel"))))
+
+;;;; ======================================================================
+;;;;	context-width
+;;;; ======================================================================
+(define (context-width width)
+  (cond 
+    ((string? width) 
+     width)
+    ((and (number? width) (inexact? width))
+     (string-append (number->string (/ width 100.)) "\\textwidth"))
+    (else 
+     (string-append (number->string width) "pt"))))
+
+;;;; ======================================================================
+;;;;	context-dim
+;;;; ======================================================================
+(define (context-dim dimension)
+  (cond 
+    ((string? dimension) 
+     dimension)
+    ((number? dimension)
+     (string-append (number->string (inexact->exact (round dimension))) 
+		    "pt"))))
+
+;;;; ======================================================================
+;;;;	context-url
+;;;; ======================================================================
+(define(context-url url text e)
+  (let ((name (gensym 'url))
+	(text (or text url)))
+    (printf "\\useURL[~A][~A][][" name url)
+    (output text e)
+    (printf "]\\from[~A]" name)))
+
+;;;; ======================================================================
+;;;;	Color Management ...
+;;;; ======================================================================
+(define *skribe-context-color-table* (make-hashtable))
+
+(define (skribe-color->context-color spec)
+  (receive (r g b)
+     (skribe-color->rgb spec)
+     (let ((ff (exact->inexact #xff)))
+       (format "r=~a,g=~a,b=~a"
+	       (number->string (/ r ff))
+	       (number->string (/ g ff))
+	       (number->string (/ b ff))))))
+
+
+(define (skribe-declare-used-colors)
+  (printf "\n%%Colors\n")
+  (for-each (lambda (spec)
+	      (let ((c (hashtable-get *skribe-context-color-table* spec)))
+		(unless (string? c)
+		  ;; Color was never used before
+		  (let ((name (symbol->string (gensym 'col))))
+		    (hashtable-put! *skribe-context-color-table* spec name)
+		    (printf "\\definecolor[~A][~A]\n" 
+			    name 
+			    (skribe-color->context-color spec))))))
+	    (skribe-get-used-colors))
+  (newline))
+
+(define (skribe-declare-standard-colors engine)
+  (for-each (lambda (x) 
+	      (skribe-use-color! (engine-custom engine x)))
+	    '(source-comment-color source-define-color source-module-color  
+	      source-markup-color  source-thread-color source-string-color
+	      source-bracket-color source-type-color)))
+
+(define (skribe-get-color spec)
+  (let ((c (and (hashtable? *skribe-context-color-table*)
+		(hashtable-get *skribe-context-color-table* spec))))
+    (if (not (string? c))
+	(skribe-error 'context "Can't find color" spec)
+	c)))
+
+;;;; ======================================================================
+;;;; 	context-engine ...
+;;;; ======================================================================
+(define context-engine
+   (default-engine-set!
+      (make-engine 'context
+	 :version 1.0
+	 :format "context"
+	 :delegate (find-engine 'base)
+	 :filter (make-string-replace context-encoding)
+	 :symbol-table (context-symbol-table (lambda (m) (format "$~a$" m)))
+	 :custom context-customs)))
+
+;;;; ======================================================================
+;;;; 	document ...
+;;;; ======================================================================
+(markup-writer 'document
+   :options '(:title :subtitle :author :ending :env)
+   :before (lambda (n e)
+	     ;; Prelude
+	     (printf "% interface=en output=pdftex\n")
+	     (display "%%%% -*- TeX -*-\n")
+	     (printf "%%%% File automatically generated by Skribe ~A on ~A\n\n"
+		     (skribe-release) (date))
+	     ;; Make URLs active
+	     (printf "\\setupinteraction[state=start]\n")
+	     ;; Choose the document font 
+	     (printf "\\setupbodyfont[~a,~apt]\n" (engine-custom e 'font-type) 
+		     (engine-custom e 'font-size))
+	     ;; Color 
+	     (display "\\setupcolors[state=start]\n")
+	     ;; Load Style
+	     (printf "\\input skribe-context-~a.tex\n" 
+		     (engine-custom e 'document-style))
+	     ;; Insert User customization
+	     (let ((s (engine-custom e 'user-style)))
+	       (when s (printf "\\input ~a\n" s)))
+	     ;; Output used colors
+	     (skribe-declare-standard-colors e)
+	     (skribe-declare-used-colors)
+	     
+	     (display "\\starttext\n\\StartTitlePage\n")
+	     ;; title
+	     (let ((t (markup-option n :title)))
+	       (when t
+		 (skribe-eval (new markup 
+				   (markup '&context-title) 
+				   (body t)
+				   (options 
+				      `((subtitle ,(markup-option n :subtitle)))))
+			      e
+			      :env `((parent ,n)))))
+	     ;; author(s)
+	     (let ((a (markup-option n :author)))
+	       (when a
+		 (if (list? a)
+		     ;; List of authors. Use multi-columns
+		     (begin 
+		       (printf "\\defineparagraphs[Authors][n=~A]\n" (length a))
+		       (display "\\startAuthors\n")
+		       (let Loop ((l a))
+			 (unless (null? l)
+			   (output (car l) e)
+			   (unless (null? (cdr l))
+			     (display "\\nextAuthors\n")
+			     (Loop (cdr l)))))
+		       (display "\\stopAuthors\n\n"))
+		     ;; One author, that's easy
+		     (output a e))))
+	     ;; End of the title
+	     (display "\\StopTitlePage\n"))
+   :after (lambda (n e)
+	     (display "\n\\stoptext\n")))
+
+
+
+;;;; ======================================================================
+;;;;	&context-title ...
+;;;; ======================================================================
+(markup-writer '&context-title
+   :before "{\\DocumentTitle{"
+   :action (lambda (n e)
+	     (output (markup-body n) e)
+	     (let ((sub (markup-option n 'subtitle)))
+	       (when sub
+		 (display "\\\\\n\\switchtobodyfont[16pt]\\it{")
+		 (output sub e)
+		 (display "}\n"))))
+   :after "}}")
+
+;;;; ======================================================================
+;;;;	author ...
+;;;; ======================================================================
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :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))
+		   (out         (lambda (n) 
+				  (output n e) 
+				  (display "\\\\\n"))))
+	       (display "{\\midaligned{")
+	       (when name         	(out name))
+	       (when title        	(out title))
+	       (when affiliation  	(out affiliation))
+	       (when (pair? address)	(for-each out address))
+	       (when phone 		(out phone))
+	       (when email 		(out email))
+	       (when url 		(out url))
+	       (display "}}\n"))))
+
+
+;;;; ======================================================================
+;;;;	toc ...
+;;;; ======================================================================
+(markup-writer 'toc
+   :options '()
+   :action (lambda (n e) (display "\\placecontent\n")))
+
+;;;; ======================================================================
+;;;;	context-block-before ...
+;;;; ======================================================================
+(define (context-block-before name name-unnum)
+   (lambda (n e)
+      (let ((num (markup-option n :number)))
+	 (printf "\n\n%% ~a\n" (string-canonicalize (markup-ident n)))
+	 (printf "\\~a[~a]{" (if num name name-unnum)
+		 (string-canonicalize (markup-ident n)))
+	 (output (markup-option n :title) e)
+	 (display "}\n"))))
+
+
+;;;; ======================================================================
+;;;;	chapter, section,  ...
+;;;; ======================================================================
+(markup-writer 'chapter
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'chapter 'title))
+
+
+(markup-writer 'section
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'section 'subject))
+
+
+(markup-writer 'subsection
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'subsection 'subsubject))
+
+
+(markup-writer 'subsubsection
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'subsubsection 'subsubsubject))
+
+;;;; ======================================================================
+;;;;    paragraph ...
+;;;; ======================================================================
+(markup-writer 'paragraph
+   :options '(:title :number :toc :env)
+   :after "\\par\n")
+
+;;;; ======================================================================
+;;;;	footnote ...
+;;;; ======================================================================
+(markup-writer 'footnote
+   :before "\\footnote{"
+   :after "}")
+
+;;;; ======================================================================
+;;;;	linebreak ...
+;;;; ======================================================================
+(markup-writer 'linebreak
+   :action "\\crlf ")
+
+;;;; ======================================================================
+;;;;	hrule ...
+;;;; ======================================================================
+(markup-writer 'hrule 
+   :options '(:width :height)
+   :before (lambda (n e)
+	     (printf "\\blackrule[width=~A,height=~A]\n" 
+		     (context-width  (markup-option n :width))
+		     (context-dim    (markup-option n :height)))))
+		     
+;;;; ======================================================================
+;;;; 	color ...
+;;;; ======================================================================
+(markup-writer 'color
+   :options '(:bg :fg :width :margin :border)
+   :before (lambda (n e)
+	     (let ((bg (markup-option n :bg))
+		   (fg (markup-option n :fg))
+		   (w  (markup-option n :width))
+		   (m  (markup-option n :margin))
+		   (b  (markup-option n :border))
+		   (c  (markup-option n :round-corner)))
+	       (if (or bg w m b)
+		   (begin
+		     (printf "\\startframedtext[width=~a" (if w
+							      (context-width w)
+							      "fit"))
+		     (printf ",rulethickness=~A" (if b (context-width b) "0pt"))
+		     (when m
+		       (printf ",offset=~A" (context-width m)))
+		     (when bg
+		       (printf ",background=color,backgroundcolor=~A" 
+			       (skribe-get-color bg)))
+		     (when fg
+		       (printf ",foregroundcolor=~A" 
+			       (skribe-get-color fg)))
+		     (when c 
+		       (display ",framecorner=round"))
+		     (printf "]\n"))
+		   ;; Probably just a foreground was specified
+		   (when fg
+		     (printf "\\startcolor[~A] " (skribe-get-color fg))))))
+   :after (lambda (n e)
+	    (let ((bg (markup-option n :bg))
+		   (fg (markup-option n :fg))
+		   (w  (markup-option n :width))
+		   (m  (markup-option n :margin))
+		   (b  (markup-option n :border)))
+	      (if (or bg w m b)
+		(printf "\\stopframedtext ")
+		(when fg
+		  (printf "\\stopcolor "))))))
+;;;; ======================================================================
+;;;;	frame ...
+;;;; ======================================================================
+(markup-writer 'frame
+   :options '(:width :border :margin)
+   :before (lambda (n e)
+	     (let ((m (markup-option n :margin))
+		   (w (markup-option n :width))
+		   (b (markup-option n :border))
+		   (c (markup-option n :round-corner)))
+	       (printf "\\startframedtext[width=~a" (if w
+							(context-width w)
+							"fit"))
+	       (printf ",rulethickness=~A" (context-dim b))
+	       (printf ",offset=~A" (context-width m))
+	       (when c 
+		 (display ",framecorner=round"))
+	       (printf "]\n")))
+   :after "\\stopframedtext ")
+
+;;;; ======================================================================
+;;;;	font ...
+;;;; ======================================================================
+(markup-writer 'font
+   :options '(:size)
+   :action (lambda (n e) 
+	     (let* ((size (markup-option n :size))
+		    (cs   (engine-custom e 'font-size))
+		    (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 'context)
+				      :delegate e
+				      :filter (engine-filter e)
+				      :symbol-table (engine-symbol-table e)
+				      :custom `((font-size ,ns)
+						,@(engine-customs e)))))
+	       (printf "{\\switchtobodyfont[~apt]" ns)
+	       (output (markup-body n) ne)
+	       (display "}"))))
+   
+
+;;;; ======================================================================
+;;;;    flush ...                                                        
+;;;; ======================================================================
+(markup-writer 'flush
+   :options '(:side)
+   :before (lambda (n e)
+	     (case (markup-option n :side)
+		 ((center)
+		  (display "\n\n\\midaligned{"))
+		 ((left)
+		  (display "\n\n\\leftaligned{"))
+		 ((right)
+		  (display "\n\n\\rightaligned{"))))
+   :after "}\n")
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+   :before "\n\n\\midaligned{"
+   :after "}\n")
+
+;;;; ======================================================================
+;;;;   pre ...
+;;;; ======================================================================
+(markup-writer 'pre
+   :before "{\\tt\n\\startlines\n\\fixedspaces\n"
+   :action (lambda (n e)
+	     (let ((ne (make-engine
+			  (gensym 'context)
+			  :delegate e
+			  :filter (make-string-replace context-pre-encoding)
+			  :symbol-table (engine-symbol-table e)
+			  :custom (engine-customs e))))
+	       (output (markup-body n) ne)))
+   :after  "\n\\stoplines\n}")
+
+;;;; ======================================================================
+;;;;	prog ...
+;;;; ======================================================================
+(markup-writer 'prog
+   :options '(:line :mark)
+   :before "{\\tt\n\\startlines\n\\fixedspaces\n"
+   :action (lambda (n e)
+	     (let ((ne (make-engine
+			  (gensym 'context)
+			  :delegate e
+			  :filter (make-string-replace context-pre-encoding)
+			  :symbol-table (engine-symbol-table e)
+			  :custom (engine-customs e))))
+	       (output (markup-body n) ne)))
+   :after  "\n\\stoplines\n}")
+   
+
+;;;; ======================================================================
+;;;;    itemize, enumerate ...
+;;;; ======================================================================
+(define (context-itemization-action n e descr?)
+  (let ((symbol (markup-option n :symbol)))
+    (for-each (lambda (item)
+		(if symbol 
+		    (begin 
+		      (display "\\sym{")
+		      (output symbol e)
+		      (display "}"))
+		    ;; output a \item iff not a description
+		    (unless descr?
+		      (display "  \\item ")))
+		(output item e)
+		(newline))
+	      (markup-body n))))
+
+(markup-writer 'itemize
+   :options '(:symbol)	       
+   :before "\\startnarrower[left]\n\\startitemize[serried]\n"
+   :action (lambda (n e) (context-itemization-action n e #f))
+   :after "\\stopitemize\n\\stopnarrower\n")
+
+
+(markup-writer 'enumerate
+   :options '(:symbol)	       
+   :before "\\startnarrower[left]\n\\startitemize[n][standard]\n"
+   :action (lambda (n e) (context-itemization-action n e #f))
+   :after "\\stopitemize\n\\stopnarrower\n")
+
+;;;; ======================================================================
+;;;;    description ...
+;;;; ======================================================================
+(markup-writer 'description
+   :options '(:symbol)	       
+   :before "\\startnarrower[left]\n\\startitemize[serried]\n"
+   :action (lambda (n e) (context-itemization-action n e #t))
+   :after "\\stopitemize\n\\stopnarrower\n")
+
+;;;; ======================================================================
+;;;;    item ...
+;;;; ======================================================================
+(markup-writer 'item
+   :options '(:key)	       
+   :action (lambda (n e)
+	     (let ((k (markup-option n :key)))
+	       (when k
+		 ;; Output the key(s)
+		 (let Loop ((l (if (pair? k) k (list k))))
+		   (unless (null? l)
+		     (output (bold (car l)) e)
+		     (unless (null? (cdr l))
+		       (display "\\crlf\n"))
+		     (Loop (cdr l))))
+		 (display "\\nowhitespace\\startnarrower[left]\n"))
+	       ;; Output body
+	       (output (markup-body n) e)
+	       ;; Terminate
+	       (when k 
+		 (display "\n\\stopnarrower\n")))))
+
+;;;; ======================================================================
+;;;;	blockquote ...
+;;;; ======================================================================
+(markup-writer 'blockquote
+   :before "\n\\startnarrower[left,right]\n"
+   :after  "\n\\stopnarrower\n")
+
+
+;;;; ======================================================================
+;;;;	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)))
+	       (unless number 
+		 (display "{\\setupcaptions[number=off]\n"))
+	       (display "\\placefigure\n")
+	       (printf "  [~a]\n" (string-canonicalize ident))
+	       (display "  {") (output legend e) (display "}\n")
+	       (display "  {") (output (markup-body n) e) (display "}")
+	       (unless number 
+		 (display "}\n")))))
+
+;;;; ======================================================================
+;;;;    table ...
+;;;; ======================================================================
+						;; width doesn't work
+(markup-writer 'table
+   :options '(:width :border :frame :rules :cellpadding)
+   :before (lambda (n e)
+	     (let ((width  (markup-option n :width))
+		   (border (markup-option n :border))
+		   (frame  (markup-option n :frame))
+		   (rules  (markup-option n :rules))
+		   (cstyle (markup-option n :cellstyle))
+		   (cp     (markup-option n :cellpadding))
+		   (cs     (markup-option n :cellspacing)))
+	       (printf "\n{\\bTABLE\n")
+	       (printf "\\setupTABLE[")
+	       (printf "width=~A" (if width (context-width width) "fit"))
+	       (when border 
+		 (printf ",rulethickness=~A" (context-dim border)))
+	       (when cp
+		 (printf ",offset=~A" (context-width cp)))
+	       (printf ",frame=off]\n")
+
+	       (when rules
+		 (let ((hor  "\\setupTABLE[row][bottomframe=on,topframe=on]\n")
+		       (vert "\\setupTABLE[c][leftframe=on,rightframe=on]\n"))
+		   (case rules
+		     ((rows) (display hor))
+		     ((cols) (display vert))
+		     ((all)  (display hor) (display vert)))))
+
+	       (when frame 
+		 ;;  hsides, vsides, lhs, rhs, box, border
+		 (let ((top   "\\setupTABLE[row][first][frame=off,topframe=on]\n")
+		       (bot   "\\setupTABLE[row][last][frame=off,bottomframe=on]\n")
+		       (left  "\\setupTABLE[c][first][frame=off,leftframe=on]\n")
+		       (right "\\setupTABLE[c][last][frame=off,rightframe=on]\n"))
+		 (case frame
+		   ((above)      (display top))
+		   ((below)      (display bot))
+		   ((hsides)     (display top) (display bot))
+		   ((lhs)        (display left))
+		   ((rhs)        (display right))
+		   ((vsides)     (display left) (diplay right))
+		   ((box border) (display top)  (display bot) 
+		    		 (display left) (display right)))))))
+
+   :after  (lambda (n e)
+	     (printf "\\eTABLE}\n")))
+
+
+;;;; ======================================================================
+;;;;    tr ...
+;;;; ======================================================================
+(markup-writer 'tr
+   :options '(:bg)
+   :before (lambda (n e)
+	     (display "\\bTR")
+	     (let ((bg (markup-option n :bg)))
+	       (when bg
+		 (printf "[background=color,backgroundcolor=~A]"
+			 (skribe-get-color bg)))))		 
+   :after  "\\eTR\n")
+
+
+;;;; ======================================================================
+;;;;    tc ...
+;;;; ======================================================================
+(markup-writer 'tc
+   :options '(:width :align :valign :colspan)
+   :before (lambda (n e) 
+	     (let ((th?     (eq? 'th (markup-option n 'markup)))
+		   (width   (markup-option n :width))
+		   (align   (markup-option n :align))
+		   (valign  (markup-option n :valign))
+		   (colspan (markup-option n :colspan))
+		   (rowspan (markup-option n :rowspan))
+		   (bg      (markup-option n :bg)))
+	       (printf "\\bTD[")
+	       (printf "width=~a" (if width (context-width width) "fit"))
+	       (when valign
+		 ;; This is buggy. In fact valign an align can't be both 
+		 ;; specified in ConTeXt
+		 (printf ",align=~a" (case valign
+				       ((center) 'lohi)
+				       ((bottom) 'low)
+				       ((top)    'high))))
+	       (when align 
+		 (printf ",align=~a" (case align
+				       ((left) 'right) ; !!!!
+				       ((right) 'left) ; !!!!
+				       (else    'middle))))
+	       (unless (equal? colspan 1)
+		 (printf ",nx=~a" colspan))
+	       (display "]")
+	       (when th? 
+		 ;; This is a TH, output is bolded
+		 (display "{\\bf{"))))
+	     
+   :after (lambda (n e)
+	     (when (equal? (markup-option n 'markup) 'th)
+	       ;; This is a TH, output is bolded
+	       (display "}}"))
+	     (display "\\eTD")))
+
+;;;; ======================================================================
+;;;;	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
+						       '("jpg"))))))
+	       (if (not (string? img))
+		   (skribe-error 'context "Illegal image" file)
+		   (begin
+		     (printf "\\externalfigure[~A][frame=off" (strip-ref-base img))
+		     (if zoom   (printf ",factor=~a"   (inexact->exact zoom)))
+		     (if width  (printf ",width=~a"    (context-width width)))
+		     (if height (printf ",height=~apt" (context-dim height)))
+		     (display "]"))))))
+
+
+;;;; ======================================================================
+;;;;   Ornaments ...
+;;;; ======================================================================
+(markup-writer 'roman :before "{\\rm{" :after "}}")
+(markup-writer 'bold :before "{\\bf{" :after "}}")
+(markup-writer 'underline :before  "{\\underbar{" :after "}}")
+(markup-writer 'emph :before "{\\em{" :after "}}")
+(markup-writer 'it :before "{\\it{" :after "}}")
+(markup-writer 'code :before "{\\tt{" :after "}}")
+(markup-writer 'var :before "{\\tt{" :after "}}")
+(markup-writer 'sc :before "{\\sc{" :after "}}")
+;;//(markup-writer 'sf :before "{\\sf{" :after "}}")
+(markup-writer 'sub :before "{\\low{" :after "}}")
+(markup-writer 'sup :before "{\\high{" :after "}}")
+
+
+;;//
+;;//(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 ...
+;;;; ======================================================================
+(markup-writer 'q
+   :before "\\quotation{"
+   :after "}")
+
+;;;; ======================================================================
+;;;;    mailto ...
+;;;; ======================================================================
+(markup-writer 'mailto
+   :options '(:text)
+   :action (lambda (n e)
+	     (let ((text (markup-option n :text))
+		   (url  (markup-body n)))
+	       (when (pair? url) 
+		 (context-url (format "mailto:~A" (car url))
+			      (or text
+				  (car url))
+			      e)))))
+;;;; ======================================================================
+;;;;   mark ...
+;;;; ======================================================================
+(markup-writer 'mark
+   :before (lambda (n e)
+	      (printf "\\reference[~a]{}\n" 
+		      (string-canonicalize (markup-ident n)))))
+
+;;;; ======================================================================
+;;;;   ref ...
+;;;; ======================================================================
+(markup-writer 'ref
+   :options '(:text :chapter :section :subsection :subsubsection 
+	      :figure :mark :handle :page)
+   :action (lambda (n e)
+	      (let* ((text (markup-option n :text))
+		     (page (markup-option n :page))
+		     (c    (handle-ast (markup-body n)))
+		     (id   (markup-ident c)))
+		(cond 
+		  (page ;; Output the page only (this is a hack)
+		     (when text (output text e))
+		     (printf "\\at[~a]" 
+			     (string-canonicalize id)))
+		  ((or (markup-option n :chapter)
+		       (markup-option n :section)
+		       (markup-option n :subsection)
+		       (markup-option n :subsubsection))
+		   (if text
+		       (printf "\\goto{~a}[~a]" (or text id)
+			       (string-canonicalize id))
+		       (printf "\\in[~a]" (string-canonicalize id))))
+		  ((markup-option n :mark)
+		     (printf "\\goto{~a}[~a]"
+			     (or text id)
+			     (string-canonicalize id)))
+		  (else ;; Output a little image indicating the direction
+		      (printf "\\in[~a]" (string-canonicalize id)))))))
+
+;;;; ======================================================================
+;;;;   bib-ref ...
+;;;; ======================================================================
+(markup-writer 'bib-ref
+   :options '(:text :bib)
+   :before (lambda (n e) (output "[" e))
+   :action (lambda (n e)
+	     (let* ((obj   (handle-ast (markup-body n)))
+		    (title (markup-option obj :title))
+		    (ref   (markup-option title 'number))
+		    (ident (markup-ident obj)))
+	       (printf "\\goto{~a}[~a]" ref (string-canonicalize ident))))
+   :after (lambda (n e) (output "]" e)))
+
+;;;; ======================================================================
+;;;;   bib-ref+ ...
+;;;; ======================================================================
+(markup-writer 'bib-ref+
+   :options '(:text :bib)
+   :before (lambda (n e) (output "[" e))
+   :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 (lambda (n e) (output "]" e)))
+
+;;;; ======================================================================
+;;;;	url-ref ...
+;;;; ======================================================================
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :action (lambda (n e) 
+	     (context-url (markup-option n :url) (markup-option n :text) e)))
+
+;;//;*---------------------------------------------------------------------*/
+;;//;*    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 "\n% Bibliography\n\n")
+
+
+;;;; ======================================================================
+;;;;	&bib-entry ...
+;;;; ======================================================================
+(markup-writer '&bib-entry
+   :options '(:title)
+   :action (lambda (n e)
+	     (skribe-eval (mark (markup-ident n)) e)
+	     (output n e (markup-writer-get '&bib-entry-label e))
+	     (output n e (markup-writer-get '&bib-entry-body e)))
+   :after "\n\n")
+
+;;;; ======================================================================
+;;;;	&bib-entry-label ...
+;;;; ======================================================================
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before (lambda (n e) (output "[" e))
+   :action (lambda (n e) (output (markup-option n :title) e))
+   :after  (lambda (n e) (output "] "e)))
+
+;;;; ======================================================================
+;;;;	&bib-entry-title ...
+;;;; ======================================================================
+(markup-writer '&bib-entry-title
+   :action (lambda (n e)
+	     (let* ((t  (bold (markup-body n)))
+		    (en (handle-ast (ast-parent n)))
+		    (url #f ) ;;;;;;;;;;;;;;;// (markup-option en 'url))
+		    (ht (if url (ref :url (markup-body url) :text t) t)))
+	       (skribe-eval ht e))))
+
+
+;;//;*---------------------------------------------------------------------*/
+;;//;*    &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))))
+
+
+;;;; ======================================================================
+;;;;	&the-index ...
+;;;; ======================================================================
+(markup-writer '&the-index
+   :options '(:column)
+   :action 
+   (lambda (n e)
+     (define (make-mark-entry n)
+       (display "\\blank[medium]\n{\\bf\\it\\tfc{")
+       (skribe-eval (bold n) e)
+       (display "}}\\crlf\n"))
+     
+     (define (make-primary-entry n)
+       (let ((b (markup-body n)))
+	 (markup-option-add! b :text (list (markup-option b :text) ", "))
+	 (markup-option-add! b :page #t)
+	 (output n e)))
+
+     (define (make-secondary-entry n)
+       (let* ((note (markup-option n :note))
+	      (b    (markup-body n))
+	      (bb   (markup-body b)))
+	 (if note
+	     (begin   ;; This is another entry
+	       (display "\\crlf\n ... ")
+	       (markup-option-add! b :text (list note ", ")))
+	     (begin   ;; another line on an entry
+	       (markup-option-add! b :text ", ")))
+	 (markup-option-add! b :page #t)
+	 (output n e)))
+
+     ;; Writer body starts here
+     (let ((col  (markup-option n :column)))
+       (when col
+	 (printf "\\startcolumns[n=~a]\n" col))
+       (for-each (lambda (item)
+		   ;;(DEBUG "ITEM= ~S" item)
+		   (if (pair? item)
+		       (begin
+			 (make-primary-entry (car item))
+			 (for-each (lambda (x) (make-secondary-entry x))
+				   (cdr item)))
+		       (make-mark-entry item))
+		   (display "\\crlf\n"))
+		 (markup-body n))
+       (when col
+	 (printf "\\stopcolumns\n")))))
+
+;;;; ======================================================================
+;;;;    &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 (it (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 (it n1))
+			     (it 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))))
+
+
+
+;;;; ======================================================================
+;;;; 	Context Only Markups
+;;;; ======================================================================
+
+;;;
+;;; Margin -- put text in the margin
+;;;
+(define-markup (margin #!rest opts #!key (ident #f) (class "margin")
+			(side 'right) text)
+  (new markup
+       (markup 'margin)
+       (ident (or ident (symbol->string (gensym 'ident))))
+       (class class)
+       (required-options '(:text))
+       (options (the-options opts :ident :class))
+       (body (the-body opts))))
+
+(markup-writer 'margin
+   :options '(:text)
+   :before (lambda (n e)
+	     (display
+	      "\\setupinmargin[align=right,style=\\tfx\\setupinterlinespace]\n")
+	     (display "\\inright{")
+	     (output (markup-option n :text) e)
+	     (display "}{"))
+   :after  "}")
+
+;;;
+;;; ConTeXt and TeX
+;;; 
+(define-markup (ConTeXt #!key (space #t))
+  (if (engine-format? "context")
+      (! (if space "\\CONTEXT\\ " "\\CONTEXT"))
+      "ConTeXt"))
+
+(define-markup (TeX #!key (space #t))
+  (if (engine-format? "context")
+      (! (if space "\\TEX\\ " "\\TEX"))
+      "ConTeXt"))
+
+;;;; ======================================================================
+;;;;    Restore the base engine
+;;;; ======================================================================
+(default-engine-set! (find-engine 'base))
diff --git a/skr/french.skr b/skr/french.skr
new file mode 100644
index 0000000..373d076
--- /dev/null
+++ b/skr/french.skr
@@ -0,0 +1,19 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/letter.skr                       */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Fri Oct  3 12:22:13 2003                          */
+;*    Last change :  Tue Oct 28 14:33:43 2003 (serrano)                */
+;*    Copyright   :  2003 Manuel Serrano                               */
+;*    -------------------------------------------------------------    */
+;*    French Skribe style                                              */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX configuration                                              */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'usepackage
+		       (string-append (engine-custom le 'usepackage)
+				      "\\usepackage[french]{babel}
+\\usepackage{a4}")))
diff --git a/skr/html.skr b/skr/html.skr
new file mode 100644
index 0000000..ebac5f2
--- /dev/null
+++ b/skr/html.skr
@@ -0,0 +1,2251 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/html.skr                         */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sat Jul 26 12:28:57 2003                          */
+;*    Last change :  Thu Jun  2 10:57:42 2005 (serrano)                */
+;*    Copyright   :  2003-05 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    HTML Skribe engine                                               */
+;*    -------------------------------------------------------------    */
+;*    Implementation:                                                  */
+;*       common: @path ../src/common/api.src@                          */
+;*       bigloo: @path ../src/bigloo/api.bgl@                          */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/htmle.skb:ref@                            */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    html-engine ...                                                  */
+;*---------------------------------------------------------------------*/
+(define html-engine
+   ;; setup the html engine
+   (default-engine-set!
+      (make-engine 'html
+	 :version 1.0
+	 :format "html"
+	 :delegate (find-engine 'base)
+	 :filter (make-string-replace '((#\< "&lt;")
+					(#\> "&gt;")
+					(#\& "&amp;")
+					(#\" "&quot;")
+					(#\@ "&#x40;")))
+	 :custom `(;; the icon associated with the URL
+		   (favicon #f)
+		   ;; charset used
+		   (charset "ISO-8859-1")
+		   ;; enable/disable Javascript
+		   (javascript #f)
+		   ;; user html head
+		   (head #f)
+		   ;; user CSS
+		   (css ())
+		   ;; user inlined CSS
+		   (inline-css ())
+		   ;; user JS
+		   (js ())
+		   ;; emit-sui
+		   (emit-sui #f)
+		   ;; the body
+		   (background "#ffffff")
+		   (foreground #f)
+		   ;; the margins
+		   (margin-padding 3)
+		   (left-margin #f)
+		   (chapter-left-margin #f)
+		   (section-left-margin #f)
+		   (left-margin-font #f)
+		   (left-margin-size 17.)
+		   (left-margin-background "#dedeff")
+		   (left-margin-foreground #f)
+		   (right-margin #f)
+		   (chapter-right-margin #f)
+		   (section-right-margin #f)
+		   (right-margin-font #f)
+		   (right-margin-size 17.)
+		   (right-margin-background "#dedeff")
+		   (right-margin-foreground #f)
+		   ;; author configuration
+		   (author-font #f)
+		   ;; title configuration
+		   (title-font #f)
+		   (title-background "#8381de")
+		   (title-foreground #f)
+		   (file-title-separator " -- ")
+		   ;; index configuration
+		   (index-header-font-size +2.)
+		   ;; chapter configuration
+		   (chapter-number->string number->string)
+		   (chapter-file #f)
+		   ;; section configuration
+		   (section-title-start "<h3>")
+		   (section-title-stop "</h3>")
+		   (section-title-background "#dedeff")
+		   (section-title-foreground "black")
+		   (section-title-number-separator " ")
+		   (section-number->string number->string)
+		   (section-file #f)
+		   ;; subsection configuration
+		   (subsection-title-start "<h3>")
+		   (subsection-title-stop "</h3>")
+		   (subsection-title-background "#ffffff")
+		   (subsection-title-foreground "#8381de")
+		   (subsection-title-number-separator " ")
+		   (subsection-number->string number->string)
+		   (subsection-file #f)
+		   ;; subsubsection configuration
+		   (subsubsection-title-start "<h4>")
+		   (subsubsection-title-stop "</h4>")
+		   (subsubsection-title-background #f)
+		   (subsubsection-title-foreground "#8381de")
+		   (subsubsection-title-number-separator " ")
+		   (subsubsection-number->string number->string)
+		   (subsubsection-file #f)
+		   ;; 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
+		   (image-format ("png" "gif" "jpg" "jpeg")))
+	 :symbol-table '(("iexcl" "&#161;")
+			 ("cent" "&#162;")
+			 ("pound" "&#163;")
+			 ("currency" "&#164;")
+			 ("yen" "&#165;")
+			 ("section" "&#167;")
+			 ("mul" "&#168;")
+			 ("copyright" "&#169;")
+			 ("female" "&#170;")
+			 ("lguillemet" "&#171;")
+			 ("not" "&#172;")
+			 ("registered" "&#174;")
+			 ("degree" "&#176;")
+			 ("plusminus" "&#177;")
+			 ("micro" "&#181;")
+			 ("paragraph" "&#182;")
+			 ("middot" "&#183;")
+			 ("male" "&#184;")
+			 ("rguillemet" "&#187;")
+			 ("1/4" "&#188;")
+			 ("1/2" "&#189;")
+			 ("3/4" "&#190;")
+			 ("iquestion" "&#191;")
+			 ("Agrave" "&#192;")
+			 ("Aacute" "&#193;")
+			 ("Acircumflex" "&#194;")
+			 ("Atilde" "&#195;")
+			 ("Amul" "&#196;")
+			 ("Aring" "&#197;")
+			 ("AEligature" "&#198;")
+			 ("Oeligature" "&#338;")
+			 ("Ccedilla" "&#199;")
+			 ("Egrave" "&#200;")
+			 ("Eacute" "&#201;")
+			 ("Ecircumflex" "&#202;")
+			 ("Euml" "&#203;")
+			 ("Igrave" "&#204;")
+			 ("Iacute" "&#205;")
+			 ("Icircumflex" "&#206;")
+			 ("Iuml" "&#207;")
+			 ("ETH" "&#208;")
+			 ("Ntilde" "&#209;")
+			 ("Ograve" "&#210;")
+			 ("Oacute" "&#211;")
+			 ("Ocurcumflex" "&#212;")
+			 ("Otilde" "&#213;")
+			 ("Ouml" "&#214;")
+			 ("times" "&#215;")
+			 ("Oslash" "&#216;")
+			 ("Ugrave" "&#217;")
+			 ("Uacute" "&#218;")
+			 ("Ucircumflex" "&#219;")
+			 ("Uuml" "&#220;")
+			 ("Yacute" "&#221;")
+			 ("THORN" "&#222;")
+			 ("szlig" "&#223;")
+			 ("agrave" "&#224;")
+			 ("aacute" "&#225;")
+			 ("acircumflex" "&#226;")
+			 ("atilde" "&#227;")
+			 ("amul" "&#228;")
+			 ("aring" "&#229;")
+			 ("aeligature" "&#230;")
+			 ("oeligature" "&#339;")
+			 ("ccedilla" "&#231;")
+			 ("egrave" "&#232;")
+			 ("eacute" "&#233;")
+			 ("ecircumflex" "&#234;")
+			 ("euml" "&#235;")
+			 ("igrave" "&#236;")
+			 ("iacute" "&#237;")
+			 ("icircumflex" "&#238;")
+			 ("iuml" "&#239;")
+			 ("eth" "&#240;")
+			 ("ntilde" "&#241;")
+			 ("ograve" "&#242;")
+			 ("oacute" "&#243;")
+			 ("ocurcumflex" "&#244;")
+			 ("otilde" "&#245;")
+			 ("ouml" "&#246;")
+			 ("divide" "&#247;")
+			 ("oslash" "&#248;")
+			 ("ugrave" "&#249;")
+			 ("uacute" "&#250;")
+			 ("ucircumflex" "&#251;")
+			 ("uuml" "&#252;")
+			 ("yacute" "&#253;")
+			 ("thorn" "&#254;")
+			 ("ymul" "&#255;")
+			 ;; Greek 
+			 ("Alpha" "&#913;") 
+			 ("Beta" "&#914;")
+			 ("Gamma" "&#915;")
+			 ("Delta" "&#916;")
+			 ("Epsilon" "&#917;")
+			 ("Zeta" "&#918;")
+			 ("Eta" "&#919;")
+			 ("Theta" "&#920;")
+			 ("Iota" "&#921;")
+			 ("Kappa" "&#922;")
+			 ("Lambda" "&#923;")
+			 ("Mu" "&#924;")
+			 ("Nu" "&#925;")
+			 ("Xi" "&#926;")
+			 ("Omicron" "&#927;")
+			 ("Pi" "&#928;")
+			 ("Rho" "&#929;")
+			 ("Sigma" "&#931;")
+			 ("Tau" "&#932;")
+			 ("Upsilon" "&#933;")
+			 ("Phi" "&#934;")
+			 ("Chi" "&#935;")
+			 ("Psi" "&#936;")
+			 ("Omega" "&#937;")
+			 ("alpha" "&#945;")
+			 ("beta" "&#946;")
+			 ("gamma" "&#947;")
+			 ("delta" "&#948;")
+			 ("epsilon" "&#949;")
+			 ("zeta" "&#950;")
+			 ("eta" "&#951;")
+			 ("theta" "&#952;")
+			 ("iota" "&#953;")
+			 ("kappa" "&#954;")
+			 ("lambda" "&#955;")
+			 ("mu" "&#956;")
+			 ("nu" "&#957;")
+			 ("xi" "&#958;")
+			 ("omicron" "&#959;")
+			 ("pi" "&#960;")
+			 ("rho" "&#961;")
+			 ("sigmaf" "&#962;")
+			 ("sigma" "&#963;")
+			 ("tau" "&#964;")
+			 ("upsilon" "&#965;")
+			 ("phi" "&#966;")
+			 ("chi" "&#967;")
+			 ("psi" "&#968;")
+			 ("omega" "&#969;")
+			 ("thetasym" "&#977;")
+			 ("piv" "&#982;")
+			 ;; punctuation
+			 ("bullet" "&#8226;")
+			 ("ellipsis" "&#8230;")
+			 ("weierp" "&#8472;")
+			 ("image" "&#8465;")
+			 ("real" "&#8476;")
+			 ("tm" "&#8482;")
+			 ("alef" "&#8501;")
+			 ("<-" "&#8592;")
+			 ("<--" "&#8592;")
+			 ("uparrow" "&#8593;")
+			 ("->" "&#8594;")
+			 ("-->" "&#8594;")
+			 ("downarrow" "&#8595;")
+			 ("<->" "&#8596;")
+			 ("<-->" "&#8596;")
+			 ("<+" "&#8629;")
+			 ("<=" "&#8656;")
+			 ("<==" "&#8656;")
+			 ("Uparrow" "&#8657;")
+			 ("=>" "&#8658;")
+			 ("==>" "&#8658;")
+			 ("Downarrow" "&#8659;")
+			 ("<=>" "&#8660;")
+			 ("<==>" "&#8660;")
+			 ;; Mathematical operators 
+			 ("forall" "&#8704;")
+			 ("partial" "&#8706;")
+			 ("exists" "&#8707;")
+			 ("emptyset" "&#8709;")
+			 ("infinity" "&#8734;")
+			 ("nabla" "&#8711;")
+			 ("in" "&#8712;")
+			 ("notin" "&#8713;")
+			 ("ni" "&#8715;")
+			 ("prod" "&#8719;")
+			 ("sum" "&#8721;")
+			 ("asterisk" "&#8727;")
+			 ("sqrt" "&#8730;")
+			 ("propto" "&#8733;")
+			 ("angle" "&#8736;")
+			 ("and" "&#8743;")
+			 ("or" "&#8744;")
+			 ("cap" "&#8745;")
+			 ("cup" "&#8746;")
+			 ("integral" "&#8747;")
+			 ("therefore" "&#8756;")
+			 ("models" "|=")
+			 ("vdash" "|-")
+			 ("dashv" "-|")
+			 ("sim" "&#8764;")
+			 ("cong" "&#8773;")
+			 ("approx" "&#8776;")
+			 ("neq" "&#8800;")
+			 ("equiv" "&#8801;")
+			 ("le" "&#8804;")
+			 ("ge" "&#8805;")
+			 ("subset" "&#8834;")
+			 ("supset" "&#8835;")
+			 ("nsupset" "&#8835;")
+			 ("subseteq" "&#8838;")
+			 ("supseteq" "&#8839;")
+			 ("oplus" "&#8853;")
+			 ("otimes" "&#8855;")
+			 ("perp" "&#8869;")
+			 ("mid" "|")
+			 ("lceil" "&#8968;")
+			 ("rceil" "&#8969;")
+			 ("lfloor" "&#8970;")
+			 ("rfloor" "&#8971;")
+			 ("langle" "&#9001;")
+			 ("rangle" "&#9002;")
+			 ;; Misc
+			 ("loz" "&#9674;") 
+			 ("spades" "&#9824;")
+			 ("clubs" "&#9827;")
+			 ("hearts" "&#9829;")
+			 ("diams" "&#9830;")
+			 ("euro" "&#8464;")
+			 ;; LaTeX 
+			 ("dag" "dag")
+			 ("ddag" "ddag")
+			 ("circ" "o")
+			 ("top" "T")
+			 ("bottom" "&#8869;")
+			 ("lhd" "<")
+			 ("rhd" ">")
+			 ("parallel" "||")))))
+
+;*---------------------------------------------------------------------*/
+;*    html-title-engine ...                                            */
+;*---------------------------------------------------------------------*/
+(define html-title-engine
+   (copy-engine 'html-title base-engine
+      :filter (make-string-replace '((#\< "&lt;")
+				     (#\> "&gt;")
+				     (#\& "&amp;")
+				     (#\" "&quot;")))))
+
+;*---------------------------------------------------------------------*/
+;*    html-browser-title ...                                           */
+;*---------------------------------------------------------------------*/
+(define (html-browser-title n)
+   (and (markup? n)
+	(or (markup-option n :html-title)
+	    (if (document? n)
+		(markup-option n :title)
+		(html-browser-title (ast-parent n))))))
+
+;*---------------------------------------------------------------------*/
+;*    html-file ...                                                    */
+;*---------------------------------------------------------------------*/
+(define html-file
+   (let ((table '())
+	 (filename (gensym)))
+      (define (get-file-name base suf)
+	 (let* ((c (assoc base table))
+		(n (if (pair? c)
+		       (let ((n (+ 1 (cdr c))))
+			  (set-cdr! c n)
+			  n)
+		       (begin
+			  (set! table (cons (cons base 1) table))
+			  1))))
+	    (format "~a-~a.~a" base n suf)))
+      (lambda (node e)
+	 (let ((f (markup-option node filename))
+	       (file (markup-option node :file)))
+	    (cond
+	       ((string? f)
+		f)
+	       ((string? file)
+		file)
+	       ((or file 
+		    (and (is-markup? node 'chapter)
+			 (engine-custom e 'chapter-file))
+		    (and (is-markup? node 'section)
+			 (engine-custom e 'section-file))
+		    (and (is-markup? node 'subsection)
+			 (engine-custom e 'subsection-file))
+		    (and (is-markup? node 'subsubsection)
+			 (engine-custom e 'subsubsection-file)))
+		(let* ((b (or (and (string? *skribe-dest*)
+				   (prefix *skribe-dest*))
+			      ""))
+		       (s (or (and (string? *skribe-dest*)
+				   (suffix *skribe-dest*))
+			      "html"))
+		       (nm (get-file-name b s)))
+		   (markup-option-add! node filename nm)
+		   nm))
+	       ((document? node)
+		*skribe-dest*)
+	       (else
+		(let ((p (ast-parent node)))
+		   (if (container? p)
+		       (let ((file (html-file p e)))
+			  (if (string? file)
+			      (begin
+				 (markup-option-add! node filename file)
+				 file)
+			      #f))
+		       #f))))))))
+
+;*---------------------------------------------------------------------*/
+;*    html-container-number ...                                        */
+;*    -------------------------------------------------------------    */
+;*    Returns a string representing the container number               */
+;*---------------------------------------------------------------------*/
+(define (html-container-number c e)
+   (define (html-number n proc)
+      (cond
+	 ((string? n)
+	  n)
+	 ((number? n)
+	  (if (procedure? proc) 
+	      (proc n)
+	      (number->string n)))
+	 (else
+	  "")))
+   (define (html-chapter-number c)
+      (html-number (markup-option c :number) 
+		   (engine-custom e 'chapter-number->string)))
+   (define (html-section-number c)
+      (let ((p (ast-parent c))
+	    (s (html-number (markup-option c :number) 
+			    (engine-custom e 'section-number->string))))
+	 (cond
+	    ((is-markup? p 'chapter)
+	     (string-append (html-chapter-number p) "." s))
+	    (else
+	     (string-append s)))))
+   (define (html-subsection-number c)
+      (let ((p (ast-parent c))
+	    (s (html-number (markup-option c :number) 
+			    (engine-custom e 'subsection-number->string))))
+	 (cond
+	    ((is-markup? p 'section)
+	     (string-append (html-section-number p) "." s))
+	    (else
+	     (string-append "." s)))))
+   (define (html-subsubsection-number c)
+      (let ((p (ast-parent c))
+	    (s (html-number (markup-option c :number) 
+			    (engine-custom e 'subsubsection-number->string))))
+	 (cond
+	    ((is-markup? p 'subsection)
+	     (string-append (html-subsection-number p) "." s))
+	    (else
+	     (string-append ".." s)))))
+   (define (inner-html-container-number c)
+      (html-number (markup-option c :number) #f))
+   (let ((n (markup-option c :number)))
+      (if (not n)
+	  ""
+	  (case (markup-markup c)
+	     ((chapter)
+	      (html-chapter-number c))
+	     ((section)
+	      (html-section-number c))
+	     ((subsection)
+	      (html-subsection-number c))
+	     ((subsubsection)
+	      (html-subsubsection-number c))
+	     (else
+	      (if (container? c)
+		  (inner-html-container-number c)
+		  (skribe-error 'html-container-number
+				"Not a container"
+				(markup-markup c))))))))
+   
+;*---------------------------------------------------------------------*/
+;*    html-counter ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (html-counter cnts)
+   (cond
+      ((not cnts)
+       "")
+      ((null? cnts)
+       "")
+      ((not (pair? cnts))
+       cnts)
+      ((null? (cdr cnts))
+       (format "~a." (car cnts)))
+      (else
+       (let loop ((cnts cnts))
+	  (if (null? (cdr cnts))
+	      (format "~a" (car cnts))
+	      (format "~a.~a" (car cnts) (loop (cdr cnts))))))))
+
+;*---------------------------------------------------------------------*/
+;*    html-width ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (html-width width)
+   (cond
+      ((and (integer? width) (exact? width))
+       (format "~A" width))
+      ((real? width)
+       (format "~A%" (inexact->exact (round width))))
+      ((string? width)
+       width)
+      (else
+       (skribe-error 'html-width "bad width" width))))
+
+;*---------------------------------------------------------------------*/
+;*    html-class ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (html-class m)
+   (if (markup? m)
+       (let ((c (markup-class m)))
+	  (if (or (string? c) (symbol? c) (number? c))
+	      (printf " class=\"~a\"" c)))))
+
+;*---------------------------------------------------------------------*/
+;*    html-markup-class ...                                            */
+;*---------------------------------------------------------------------*/
+(define (html-markup-class m)
+   (lambda (n e)
+      (printf "<~a" m)
+      (html-class n)
+      (display ">")))
+
+;*---------------------------------------------------------------------*/
+;*    html-color-spec? ...                                             */
+;*---------------------------------------------------------------------*/
+(define (html-color-spec? v)
+   (and v 
+	(not (unspecified? v))
+	(or (not (string? v)) (> (string-length v) 0))))
+			  
+;*---------------------------------------------------------------------*/
+;*    document ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+   :options '(:title :author :ending :html-title :env)
+   :action (lambda (n e)
+	      (let* ((id (markup-ident n))
+		     (title (new markup
+			       (markup '&html-document-title)
+			       (parent n)
+			       (ident (string-append id "-title"))
+			       (class (markup-class n))
+			       (options `((author ,(markup-option n :author))))
+			       (body (markup-option n :title)))))
+		 (&html-generic-document n title e)))
+   :after (lambda (n e)
+	     (if (engine-custom e 'emit-sui)
+		 (document-sui n e))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-html ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-html
+   :before "<!-- 95% W3C COMPLIANT, 95% CSS FREE, RAW HTML -->
+<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+<html>\n"
+   :after "</html>")
+
+;*---------------------------------------------------------------------*/
+;*    &html-head ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-head
+   :before (lambda (n e)
+	     (printf "<head>\n")
+	     (printf "<meta http-equiv=\"Content-Type\" content=\"text/html;")
+	     (printf "charset=~A\">\n" (engine-custom (find-engine 'html)
+						      'charset)))
+   :after "</head>\n\n")
+
+;*---------------------------------------------------------------------*/
+;*    &html-body ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-body 
+   :before (lambda (n e)
+	      (let ((bg (engine-custom e 'background)))
+		 (display "<body")
+		 (html-class n)
+		 (when (html-color-spec? bg) (printf " bgcolor=\"~a\"" bg))
+		 (display ">\n")))
+   :after "</body>\n")
+
+;*---------------------------------------------------------------------*/
+;*    &html-page ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-page
+   :action (lambda (n e)
+	      (define (html-margin m fn size bg fg cla)
+		 (printf "<td align=\"left\" valign=\"top\" class=\"~a\"" cla)
+		 (if size
+		     (printf " width=\"~a\"" (html-width size)))
+		 (if (html-color-spec? bg)
+		     (printf " bgcolor=\"~a\">" bg)
+		     (display ">"))
+		 (printf "<div class=\"~a\">\n" cla)
+		 (cond
+		    ((and (string? fg) (string? fn))
+		     (printf "<font color=\"~a\" \"~a\">" fg fn))
+		    ((string? fg)
+		     (printf "<font color=\"~a\">" fg))
+		    ((string? fn)
+		     (printf "<font \"~a\">" fn)))
+		 (if (procedure? m)
+		     (skribe-eval (m n e) e)
+		     (output m e))
+		 (if (or (string? fg) (string? fn))
+		     (display "</font>"))
+		 (display "</div></td>\n"))
+	      (let ((body (markup-body n))
+		    (lm (engine-custom e 'left-margin))
+		    (lmfn (engine-custom e 'left-margin-font))
+		    (lms (engine-custom e 'left-margin-size))
+		    (lmbg (engine-custom e 'left-margin-background))
+		    (lmfg (engine-custom e 'left-margin-foreground))
+		    (rm (engine-custom e 'right-margin))
+		    (rmfn (engine-custom e 'right-margin-font))
+		    (rms (engine-custom e 'right-margin-size))
+		    (rmbg (engine-custom e 'right-margin-background))
+		    (rmfg (engine-custom e 'right-margin-foreground)))
+		 (cond
+		    ((and lm rm)
+		     (let* ((ep (engine-custom e 'margin-padding))
+			    (ac (if (number? ep) ep 0)))
+			(printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribe-margins\"><tr>\n" ac))
+		     (html-margin lm lmfn lms lmbg lmfg "skribe-left-margin")
+		     (html-margin body #f #f #f #f "skribe-body")
+		     (html-margin rm rmfn rms rmbg rmfg "skribe-right-margin")
+		     (display "</tr></table>"))
+		    (lm
+		     (let* ((ep (engine-custom e 'margin-padding))
+			    (ac (if (number? ep) ep 0)))
+			(printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribe-margins\"><tr>\n" ac))
+		     (html-margin lm lmfn lms lmbg lmfg "skribe-left-margin")
+		     (html-margin body #f #f #f #f "skribe-body")
+		     (display "</tr></table>"))
+		    (rm
+		     (let* ((ep (engine-custom e 'margin-padding))
+			    (ac (if (number? ep) ep 0)))
+			(printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribe-margins\"><tr>\n"))
+		     (html-margin body #f #f #f #f "skribe-body")
+		     (html-margin rm rmfn rms rmbg rmfg "skribe-right-margin")
+		     (display "</tr></table>"))
+		    (else
+		     (display "<div class=\"skribe-body\">\n")
+		     (output body e)
+		     (display "</div>\n"))))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-header ...                                         */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-header n e)
+   (let* ((ic (engine-custom e 'favicon))
+	  (id (markup-ident n)))
+      (unless (string? id)
+	 (skribe-error '&html-generic-header 
+		       (format "Illegal identifier `~a'" id)
+		       n))
+      ;; title
+      (output (new markup
+		 (markup '&html-header-title)
+		 (parent n)
+		 (ident (string-append id "-title"))
+		 (class (markup-class n))
+		 (body (markup-body n)))
+	      e)
+      ;; favicon
+      (output (new markup
+		 (markup '&html-header-favicon)
+		 (parent n)
+		 (ident (string-append id "-favicon"))
+		 (body (cond
+			  ((string? ic)
+			   ic)
+			  ((procedure? ic)
+			   (ic d e)))))
+	      e)
+      ;; style
+      (output (new markup
+		 (markup '&html-header-style)
+		 (parent n)
+		 (ident (string-append id "-style"))
+		 (class (markup-class n)))
+	      e)
+      ;; css
+      (output (new markup
+		 (markup '&html-header-css)
+		 (parent n)
+		 (ident (string-append id "-css"))
+		 (body (let ((c (engine-custom e 'css)))
+			  (if (string? c)
+			      (list c) 
+			      c))))
+	      e)
+      ;; javascript
+      (output (new markup
+		 (markup '&html-header-javascript)
+		 (parent n)
+		 (ident (string-append id "-javascript")))
+	      e)))
+
+(markup-writer '&html-header-title
+   :before "<title>"
+   :action (lambda (n e)
+	      (output (markup-body n) html-title-engine))
+   :after "</title>\n")
+
+(markup-writer '&html-header-favicon
+   :action (lambda (n e)
+	      (let ((i (markup-body n)))
+		 (when i
+		    (printf " <link rel=\"shortcut icon\" href=~s>\n" i)))))
+
+(markup-writer '&html-header-css
+   :action (lambda (n e)
+	      (let ((css (markup-body n)))
+		 (when (pair? css)
+		    (for-each (lambda (css)
+				 (printf " <link href=~s rel=\"stylesheet\" type=\"text/css\">\n" css))
+			      css)))))
+	      
+(markup-writer '&html-header-style
+   :before " <style type=\"text/css\">\n  <!--\n"
+   :action (lambda (n e)
+	      (let ((hd (engine-custom e 'head))
+		    (icss (let ((ic (engine-custom e 'inline-css)))
+			     (if (string? ic)
+				 (list ic)
+				 ic))))
+		 (display "  pre { font-family: monospace }\n")
+		 (display "  tt { font-family: monospace }\n")
+		 (display "  code { font-family: monospace }\n")
+		 (display "  p.flushright { text-align: right }\n")
+		 (display "  p.flushleft { text-align: left }\n")
+		 (display "  span.sc { font-variant: small-caps }\n")
+		 (display "  span.sf { font-family: sans-serif }\n")
+		 (display "  span.skribetitle { font-family: sans-serif; font-weight: bolder; font-size: x-large; }\n")
+		 (when hd (display (format "  ~a\n" hd)))
+		 (when (pair? icss)
+		    (for-each (lambda (css)
+				 (let ((p (open-input-file css)))
+				    (if (not (input-port? p))
+					(skribe-error 
+					 'html-css
+					 "Can't open CSS file for input"
+					 css)
+					(begin
+					   (let loop ((l (read-line p)))
+					      (unless (eof-object? l)
+						 (display l)
+						 (newline)
+						 (loop (read-line p))))
+					   (close-input-port p)))))
+			      icss))))
+   :after "  -->\n </style>\n")
+	      
+(markup-writer '&html-header-javascript
+   :action (lambda (n e)
+	      (when (engine-custom e 'javascript)
+		 (display " <script language=\"JavaScript\" type=\"text/javascript\">\n")
+		 (display " <!--\n")
+		 (display "  function skribenospam( n, d, f ) {\n")
+		 (display "    nn=n.replace( / /g , \".\" );\n" )
+		 (display "    dd=d.replace( / /g , \".\" );\n" )
+		 (display "    document.write( \"<a href=\\\"mailto:\" + nn + \"@\" + dd + \"\\\">\" );\n")
+		 (display "    if( f ) {\n")
+		 (display "      document.write( \"<tt>\" + nn + \"@\" + dd + \"</\" + \"tt><\" + \"/a>\" );\n")
+		 (display "    }\n")
+		 (display "  }\n")
+		 (display " -->\n")
+		 (display " </script>\n"))
+	      (let* ((ejs (engine-custom e 'js))
+		     (js (cond
+			    ((string? ejs)
+			     (list ejs))
+			    ((list? ejs)
+			     ejs)
+			    (else
+			     '()))))
+		 (for-each (lambda (s)
+			      (printf "<script type=\"text/javascript\" src=\"~a\"></script>" s))
+			   js))))
+			      
+	      
+;*---------------------------------------------------------------------*/
+;*    &html-header ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-document-header :action &html-generic-header)
+(markup-writer '&html-chapter-header :action &html-generic-header)
+(markup-writer '&html-section-header :action &html-generic-header)
+(markup-writer '&html-subsection-header :action &html-generic-header)
+(markup-writer '&html-subsubsection-header :action &html-generic-header)
+
+;*---------------------------------------------------------------------*/
+;*    &html-ending ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-ending
+   :before "<div class=\"skribe-ending\">"
+   :action (lambda (n e)
+	      (let ((body (markup-body n)))
+		 (if body
+		     (output body #t)
+		     (skribe-eval [
+,(hrule) 
+,(p :class "ending" (font :size -1 [
+This ,(sc "Html") page has been produced by 
+,(ref :url (skribe-url) :text "Skribe").
+,(linebreak)
+Last update ,(it (date)).]))] e))))
+   :after "</div>\n")
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-title ...                                          */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-title n e)
+   (let* ((title (markup-body n))
+	  (authors (markup-option n 'author))
+	  (tbg (engine-custom e 'title-background))
+	  (tfg (engine-custom e 'title-foreground))
+	  (tfont (engine-custom e 'title-font)))
+      (when title
+	 (display "<table width=\"100%\" class=\"skribetitle\" cellspacing=\"0\" cellpadding=\"0\"><tbody>\n<tr>")
+	 (if (html-color-spec? tbg)
+	     (printf "<td align=\"center\" bgcolor=\"~a\">" tbg)
+	     (display "<td align=\"center\">"))
+	 (if (string? tfg)
+	     (printf "<font color=\"~a\">" tfg))
+	 (when title
+	    (if (string? tfont)
+		(begin
+		   (printf "<font ~a><strong>" tfont)
+		   (output title e)
+		   (display "</strong></font>"))
+		(begin
+		   (printf "<div class=\"skribetitle\"><strong><big><big><big>")
+		   (output title e)
+		   (display "</big></big></big></strong></div>"))))
+	 (if (not authors)
+	     (display "\n")
+	     (html-title-authors authors e))
+	 (if (string? tfg)
+	     (display "</font>"))
+	 (display "</td></tr></tbody></table>\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-document-title ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-document-title :action &html-generic-title)
+(markup-writer '&html-chapter-title :action &html-generic-title)
+(markup-writer '&html-section-title :action &html-generic-title)
+(markup-writer '&html-subsection-title :action &html-generic-title)
+(markup-writer '&html-subsubsection-title :action &html-generic-title)
+
+;*---------------------------------------------------------------------*/
+;*    &html-footnotes                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-footnotes
+   :before (lambda (n e)
+	      (let ((footnotes (markup-body n)))
+		 (when (pair? footnotes)
+		    (display "<div class=\"footnote\">")
+		    (display "<br><br>\n")
+		    (display "<hr width='20%' size='2' align='left'>\n"))))
+   :action (lambda (n e)
+	      (let ((footnotes (markup-body n)))
+		 (when (pair? footnotes)
+		    (let loop ((fns footnotes))
+		       (if (pair? fns)
+			   (let ((fn (car fns)))
+			      (printf "<a name=\"footnote-~a\">" 
+				      (string-canonicalize 
+				       (container-ident fn)))
+			      (printf "<sup><small>~a</small></sup></a>: "
+				      (markup-option fn :number))
+			      (output (markup-body fn) e)
+			      (display "\n<br>\n")
+			      (loop (cdr fns)))))
+		    (display "<div>")))))
+
+;*---------------------------------------------------------------------*/
+;*    html-title-authors ...                                           */
+;*---------------------------------------------------------------------*/
+(define (html-title-authors authors e)
+   (define (html-authorsN authors cols first)
+      (define (make-row authors . opt)
+	 (tr (map (lambda (v)
+		     (apply td :align 'center :valign 'top v opt))
+		  authors)))
+      (define (make-rows authors)
+	 (let loop ((authors authors)
+		    (rows '())
+		    (row '())
+		    (cnum 0))
+	    (cond
+	       ((null? authors)
+		(reverse! (cons (make-row (reverse! row)) rows)))
+	       ((= cnum cols)
+		(loop authors
+		      (cons (make-row (reverse! row)) rows)
+		      '()
+		      0))
+	       (else
+		(loop (cdr authors)
+		      rows
+		      (cons (car authors) row)
+		      (+ cnum 1))))))
+      (output (table :cellpadding 10
+		 (if first
+		     (cons (make-row (list (car authors)) :colspan cols)
+			   (make-rows (cdr authors)))
+		     (make-rows authors)))
+	      e))
+   (cond
+      ((pair? authors)
+       (display "<center>\n")
+       (let ((len (length authors)))
+	  (case len
+	     ((1)
+	      (output (car authors) e))
+	     ((2 3)
+	      (html-authorsN authors len #f))
+	     ((4)
+	      (html-authorsN authors 2 #f))
+	     (else
+	      (html-authorsN authors 3 #t))))
+       (display "</center>\n"))
+      (else
+       (html-title-authors (list authors) e))))
+
+;*---------------------------------------------------------------------*/
+;*    document-sui ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (document-sui n e)
+   (define (sui)
+      (display "(sui \"")
+      (skribe-eval (markup-option n :title) html-title-engine)
+      (display "\"\n")
+      (printf "  :file ~s\n" (sui-referenced-file n e))
+      (sui-marks n e)
+      (sui-blocks 'chapter n e)
+      (sui-blocks 'section n e)
+      (sui-blocks 'subsection n e)
+      (sui-blocks 'subsubsection n e)
+      (display "  )\n"))
+   (if (string? *skribe-dest*)
+       (let ((f (format "~a.sui" (prefix *skribe-dest*))))
+	  (with-output-to-file f sui))
+       (sui)))
+
+;*---------------------------------------------------------------------*/
+;*    sui-referenced-file ...                                          */
+;*---------------------------------------------------------------------*/
+(define (sui-referenced-file n e)
+   (let ((file (html-file n e)))
+      (if (member (suffix file) '("skb" "sui" "skr" "html"))
+	  (string-append (strip-ref-base (prefix file)) ".html")
+	  file)))
+
+;*---------------------------------------------------------------------*/
+;*    sui-marks ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (sui-marks n e)
+   (printf "  (marks")
+   (for-each (lambda (m)
+		(printf "\n    (~s" (markup-ident m))
+		(printf " :file ~s" (sui-referenced-file m e))
+		(printf " :mark ~s" (markup-ident m))
+		(when (markup-class m)
+		   (printf " :class ~s" (markup-class m)))
+		(display ")"))
+	     (search-down (lambda (n) (is-markup? n 'mark)) n))
+   (display ")\n"))
+
+;*---------------------------------------------------------------------*/
+;*    sui-blocks ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (sui-blocks kind n e)
+   (printf "  (~as" kind)
+   (for-each (lambda (chap)
+		(display "\n    (\"")
+		(skribe-eval (markup-option chap :title) html-title-engine)
+		(printf "\" :file ~s" (sui-referenced-file chap e))
+		(printf " :mark ~s" (markup-ident chap))
+		(when (markup-class chap)
+		   (printf " :class ~s" (markup-class chap)))
+		(display ")"))
+	     (container-search-down (lambda (n) (is-markup? n kind)) n))
+   (display ")\n"))
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :before (lambda (n e)
+	      (display "<table")
+	      (html-class n)
+	      (display "><tbody>\n"))
+   :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))
+		    (nfn (engine-custom e 'author-font))
+		    (align (markup-option n :align)))
+		 (define (row n)
+		    (printf "<tr><td align=\"~a\">" align)
+		    (output n e)
+		    (display "</td></tr>"))
+		 ;; name
+		 (printf "<tr><td align=\"~a\">" align)
+		 (if nfn
+		     (printf "<font ~a>\n" nfn)
+		     (display "<font size=\"+2\"><i>\n"))
+		 (output name e)
+		 (if nfn
+		     (printf "</font>\n")
+		     (display "</i></font>\n"))
+		 (display "</td></tr>")
+		 ;; title
+		 (if title (row title))
+		 ;; affiliation
+		 (if affiliation (row affiliation))
+		 ;; address
+		 (if (pair? address)
+		     (for-each row address))
+		 ;; telephone
+		 (if phone (row phone))
+		 ;; email
+		 (if email (row email))
+		 ;; url
+		 (if url (row url))))
+   :after "</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;*    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)
+	      (display "<table")
+	      (html-class n)
+	      (display "><tbody>\n<tr>"))
+   :action (lambda (n e)
+	      (let ((photo (markup-option n :photo)))
+		 (display "<td>")
+		 (output photo e)
+		 (display "</td><td>")
+		 (markup-option-add! n :photo #f)
+		 (output n e)
+		 (markup-option-add! n :photo photo)
+		 (display "</td>")))
+   :after "</tr>\n</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;*    toc ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'toc
+   :options 'all
+   :action (lambda (n e)
+	      (define (col n)
+		 (let loop ((i 0))
+		      (if (< i n)
+			  (begin
+			     (display "<td></td>")
+			     (loop (+ i 1))))))
+	      (define (toc-entry fe level)
+		 (let* ((c (car fe))
+			(ch (cdr fe))
+			(t (markup-option c :title))
+			(id (markup-ident c))
+			(f (html-file c e)))
+		    (unless (string? id)
+		       (skribe-error 'toc
+				     (format "Illegal identifier `~a'" id)
+				     c))
+		    (display " <tr>")
+		    ;; blank columns
+		    (col level)
+		    ;; number
+		    (printf "<td valign=\"top\" align=\"left\">~a</td>" 
+			    (html-container-number c e))
+		    ;; title
+		    (printf "<td colspan=\"~a\" width=\"100%\">"
+			    (- 4 level))
+		    (printf "<a href=\"~a#~a\">" 
+			    (if (string=? f *skribe-dest*)
+				""
+				(strip-ref-base (or f *skribe-dest* "")))
+			    (string-canonicalize id))
+		    (output (markup-option c :title) e)
+		    (display "</a></td>")
+		    (display "</tr>\n")
+		    ;; the children
+		    (for-each (lambda (n) (toc-entry n (+ 1 level))) ch)))
+	      (define (symbol->keyword s)
+		 (cond-expand
+		    (stklos
+		     (make-keyword s))
+		    (bigloo
+		     (string->keyword (string-append ":" (symbol->string s))))))
+	      (let* ((c (markup-option n :chapter))
+		     (s (markup-option n :section))
+		     (ss (markup-option n :subsection))
+		     (sss (markup-option n :subsubsection))
+		     (b (markup-body n))
+		     (bb (if (handle? b)
+			     (handle-ast b)
+			     b)))
+		 (if (not (container? bb))
+		     (error 'toc 
+			    "Illegal body (container expected)" 
+			    (if (markup? bb)
+				(markup-markup bb)
+				"???"))
+		     (let ((lst (find-down (lambda (x)
+					     (and (markup? x)
+						  (markup-option x :toc)
+						  (or (and sss (is-markup? x 'subsubsection))
+						      (and ss (is-markup? x 'subsection))
+						      (and s (is-markup? x 'section))
+						      (and c (is-markup? x 'chapter))
+						      (markup-option n (symbol->keyword 
+									(markup-markup x))))))
+					   (container-body bb))))
+		       ;; avoid to produce an empty table
+		       (unless (null? lst)
+			  (display "<table cellspacing=\"1\" cellpadding=\"1\" width=\"100%\"")
+			  (html-class n)
+			  (display ">\n<tbody>\n")
+			  
+			  (for-each (lambda (n) (toc-entry n 0)) lst)
+			  
+			  (display "</tbody>\n</table>\n")))))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-document ...                                       */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-document n title e)
+   (let* ((id (markup-ident n))
+	  (header (new markup
+		     (markup '&html-chapter-header)
+		     (ident (string-append id "-header"))
+		     (class (markup-class n))
+		     (parent n)
+		     (body (html-browser-title n))))
+	  (head (new markup
+		   (markup '&html-head)
+		   (ident (string-append id "-head"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body header)))
+	  (ftnote (new markup
+		     (markup '&html-footnotes)
+		     (ident (string-append id "-footnote"))
+		     (class (markup-class n))
+		     (parent n)
+		     (body (reverse! 
+			    (container-env-get n 'footnote-env)))))
+	  (page (new markup
+		   (markup '&html-page)
+		   (ident (string-append id "-page"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body (list (markup-body n) ftnote))))
+	  (ending (new markup
+		     (markup '&html-ending)
+		     (ident (string-append id "-ending"))
+		     (class (markup-class n))
+		     (parent n)
+		     (body (or (markup-option n :ending)
+			       (let ((p (ast-document n)))
+				  (and p (markup-option p :ending)))))))
+	  (body (new markup 
+		   (markup '&html-body)
+		   (ident (string-append id "-body"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body (list title page ending))))
+	  (html (new markup
+		   (markup '&html-html)
+		   (ident (string-append id "-html"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body (list head body)))))
+      ;; No file must be opened for documents. These files are
+      ;; directly opened by Skribe
+      (if (document? n)
+	  (output html e)
+	  (with-output-to-file (html-file n e)
+	     (lambda ()
+		(output html e))))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-subdocument ...                                    */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-subdocument n e)
+   (let* ((p (ast-document n))
+	  (id (markup-ident n))
+	  (ti (let* ((nb (html-container-number n e))
+		     (tc (markup-option n :title))
+		     (ti (if (document? p)
+			     (list (markup-option p :title) 
+				   (engine-custom e 'file-title-separator)
+				   tc)
+			     tc))
+		     (sep (engine-custom 
+			     e
+			     (symbol-append (markup-markup n) 
+					    '-title-number-separator)))
+		     (nti (and tc
+			       (if (and nb (not (equal? nb "")))
+				   (list nb 
+					 (if (unspecified? sep) ". " sep)
+					 ti)
+				   ti))))
+		 (new markup
+		    (markup (symbol-append '&html- (markup-markup n) '-title))
+		    (ident (string-append id "-title"))
+		    (parent n)
+		    (options '((author ())))
+		    (body nti)))))
+      (case (markup-markup n)
+	 ((chapter)
+	  (skribe-message "  [~s chapter: ~a]\n" (engine-ident e) id))
+	 ((section)
+	  (skribe-message "    [~s section: ~a]\n" (engine-ident e) id)))
+      (&html-generic-document n ti e)))
+
+;*---------------------------------------------------------------------*/
+;*    chapter ... @label chapter@                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'chapter
+   :options '(:title :number :file :toc :html-title :env)
+   :before (lambda (n e)
+	      (let ((title (markup-option n :title))
+		    (ident (markup-ident n)))
+		 (display "<!-- ")
+		 (output title html-title-engine)
+		 (display " -->\n")
+		 (display "<a name=\"")
+		 (display (string-canonicalize ident))
+		 (display "\"></a>\n")
+		 (display "<center><h1")
+		 (html-class n)
+		 (display ">")
+		 (output (html-container-number n e) e)
+		 (display " ")
+		 (output (markup-option n :title) e)
+		 (display "</h1></center>")))
+   :after "<br>")
+
+;; This writer is invoked only for chapters rendered inside separate files!
+(markup-writer 'chapter
+   :options '(:title :number :file :toc :html-title :env)
+   :predicate (lambda (n e)
+		 (or (markup-option n :file)
+		     (engine-custom e 'chapter-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    html-section-title ...                                           */
+;*---------------------------------------------------------------------*/
+(define (html-section-title n e)
+   (let* ((title (markup-option n :title))
+	  (number (markup-option n :number))
+	  (c (markup-class n))
+	  (ident (markup-ident n))
+	  (kind (markup-markup n))
+	  (tbg (engine-custom e (symbol-append kind '-title-background)))
+	  (tfg (engine-custom e (symbol-append kind '-title-foreground)))
+	  (tstart (engine-custom e (symbol-append kind '-title-start)))
+	  (tstop (engine-custom e (symbol-append kind '-title-stop)))
+	  (nsep (engine-custom e (symbol-append kind '-title-number-separator))))
+      ;; the section header
+      (display "<!-- ")
+      (output title html-title-engine)
+      (display " -->\n")
+      (display "<a name=\"")
+      (display (string-canonicalize ident))
+      (display "\"></a>\n")
+      (if c
+	  (printf "<div class=\"~a-atitle\">" c)
+	  (printf "<div class=\"skribe~atitle\">" (markup-markup n)))
+      (when (html-color-spec? tbg)
+	 (display "<table width=\"100%\">")
+	 (printf "<tr><td bgcolor=\"~a\">" tbg))
+      (display tstart)
+      (if tfg (printf "<font color=\"~a\">" tfg))
+      (if number
+	  (begin
+	     (output (html-container-number n e) e)
+	     (output nsep e)))
+      (output title e)
+      (if tfg (display "</font>\n"))
+      (display tstop)
+      (when (and (string? tbg) (> (string-length tbg) 0))
+	 (display "</td></tr></table>\n"))
+      (display "</div>")
+      (display "<div")
+      (html-class n)
+      (display ">"))
+   (newline))
+
+;*---------------------------------------------------------------------*/
+;*    section ...  @label section@                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :before html-section-title
+   :after "</div><br>\n")
+
+;; on-file section writer
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :predicate (lambda (n e) 
+		 (or (markup-option n :file)
+		     (engine-custom e 'section-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    subsection ... @label subsection@                                */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsection
+   :options '(:title :html-title :number :toc :env :file)
+   :before html-section-title
+   :after "</div>\n")
+		     
+;; on-file subsection writer
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :predicate (lambda (n e) 
+		 (or (markup-option n :file)
+		     (engine-custom e 'subsection-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    subsubsection ... @label subsubsection@                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsubsection
+   :options '(:title :html-title :number :toc :env :file)
+   :before html-section-title
+   :after "</div>\n")
+
+;; on-file subsection writer
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :predicate (lambda (n e) 
+		 (or (markup-option n :file)
+		     (engine-custom e 'subsubsection-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    paragraph ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'paragraph 
+   :before (lambda (n e)
+	      (when (and (>= (skribe-debug) 2) (location? (ast-loc n)))
+		 (printf "<span style=\"display: block; position: relative; left: -2cm; font-size: x-small; font-style: italic; color: ff8e1e;\">~a</span>"
+			 (ast-location n)))
+	      ((html-markup-class "p") n e))
+   :after "</p>")
+
+;*---------------------------------------------------------------------*/
+;*    footnote ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'footnote
+   :options '(:number)
+   :action (lambda (n e)
+	      (printf "<a href=\"#footnote-~a\"><sup><small>~a</small></sup></a>"
+		      (string-canonicalize (container-ident n))
+		      (markup-option n :number))))
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'linebreak 
+	       :before (lambda (n e)
+			  (display "<br")
+			  (html-class n)
+			  (display "/>")))
+
+;*---------------------------------------------------------------------*/
+;*    hrule ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'hrule 
+   :options '(:width :height)
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (height (markup-option n :height)))
+		 (display "<hr")
+		 (html-class n)
+		 (if (< width 100) 
+		     (printf " width=\"~a\"" (html-width width)))
+		 (if (> height 1)
+		     (printf " size=\"~a\"" height))
+		 (display ">"))))
+
+;*---------------------------------------------------------------------*/
+;*    color ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'color
+   :options '(:bg :fg :width :margin)
+   :before (lambda (n e) 
+	      (let ((m (markup-option n :margin))
+		    (w (markup-option n :width))
+		    (bg (markup-option n :bg))
+		    (fg (markup-option n :fg)))
+		 (when (html-color-spec? bg)
+		    (display "<table cellspacing=\"0\"")
+		    (html-class n)
+		    (printf " cellpadding=\"~a\"" (if m m 0))
+		    (if w (printf " width=\"~a\"" (html-width w)))
+		    (display "><tbody>\n<tr>")
+		    (display "<td bgcolor=\"")
+		    (output bg e)
+		    (display "\">"))
+		 (when (html-color-spec? fg) 
+		    (display "<font color=\"")
+		    (output fg e)
+		    (display "\">"))))
+   :after (lambda (n e)
+	     (when (html-color-spec? (markup-option n :fg))
+		(display "</font>"))
+	     (when (html-color-spec? (markup-option n :bg))
+		(display "</td></tr>\n</tbody></table>"))))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'frame
+   :options '(:width :margin :border)
+   :before (lambda (n e) 
+	      (let ((m (markup-option n :margin))
+		    (b (markup-option n :border))
+		    (w (markup-option n :width)))
+		 (display "<table cellspacing=\"0\"")
+		 (html-class n)
+		 (printf " cellpadding=\"~a\"" (if m m 0))
+		 (printf " border=\"~a\"" (if b b 0))
+		 (if w (printf " width=\"~a\"" (html-width w)))
+		 (display "><tbody>\n<tr><td>")))
+   :after "</td></tr>\n</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;*    font ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'font
+   :options '(:size :face)
+   :before (lambda (n e) 
+	      (let ((size (markup-option n :size))
+		    (face (markup-option n :face)))
+		 (when (and (number? size) (inexact? size))
+		    (let ((s (if (> size 0) "<big>" "<small>"))
+			  (d (if (> size 0) 1 -1)))
+		       (do ((i (inexact->exact size) (- i d)))
+			   ((= i 0))
+			   (display s))))
+		 (when (or (and (number? size) (exact? size)) face)
+		    (display "<font")
+		    (html-class n)
+		    (when (and (number? size) (exact? size) (not (= size 0)))
+		       (printf " size=\"~a\"" size))
+		    (when face (printf " face=\"~a\"" face))
+		    (display ">"))))
+   :after (lambda (n e)
+	     (let ((size (markup-option n :size))
+		   (face (markup-option n :face)))
+		(when (or (and (number? size) (exact? size) (not (= size 0)))
+			  face)
+		   (display "</font>"))
+		(when (and (number? size) (inexact? size))
+		   (let ((s (if (> size 0) "</big>" "</small>"))
+			 (d (if (> size 0) 1 -1)))
+		      (do ((i (inexact->exact size) (- i d)))
+			  ((= i 0))
+			  (display s)))))))
+
+;*---------------------------------------------------------------------*/
+;*    flush ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'flush
+   :options '(:side)
+   :before (lambda (n e)
+	      (case (markup-option n :side)
+		 ((center)
+		  (display "<center")
+		  (html-class n)
+		  (display ">\n"))
+		 ((left)
+		  (display "<p style=\"text-align:left;\"")
+		  (html-class n)
+		  (display ">\n"))
+		 ((right)
+		  (display "<table ")
+		  (html-class n)
+		  (display "width=\"100%\" cellpadding=\"0\" cellspacing=\"0\" border=\"0\"><tr><td align=\"right\">"))
+		 (else
+		  (skribe-error 'flush 
+				"Illegal side" 
+				(markup-option n :side)))))
+   :after (lambda (n e)
+	     (case (markup-option n :side)
+		((center)
+		 (display "</center>\n"))
+		((right)
+		 (display "</td></tr></table>\n"))
+		((left)
+		 (display "</p>\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+   :before (html-markup-class "center")
+   :after "</center>\n")
+
+;*---------------------------------------------------------------------*/
+;*    pre ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'pre :before (html-markup-class "pre") :after "</pre>\n")
+
+;*---------------------------------------------------------------------*/
+;*    prog ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'prog
+   :options '(:line :mark)
+   :before (html-markup-class "pre")
+   :after "</pre>\n")
+
+;*---------------------------------------------------------------------*/
+;*    itemize ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'itemize
+   :options '(:symbol)	       
+   :before (html-markup-class "ul")
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display "<li")
+			   (html-class item)
+			   (display ">")
+			   (output item e)
+			   (display "</li>\n"))
+			(markup-body n)))
+   :after "</ul>")
+
+;*---------------------------------------------------------------------*/
+;*    enumerate ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'enumerate
+   :options '(:symbol)	       
+   :before (html-markup-class "ol")
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display "<li")
+			   (html-class item)
+			   (display ">")
+			   (output item e)
+			   (display "</li>\n"))
+			(markup-body n)))
+   :after "</ol>")
+
+;*---------------------------------------------------------------------*/
+;*    description ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'description
+   :options '(:symbol)	       
+   :before (html-markup-class "dl")
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (let ((k (markup-option item :key)))
+			      (for-each (lambda (i)
+					   (display " <dt")
+					   (html-class i)
+					   (display ">")
+					   (output i e)
+					   (display "</dt>"))
+					(if (pair? k) k (list k)))
+			      (display "<dd")
+			      (html-class item)
+			      (display ">")
+			      (output (markup-body item) e)
+			      (display "</dd>\n")))
+			(markup-body n)))
+   :after "</dl>")
+
+;*---------------------------------------------------------------------*/
+;*    item ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'item
+   :options '(:key)	       
+   :action (lambda (n e)
+	      (let ((k (markup-option n :key)))
+		 (if k
+		     (begin
+			(display "<b")
+			(html-class n)
+			(display ">")
+			(output k e)
+			(display "</b> "))))
+	      (output (markup-body n) e)))
+
+;*---------------------------------------------------------------------*/
+;*    blockquote ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'blockquote 
+   :options '()
+   :before (lambda (n e) 
+	     (display "<blockquote ")
+	     (html-class n)
+	     (display ">\n"))
+   :after "\n</blockquote>\n")
+
+;*---------------------------------------------------------------------*/
+;*    figure ... @label figure@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'figure
+   :options '(:legend :number :multicolumns :legend-width)
+   :before (html-markup-class "br")
+   :action (lambda (n e)
+	      (let ((ident (markup-ident n))
+		    (number (markup-option n :number))
+		    (legend (markup-option n :legend)))
+		 (display "<a name=\"")
+		 (display (string-canonicalize ident))
+		 (display "\"></a>\n")
+		 (output (markup-body n) e)
+		 (display "<br>\n")
+		 (output (new markup
+			    (markup '&html-figure-legend)
+			    (parent n)
+			    (ident (string-append ident "-legend"))
+			    (class (markup-class n))
+			    (options `((:number ,number)))
+			    (body legend))
+			 e)))
+   :after "<br>")
+
+;*---------------------------------------------------------------------*/
+;*    &html-figure-legend ...                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-figure-legend 
+   :options '(:number)
+   :before (lambda (n e)
+	      (display "<center>")
+	      (let ((number (markup-option n :number))
+		    (legend (markup-option n :legend)))
+		 (if number 
+		     (printf "<strong>Fig. ~a:</strong> " number)
+		     (printf "<strong>Fig. :</strong> "))))
+   :after "</center>")
+   
+;*---------------------------------------------------------------------*/
+;*    table ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'table
+   :options '(:border :width :frame :rules :cellstyle :cellpadding :cellspacing)
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (border (markup-option n :border))
+		    (frame (markup-option n :frame))
+		    (rules (markup-option n :rules))
+		    (cstyle (markup-option n :cellstyle))
+		    (cp (markup-option n :cellpadding))
+		    (cs (markup-option n :cellspacing)))
+		 (display "<table")
+		 (html-class n)
+		 (if width (printf " width=\"~a\"" (html-width width)))
+		 (if border (printf " border=\"~a\"" border))
+		 (if (and (number? cp) (>= cp 0))
+		     (printf " cellpadding=\"~a\"" cp))
+		 (if (and (number? cs) (>= cs 0))
+		     (printf " cellspacing=\"~a\"" cs))
+		 (cond
+		    ((symbol? cstyle)
+		     (printf " style=\"border-collapse: ~a;\"" cstyle))
+		    ((string? cstyle)
+		     (printf " style=\"border-collapse: separate; border-spacing=~a\"" cstyle))
+		    ((number? cstyle)
+		     (printf " style=\"border-collapse: separate; border-spacing=~apt\"" cstyle)))
+		 (if frame
+		     (printf " frame=\"~a\"" 
+			     (if (eq? frame 'none) "void" frame)))
+		 (if (and rules (not (eq? rules 'header)))
+		     (printf " rules=\"~a\"" rules))
+		 (display "><tbody>\n")))
+   :after "</tbody></table>\n")
+
+;*---------------------------------------------------------------------*/
+;*    tr ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tr
+   :options '(:bg)
+   :before (lambda (n e)
+	      (let ((bg (markup-option n :bg)))
+		 (display "<tr")
+		 (html-class n)
+		 (when (html-color-spec? bg) (printf " bgcolor=\"~a\"" bg))
+		 (display ">")))
+   :after "</tr>\n")
+	      
+;*---------------------------------------------------------------------*/
+;*    tc ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tc
+   :options '(markup :width :align :valign :colspan :rowspan :bg)
+   :before (lambda (n e)
+	      (let ((markup (or (markup-option n 'markup) 'td))
+		    (width (markup-option n :width))
+		    (align (markup-option n :align))
+		    (valign (let ((v (markup-option n :valign)))
+			       (cond
+				  ((or (eq? v 'center)
+				       (equal? v "center"))
+				   "middle")
+				  (else
+				   v))))
+		    (colspan (markup-option n :colspan))
+		    (rowspan (markup-option n :rowspan))
+		    (bg (markup-option n :bg)))
+		 (printf "<~a" markup)
+		 (html-class n)
+		 (if width (printf " width=\"~a\"" (html-width width)))
+		 (if align (printf " align=\"~a\"" align))
+		 (if valign (printf " valign=\"~a\"" valign))
+		 (if colspan (printf " colspan=\"~a\"" colspan))
+		 (if rowspan (printf " rowspan=\"~a\"" rowspan))
+		 (when (html-color-spec? bg)
+		    (printf " bgcolor=\"~a\"" bg))
+		 (display ">")))
+   :after (lambda (n e)
+	     (let ((markup (or (markup-option n 'markup) 'td)))
+		(printf "</~a>" markup))))
+	      
+;*---------------------------------------------------------------------*/
+;*    image ... @label image@                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'image
+   :options '(:file :url :width :height)
+   :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))
+		     (body (markup-body n))
+		     (efmt (engine-custom e 'image-format))
+		     (img (or url (convert-image file 
+						 (if (list? efmt)
+						     efmt
+						     '("gif" "jpg" "png"))))))
+		 (if (not (string? img))
+		     (skribe-error 'html "Illegal image" file)
+		     (begin
+			(printf "<img src=\"~a\" border=\"0\"" img)
+			(html-class n)
+			(if body
+			    (begin
+			       (display " alt=\"")
+			       (output body e)
+			       (display "\""))
+			    (printf " alt=\"~a\"" file))
+			(if width (printf " width=\"~a\"" (html-width width)))
+			(if height (printf " height=\"~a\"" height))
+			(display ">"))))))
+
+;*---------------------------------------------------------------------*/
+;*    Ornaments ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'roman :before "")
+(markup-writer 'bold :before (html-markup-class "strong") :after "</strong>")
+(markup-writer 'underline :before (html-markup-class "u") :after "</u>")
+(markup-writer 'strike :before (html-markup-class "strike") :after "</strike>")
+(markup-writer 'emph :before (html-markup-class "em") :after "</em>")
+(markup-writer 'kbd :before (html-markup-class "kbd") :after "</kbd>")
+(markup-writer 'it :before (html-markup-class "em") :after "</em>")
+(markup-writer 'tt :before (html-markup-class "tt") :after "</tt>")
+(markup-writer 'code :before (html-markup-class "code") :after "</code>")
+(markup-writer 'var :before (html-markup-class "var") :after "</var>")
+(markup-writer 'samp :before (html-markup-class "samp") :after "</samp>")
+(markup-writer 'sc :before "<span class=\"sc\">" :after "</span>")
+(markup-writer 'sf :before "<span class=\"sf\">" :after "</span>")
+(markup-writer 'sub :before (html-markup-class "sub") :after "</sub>")
+(markup-writer 'sup :before (html-markup-class "sup") :after "</sup>")
+
+;*---------------------------------------------------------------------*/
+;*    q ... @label q@                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'q
+   :before "\""
+   :after "\"")
+
+;*---------------------------------------------------------------------*/
+;*    mailto ... @label mailto@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+   :options '(:text)
+   :action (lambda (n e)
+	      (let ((text (markup-option n :text)))
+		 (display "<a href=\"mailto:")
+		 (output (markup-body n) e)
+		 (display #\")
+		 (html-class n)
+		 (display #\>)
+		 (if text
+		     (output text e)
+		     (skribe-eval (tt (markup-body n)) e))
+		 (display "</a>"))))
+
+;*---------------------------------------------------------------------*/
+;*    mailto ... @label mailto@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+   :options '(:text)
+   :predicate (lambda (n e) 
+		 (and (engine-custom e 'javascript)
+		      (or (string? (markup-body n))
+			  (and (pair? (markup-body n))
+			       (null? (cdr (markup-body n)))
+			       (string? (car (markup-body n)))))))
+   :action (lambda (n e)
+	      (let* ((body (markup-body n))
+		     (email (if (string? body) body (car body)))
+		     (split (pregexp-split "@" email))
+		     (na (car split))
+		     (do (if (pair? (cdr split)) (cadr split) ""))
+		     (nn (pregexp-replace* "[.]" na " "))
+		     (dd (pregexp-replace* "[.]" do " "))
+		     (text (markup-option n :text)))
+		(display "<script language=\"JavaScript\" type=\"text/javascript\"")
+		(if (not text)
+		    (printf ">skribenospam( ~s, ~s, true )" nn dd)
+		    (begin
+		      (printf ">skribenospam( ~s, ~s, false )" nn dd)
+		      (display "</script>")
+		      (output text e)
+		      (display "<script language=\"JavaScript\" type=\"text/javascript\">document.write(\"</\" + \"a>\")")))
+		(display "</script>\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    mark ... @label mark@                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mark
+   :before (lambda (n e)
+	      (printf "<a name=\"~a\"" (string-canonicalize (markup-ident n)))
+	      (html-class n)
+	      (display ">"))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    ref ... @label ref@                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer 'ref
+   :options '(:text :chapter :section :subsection :subsubsection :figure :mark :handle)
+   :before (lambda (n e)
+	      (let* ((c (handle-ast (markup-body n)))
+		     (id (markup-ident c))
+		     (f (html-file c e))
+		     (class (if (markup-class n)
+				(markup-class n)
+				"inbound")))
+		 (printf "<a href=\"~a#~a\" class=\"~a\""
+			 (if (string=? f *skribe-dest*)
+			     ""
+			     (strip-ref-base (or f *skribe-dest* "")))
+			 (string-canonicalize id)
+			 class)
+		 (display ">")))
+   :action (lambda (n e)
+	      (let ((t (markup-option n :text))
+		    (m (markup-option n 'mark))
+		    (f (markup-option n :figure))
+		    (c (markup-option n :chapter))
+		    (s (markup-option n :section))
+		    (ss (markup-option n :subsection))
+		    (sss (markup-option n :subsubsection)))
+		 (cond
+		    (t
+		     (output t e))
+		    (f
+		     (output (new markup
+				(markup '&html-figure-ref)
+				(body (markup-body n)))
+			     e))
+		    ((or c s ss sss)
+		     (output (new markup
+				(markup '&html-section-ref)
+				(body (markup-body n)))
+			     e))
+					
+		    ((not m)
+		     (output (new markup
+				(markup '&html-unmark-ref)
+				(body (markup-body n)))
+			     e))
+		    (else
+		     (display m)))))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    &html-figure-ref ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-figure-ref 
+   :action (lambda (n e)
+	      (let ((c (handle-ast (markup-body n))))
+		 (if (or (not (markup? c))
+			 (not (is-markup? c 'figure)))
+		     (display "???")
+		     (output (markup-option c :number) e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-section-ref ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-section-ref 
+   :action (lambda (n e)
+	      (let ((c (handle-ast (markup-body n))))
+		 (if (not (markup? c))
+		     (display "???")
+		     (output (markup-option c :title) e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-unmark-ref ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-unmark-ref 
+   :action (lambda (n e)
+	      (let ((c (handle-ast (markup-body n))))
+		 (if (not (markup? c))
+		     (display "???")
+		     (let ((t (markup-option c :title)))
+			(if t
+			    (output t e)
+			    (let ((l (markup-option c :legend)))
+			       (if l
+				   (output t e)
+				   (display 
+				    (string-canonicalize 
+				     (markup-ident c)))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e) (output n e (markup-writer-get 'ref 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)
+			 (output (car rs) e (markup-writer-get 'ref e))
+			 (output (car rs) e))
+		     (if (pair? (cdr rs))
+			 (begin
+			    (display ",")
+			    (loop (cdr rs))))))))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    url-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :before (lambda (n e)
+	      (let* ((url (markup-option n :url))
+		     (class (cond
+			       ((markup-class n)
+				(markup-class n))
+			       ((not (string? url))
+				#f)
+			       (else
+				(let ((l (string-length url)))
+				   (let loop ((i 0))
+				      (cond
+					 ((= i l)
+					  #f)
+					 ((char=? (string-ref url i) #\:)
+					  (substring url 0 i))
+					 (else
+					  (loop (+ i 1))))))))))
+		 (display "<a href=\"")
+		 (output url html-title-engine)
+		 (display "\"")
+		 (when class (printf " class=\"~a\"" class))
+		 (display ">")))
+   :action (lambda (n e) 
+	      (let ((v (markup-option n :text)))
+		 (output (or v (markup-option n :url)) e)))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    line-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+   :options '(:offset)
+   :before (html-markup-class "i")
+   :action (lambda (n e)
+	      (let ((o (markup-option n :offset))
+		    (v (string->number (markup-option n :text))))
+		 (if (and (number? o) (number? v))
+		     (markup-option-add! n :text (+ o v)))
+		 (output n e (markup-writer-get 'ref e))
+		 (if (and (number? o) (number? v))
+		     (markup-option-add! n :text v))))
+   :after "</i>")
+
+;*---------------------------------------------------------------------*/
+;*    page-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'page-ref
+   :options '(:mark :handle)
+   :action (lambda (n e)
+	      (error 'page-ref:html "Not implemented yet" n)))
+   
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-label ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before (lambda (n e)
+	      (printf "<a name=\"~a\"" (string-canonicalize (markup-ident n)))
+	      (html-class n)
+	      (display ">"))
+   :action (lambda (n e)
+	      (output n e (markup-writer-get '&bib-entry-label base-engine)))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-title ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+   :action (lambda (n e)
+	      (let* ((t (bold (markup-body n)))
+		     (en (handle-ast (ast-parent n)))
+		     (url (or (markup-option en 'url)
+			      (markup-option en 'documenturl)))
+		     (ht (if url (ref :url (markup-body url) :text t) t)))
+		 (skribe-eval ht e))))
+
+;*---------------------------------------------------------------------*/
+;*    &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))))
+
+;*---------------------------------------------------------------------*/
+;*    &the-index-header ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index-header
+   :action (lambda (n e)
+	      (display "<center")
+	      (html-class n)
+	      (display ">")
+	      (for-each (lambda (h)
+			   (let ((f (engine-custom e 'index-header-font-size)))
+			      (if f
+				  (skribe-eval (font :size f (bold (it h))) e)
+				  (output h e))
+			      (display " ")))
+			(markup-body n))
+	      (display "</center>")
+	      (skribe-eval (linebreak 2) 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 (bold (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 'source-color) cc)
+			     (color :fg cc n1)
+			     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))
+			     (bold 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))
diff --git a/skr/html4.skr b/skr/html4.skr
new file mode 100644
index 0000000..acb7068
--- /dev/null
+++ b/skr/html4.skr
@@ -0,0 +1,165 @@
+;;;;
+;;;; html4.skr				-- HTML 4.01 Engine
+;;;; 
+;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;; 
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
+;;;; USA.
+;;;; 
+;;;;           Author: Erick Gallesio [eg@essi.fr]
+;;;;    Creation date: 18-Feb-2004 11:58 (eg)
+;;;; Last file update: 26-Feb-2004 21:09 (eg)
+;;;;
+
+(define (find-children node)
+  (define (flat l)
+    (cond 
+      ((null? l) l)
+      ((pair? l) (append (flat (car l))
+			 (flat (cdr l))))
+      (else      (list l))))
+  
+  (if (markup? node) 
+      (flat (markup-body node))
+      node))
+
+;;; ======================================================================
+
+(let ((le (find-engine 'html)))
+  ;;----------------------------------------------------------------------
+  ;;	Customizations
+  ;;----------------------------------------------------------------------
+  (engine-custom-set! le 'html-variant    "html4")
+  (engine-custom-set! le 'html4-logo      "http://www.w3.org/Icons/valid-html401")
+  (engine-custom-set! le 'html4-validator "http://validator.w3.org/check/referer")
+  
+  ;;----------------------------------------------------------------------
+  ;; 	&html-html ...
+  ;;----------------------------------------------------------------------
+  (markup-writer '&html-html le
+     :before "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+<html>\n"
+     :after "</html>")
+
+  ;;----------------------------------------------------------------------
+  ;; 	&html-ending
+  ;;----------------------------------------------------------------------
+  (let* ((img (engine-custom le 'html4-logo))
+	 (url (engine-custom le 'html4-validator))
+	 (bottom (list (hrule) 
+		      (table :width 100.
+			 (tr
+			    (td :align 'left
+			       (font :size -1 [
+				 This ,(sc "Html") page has been produced by 
+				      ,(ref :url (skribe-url) :text "Skribe").
+				      ,(linebreak)
+				      Last update ,(it (date)).]))
+			    (td :align 'right :valign 'top
+			       (ref :url url 
+				  :text (image :url img :width 88 :height 31))))))))
+    (markup-writer '&html-ending le
+       :before "<div class=\"skribe-ending\">"
+       :action (lambda (n e)
+		 (let ((body (markup-body n)))
+		   (if body
+		       (output body #t)
+		       (skribe-eval bottom e))))
+       :after "</div>\n"))
+  
+  ;;----------------------------------------------------------------------
+  ;;	color ...
+  ;;----------------------------------------------------------------------
+  (markup-writer 'color le
+     :options '(:bg :fg :width :margin)
+     :before (lambda (n e) 
+	       (let ((m    (markup-option n :margin))
+		     (w    (markup-option n :width))
+		     (bg   (markup-option n :bg))
+		     (fg   (markup-option n :fg)))
+		 (when bg
+		   (display "<table cellspacing=\"0\"")
+		   (html-class n)
+		   (printf " cellpadding=\"~a\"" (if m m 0))
+		   (if w (printf " width=\"~a\"" (html-width w)))
+		   (display "><tbody>\n<tr>")
+		   (display "<td bgcolor=\"")
+		   (output bg e)
+		   (display "\">"))
+		 (when fg
+		   (display "<span style=\"color:")
+		   (output fg e)
+		   (display ";\">"))))
+     :after (lambda (n e)
+	      (when (markup-option n :fg)
+		(display "</span>"))
+	      (when (markup-option n :bg) 
+		(display "</td></tr>\n</tbody></table>"))))
+  
+  ;;----------------------------------------------------------------------
+  ;;	font ...
+  ;;----------------------------------------------------------------------
+  (markup-writer 'font le
+     :options '(:size :face)
+     :before (lambda (n e) 
+	       (let ((face (markup-option n :face))
+		     (size (let ((sz (markup-option n :size)))
+			     (cond
+			       ((or (unspecified? sz) (not sz))
+				#f)
+			       ((and (number? sz) (or (inexact? sz) (negative? sz)))
+				(format "~a%" 
+					(+ 100 
+					   (* 20 (inexact->exact (truncate sz))))))
+			       ((number? sz)
+				sz)
+			       (else 
+				(skribe-error 'font
+					      (format "Illegal font size ~s" sz)
+					      n))))))
+		 (display "<span ")
+		 (html-class n)
+		 (display "style=\"")
+		 (if size (printf "font-size: ~a; " size))
+		 (if face (printf "font-family:'~a'; " face))
+		 (display "\">")))
+     :after "</span>")
+
+  ;;----------------------------------------------------------------------
+  ;;	paragraph ...
+  ;;----------------------------------------------------------------------
+  (copy-markup-writer 'paragraph le
+     :validate (lambda (n e)
+		 (let ((pred (lambda (x)
+			       (and (container? x)
+				    (not (memq (markup-markup x) '(font color)))))))
+		   (not (any pred (find-children n))))))
+
+  ;;----------------------------------------------------------------------
+  ;;	roman ...
+  ;;----------------------------------------------------------------------
+  (markup-writer 'roman le
+     :before "<span style=\"font-family: serif\">"
+     :after "</span>") 
+  
+  ;;----------------------------------------------------------------------
+  ;;	table ...
+  ;;----------------------------------------------------------------------
+  (let ((old-writer (markup-writer-get 'table le)))
+    (copy-markup-writer 'table le
+	:validate (lambda (n e)
+		    (not (null? (markup-body n))))))
+)
diff --git a/skr/jfp.skr b/skr/jfp.skr
new file mode 100644
index 0000000..60b40f2
--- /dev/null
+++ b/skr/jfp.skr
@@ -0,0 +1,317 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/jfp.skr                          */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sun Sep 28 14:40:38 2003                          */
+;*    Last change :  Mon Oct 11 15:44:08 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Skribe style for JFP articles.                               */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'documentclass "\\documentclass{jfp}")
+   (engine-custom-set! le 'hyperref #f)
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :action (lambda (n e)
+		 (define (&latex-subauthor)
+		    (let* ((d (ast-document n))
+			   (sa (and (is-markup? d 'document)
+				    (markup-option d :head-author))))
+		       (if sa
+			   (begin
+			      (display "[")
+			      (output sa e)
+			      (display "]")))))
+		 (define (&latex-author-1 n)
+		    (display "\\author")
+		    (&latex-subauthor)
+		    (display "{\n")
+		    (output n e)
+		    (display "}\n"))
+		 (define (&latex-author-n n)
+		    (display "\\author")
+		    (&latex-subauthor)
+		    (display "{\n")
+		    (output (car n) e)
+		    (for-each (lambda (a)
+				 (display "\\and ")
+				 (output a e))
+			      (cdr n))
+		    (display "}\n"))
+		 (let ((body (markup-body n)))
+		    (cond
+		       ((is-markup? body 'author)
+			(&latex-author-1 body))
+		       ((and (list? body)
+			     (every? (lambda (b) (is-markup? b 'author))
+				     body))
+			(&latex-author-n body))
+		       (else
+			(skribe-error 'author
+				      "Illegal `jfp' author"
+				      body))))))
+   ;; title
+   (markup-writer '&latex-title le
+      :before (lambda (n e)
+		 (let* ((d (ast-document n))
+			(st (and (is-markup? d 'document)
+				 (markup-option d :head-title))))
+		    (if st
+			(begin
+			   (display "\\title[")
+			   (output st e)
+			   (display "]{"))
+			(display "\\title{"))))
+      :after "}\n")
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (lambda (n e)
+		    (let ((name (markup-option n :name))
+			  (aff (markup-option n :affiliation))
+			  (addr (markup-option n :address))
+			  (email (markup-option n :email)))
+		       (if name
+			   (begin
+			      (output name e)
+			      (display "\\\\\n")))
+		       (if aff
+			   (begin
+			      (output aff e)
+			      (display "\\\\\n")))
+		       (if addr
+			   (begin
+			      (if (pair? addr)
+				  (for-each (lambda (a)
+					       (output a e)
+					       (display "\\\\\n"))
+					    addr)
+				  (begin
+				     (output addr e)
+				     (display "\\\\\n")))))
+		       (if email
+			   (begin
+			      (display "\\email{")
+			      (output email e)
+			      (display "}\\\\\n")))))))
+   ;; bib-ref
+   (markup-writer 'bib-ref le
+      :options '(:bib :text :key)
+      :before "("
+      :action (lambda (n e)
+		 (let ((be (handle-ast (markup-body n))))
+		    (if (is-markup? be '&bib-entry)
+			(let ((a (markup-option be 'author))
+			      (y (markup-option be 'year)))
+			   (cond
+			      ((and (is-markup? a '&bib-entry-author)
+				    (is-markup? y '&bib-entry-year))
+			       (let ((ba (markup-body a)))
+				  (if (not (string? ba))
+				      (output ba e)
+				      (let* ((s1 (pregexp-replace* " and "
+								   ba
+								   " \\& "))
+					     (s2 (pregexp-replace* ", [^ ]+"
+								   s1
+								   "")))
+					 (output s2 e)
+					 (display ", ")
+					 (output y e)))))
+			      ((is-markup? y '&bib-entry-year)
+			       (skribe-error 'bib-ref
+					     "Missing `name' entry"
+					     (markup-ident be)))
+			      (else
+			       (let ((ba (markup-body a)))
+				  (if (not (string? ba))
+				      (output ba e)
+				      (let* ((s1 (pregexp-replace* " and "
+								   ba
+								   " \\& "))
+					     (s2 (pregexp-replace* ", [^ ]+"
+								   s1
+								   "")))
+					 (output s2 e)))))))
+			(skribe-error 'bib-ref
+				      "Illegal bib-ref"
+				      (markup-ident be)))))
+      :after ")")
+      ;; bib-ref/text
+   (markup-writer 'bib-ref le
+      :options '(:bib :text :key)
+      :predicate (lambda (n e)
+		    (markup-option n :key))
+      :action (lambda (n e)
+		 (output (markup-option n :key) e)))
+   ;; &the-bibliography
+   (markup-writer '&the-bibliography le
+      :before (lambda (n e)
+		 (display "{%
+\\sloppy
+\\sfcode`\\.=1000\\relax
+\\newdimen\\bibindent
+\\bibindent=0em
+\\begin{list}{}{%
+        \\settowidth\\labelwidth{[]}%
+        \\leftmargin\\labelwidth
+        \\advance\\leftmargin\\labelsep
+        \\advance\\leftmargin\\bibindent
+        \\itemindent -\\bibindent
+        \\listparindent \\itemindent
+    }%\n"))
+      :after (lambda (n e)
+		(display "\n\\end{list}}\n")))
+   ;; bib-entry
+   (markup-writer '&bib-entry le
+      :options '(:title)
+      :action (lambda (n e)
+		 (output n e (markup-writer-get '&bib-entry-body e)))
+      :after "\n")
+   ;; %bib-entry-title
+   (markup-writer '&bib-entry-title le
+      :action (lambda (n e)
+		 (output (markup-body n) e)))
+   ;; %bib-entry-body
+   (markup-writer '&bib-entry-body le
+      :action (lambda (n e)
+		 (define (output-fields descr)
+		    (display "\\item[")
+		    (let loop ((descr descr)
+			       (pending #f)
+			       (armed #f)
+			       (first #t))
+		       (cond
+			  ((null? descr)
+			   'done)
+			  ((pair? (car descr))
+			   (if (eq? (caar descr) 'or)
+			       (let ((o1 (cadr (car descr))))
+				  (if (markup-option n o1)
+				      (loop (cons o1 (cdr descr)) 
+					    pending 
+					    #t
+					    #f)
+				      (let ((o2 (caddr (car descr))))
+					 (loop (cons o2 (cdr descr)) 
+					       pending
+					       armed
+					       #f))))
+			       (let ((o (markup-option n (cadr (car descr)))))
+				  (if o
+				      (begin
+					 (if (and pending armed)
+					     (output pending e))
+					 (output (caar descr) e)
+					 (output o e)
+					 (if (pair? (cddr (car descr)))
+					     (output (caddr (car descr)) e))
+					 (loop (cdr descr) #f #t #f))
+				      (loop (cdr descr) pending armed #f)))))
+			  ((symbol? (car descr))
+			   (let ((o (markup-option n (car descr))))
+			      (if o 
+				  (begin
+				     (if (and armed pending)
+					 (output pending e))
+				     (output o e)
+				     (if first
+					 (display "]"))
+				     (loop (cdr descr) #f #t #f))
+				  (loop (cdr descr) pending armed #f))))
+			  ((null? (cdr descr))
+			   (output (car descr) e))
+			  ((string? (car descr))
+			   (loop (cdr descr) 
+				 (if pending pending (car descr))
+				 armed
+				 #f))
+			  (else
+			   (skribe-error 'output-bib-fields
+					 "Illegal description"
+					 (car descr))))))
+		 (output-fields
+		  (case (markup-option n 'kind)
+		     ((techreport)
+		      `(author (" (" year ")") " " (or title url) ". " 
+			       number ", " institution ", "
+			       address ", " month ", "
+			       ("pp. " pages) "."))
+		     ((article)
+		      `(author (" (" year ")") " " (or title url) ". "
+			       journal ", " volume ", " ("(" number ")") ", "
+			       address ", " month ", " 
+			       ("pp. " pages) "."))
+		     ((inproceedings)
+		      `(author (" (" year ")") " " (or title url) ". " 
+			       book(or title url) ", " series ", " ("(" number ")") ", "
+			       address ", " month ", " 
+			       ("pp. " pages) "."))
+		     ((book)
+		      '(author (" (" year ")") " " (or title url) ". " 
+			       publisher ", " address
+			       ", " month ", " ("pp. " pages) "."))
+		     ((phdthesis)
+		      '(author (" (" year ")") " " (or title url) ". " type ", " 
+			       school ", " address
+			       ", " month "."))
+		     ((misc)
+		      '(author (" (" year ")") " " (or title url) ". "
+			       publisher ", " address
+			       ", " month "."))
+		     (else
+		      '(author (" (" year ")") " " (or title url) ". "
+			       publisher ", " address
+			       ", " month ", " ("pp. " pages) "."))))))
+   ;; abstract
+   (markup-writer 'jfp-abstract le
+       :options '(postscript)
+       :before "\\begin{abstract}\n"
+       :after "\\end{abstract}\n"))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-jfp-abstract he
+      :action (lambda (n e)
+		 (let* ((bg (engine-custom e 'abstract-background))
+                        (exp (p (if bg
+				    (center (color :bg bg :width 90. 
+					       (it (markup-body n))))
+				    (it (markup-body n))))))
+                    (skribe-eval exp e)))))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key postscript)
+   (if (engine-format? "latex")
+       (new markup
+	  (markup 'jfp-abstract)
+	  (body (p (the-body opt))))
+       (let ((a (new markup
+		   (markup '&html-jfp-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+                             postscript))
+		(section :number #f :toc #f :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+                         (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (section :title "References" :class "references"
+	    :number (not (engine-format? "latex"))
+	    (font :size -1 (the-bibliography)))))
+
diff --git a/skr/latex-simple.skr b/skr/latex-simple.skr
new file mode 100644
index 0000000..dd2eccb
--- /dev/null
+++ b/skr/latex-simple.skr
@@ -0,0 +1,101 @@
+;;;
+;;; LES CUSTOMS SONT TROP SPECIFIQUES POUR LA DISTRIBS. NE DOIT PAS VIRER 
+;;; CE FICHIER (sion simplifie il ne rest plus grand chose)
+;;;		Erick 27-10-04
+;;;
+
+
+;*=====================================================================*/
+;*    scmws04/src/latex-style.skr                                      */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Damien Ciabrini                                   */
+;*    Creation    :  Tue Aug 24 19:17:04 2004                          */
+;*    Last change :  Thu Oct 28 21:45:25 2004 (eg)                     */
+;*    Copyright   :  2004 Damien Ciabrini, see LICENCE file            */
+;*    -------------------------------------------------------------    */
+;*    Custom style for Latex...                                        */
+;*=====================================================================*/
+
+(let* ((le (find-engine 'latex))
+       (oa (markup-writer-get 'author le)))
+   ; latex class & package for the workshop
+   (engine-custom-set! le 'documentclass "\\documentclass[letterpaper]{sigplan-proc}")
+   (engine-custom-set! le 'usepackage
+   "\\usepackage{epsfig}
+\\usepackage{workshop}
+\\conferenceinfo{Fifth Workshop on Scheme and Functional Programming.}
+               {September 22, 2004, Snowbird, Utah, USA.}
+\\CopyrightYear{2004}
+\\CopyrightHolder{Damien Ciabrini}
+\\renewcommand{\\ttdefault}{cmtt}
+")
+   (engine-custom-set! le 'image-format '("eps"))
+   (engine-custom-set! le 'source-define-color "#000080")
+   (engine-custom-set! le 'source-thread-color "#8080f0")
+   (engine-custom-set! le 'source-string-color "#000000")
+
+   ; hyperref options
+   (engine-custom-set! le 'hyperref #t)
+   (engine-custom-set! le 'hyperref-usepackage
+   "\\usepackage[bookmarksopen=true, bookmarksopenlevel=2,bookmarksnumbered=true,colorlinks,linkcolor=blue,citecolor=blue,pdftitle={Debugging Scheme Fair Threads}, pdfsubject={debugging cooperative threads based on reactive programming}, pdfkeywords={debugger, functional, reactive programming, Scheme}, pdfauthor={Damien Ciabrini}]{hyperref}")
+   ; nbsp with ~ char
+   (set! latex-encoding (delete! (assoc #\~ latex-encoding) latex-encoding))
+
+   ; let latex process citations
+   (markup-writer 'bib-ref le
+      :options '(:text :bib)
+      :before "\\cite{"
+      :action (lambda (n e) (display (markup-option n :bib)))
+      :after "}")  
+   (markup-writer 'bib-ref+ le
+      :options '(:text :bib)
+      :before "\\cite{"
+      :action (lambda (n e) 
+		 (let loop ((bibs (markup-option n :bib)))
+		    (if (pair? bibs)
+			(begin 
+			   (display (car bibs))
+			   (if (pair? (cdr bibs)) (display ", "))
+			   (loop (cdr bibs))))))
+      :after "}")
+   (markup-writer '&the-bibliography le
+      :action (lambda (n e) 
+		 (print "\\bibliographystyle{abbrv}")
+		 (display "\\bibliography{biblio}")))
+   
+   ; ACM-style for authors
+   (markup-writer '&latex-author le
+      :before (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (if (pair? body) 
+			(print "\\numberofauthors{" (length body) "}"))
+		    (print "\\author{")))
+      :after "}\n")
+   (markup-writer 'author le
+      :options (writer-options oa)
+      :before ""
+      :action (lambda (n e)
+		 (let ((name (markup-option n :name))
+		       (affiliation (markup-option n :affiliation))
+		       (address (markup-option n :address))
+		       (email (markup-option n :email)))
+		    (define (row pre n post)
+		       (display pre) 
+		       (output n e)
+		       (display post) 
+		       (display "\\\\\n"))
+		    ;; name
+		    (if name (row "\\alignauthor " name ""))
+		    ;; affiliation
+		    (if affiliation (row "\\affaddr{" affiliation "}"))
+		    ;; address
+		    (if (pair? address)
+			(for-each (lambda (x)
+				     (row "\\affaddr{" x "}")) address))
+		    ;; email
+		    (if email (row "\\email{" email "}"))))
+      :after "")
+)
+
+(define (include-biblio) 
+   (the-bibliography))
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))
diff --git a/skr/letter.skr b/skr/letter.skr
new file mode 100644
index 0000000..17a0058
--- /dev/null
+++ b/skr/letter.skr
@@ -0,0 +1,146 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/letter.skr                       */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Fri Oct  3 12:22:13 2003                          */
+;*    Last change :  Thu Sep 23 20:00:42 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Skribe style for letters                                         */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    document                                                         */
+;*---------------------------------------------------------------------*/
+(define %letter-document document)
+
+(define-markup (document #!rest opt 
+		  #!key (ident #f) (class "letter") 
+		  where date author
+		  &skribe-eval-location)
+   (let* ((ubody (the-body opt))
+	  (body (list (new markup
+			 (markup '&letter-where)
+			 (loc &skribe-eval-location)
+			 (options `((:where ,where)
+				    (:date ,date)
+				    (:author ,author))))
+		      ubody)))
+      (apply %letter-document
+	     :author #f :title #f 
+	     (append (apply append 
+			    (the-options opt :where :date :author :title))
+		     body))))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX configuration                                              */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'documentclass "\\documentclass[12pt]{letter}\n")
+   (engine-custom-set! le 'maketitle #f)
+   ;; &letter-where
+   (markup-writer '&letter-where le
+      :before "\\begin{raggedright}\n"
+      :action (lambda (n e)
+		 (let* ((w (markup-option n :where))
+			(d (markup-option n :date))
+			(a (markup-option n :author))
+			(hd (if (and w d)
+				(list w ", " d)
+				(or w d)))
+			(ne (copy-engine 'author e)))
+		    ;; author
+		    (markup-writer 'author ne
+		       :options '(:name :title :affiliation :email :url :address :phone :photo :align :header)
+		       :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)
+					(when hd
+					   (display "\\hfill ")
+					   (output hd e)
+					   (set! hd #f))
+					(display "\\\\\n"))
+				     ;; name
+				     (if name (row name))
+				     ;; title
+				     (if title (row title))
+				     ;; affiliation
+				     (if affiliation (row affiliation))
+				     ;; address
+				     (if (pair? address)
+					 (for-each row address))
+				     ;; telephone
+				     (if phone (row phone))
+				     ;; email
+				     (if email (row email))
+				     ;; url
+				     (if url (row url)))))
+		    ;; emit the author
+		    (if a 
+			(output a ne)
+			(output hd e))))
+      :after "\\end{raggedright}\n\\vspace{1cm}\n\n"))
+		 
+;*---------------------------------------------------------------------*/
+;*    HTML configuration                                               */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   ;; &letter-where
+   (markup-writer '&letter-where he
+      :before "<table width=\"100%\">\n"
+      :action (lambda (n e)
+		 (let* ((w (markup-option n :where))
+			(d (markup-option n :date))
+			(a (markup-option n :author))
+			(hd (if (and w d)
+				(list w ", " d)
+				(or w d)))
+			(ne (copy-engine 'author e)))
+		    ;; author
+		    (markup-writer 'author ne
+		       :options '(:name :title :affiliation :email :url :address :phone :photo :align :header)
+		       :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)
+					(display "<tr><td align='left'>")
+					(output n e)
+					(when hd
+					   (display "</td><td align='right'>")
+					   (output hd e)
+					   (set! hd #f))
+					(display "</td></tr>\n"))
+				     ;; name
+				     (if name (row name))
+				     ;; title
+				     (if title (row title))
+				     ;; affiliation
+				     (if affiliation (row affiliation))
+				     ;; address
+				     (if (pair? address)
+					 (for-each row address))
+				     ;; telephone
+				     (if phone (row phone))
+				     ;; email
+				     (if email (row email))
+				     ;; url
+				     (if url (row url)))))
+		    ;; emit the author
+		    (if a 
+			(output a ne)
+			(output hd e))))
+      :after "</table>\n<hr>\n\n"))
+		 
+
diff --git a/skr/lncs.skr b/skr/lncs.skr
new file mode 100644
index 0000000..4668404
--- /dev/null
+++ b/skr/lncs.skr
@@ -0,0 +1,147 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/lncs.skr                         */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sun Sep 28 14:40:38 2003                          */
+;*    Last change :  Fri Jan 16 07:04:51 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Skribe style for LNCS articles.                              */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'documentclass "\\documentclass{llncs}")
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :action (lambda (n e)
+		 (define (&latex-inst-body n)
+		    (let ((affiliation (markup-option n :affiliation))
+			  (address (markup-option n :address)))
+		       (when affiliation (output affiliation e) (display ", "))
+		       (when address
+			  (for-each (lambda (a) (output a e) (display " "))
+				    address)
+			  (newline))))
+		 (define (&latex-inst-n i)
+		    (display "\\institute{\n")
+		    (&latex-inst-body (car i))
+		    (for-each (lambda (n)
+				 (display "\\and\n")
+				 (&latex-inst-body n))
+			      (cdr i))
+		    (display "}\n"))
+		 (define (&latex-author-1 n)
+		    (display "\\author{\n")
+		    (output n e)
+		    (display "}\n"))
+		 (define (&latex-author-n n)
+		    (display "\\author{\n")
+		    (output (car n) e)
+		    (for-each (lambda (a)
+				 (display " and ")
+				 (output a e))
+			      (cdr n))
+		    (display "}\n"))
+		 (let ((body (markup-body n)))
+		    (cond
+		       ((is-markup? body 'author)
+			(markup-option-add! n 'inst 1)
+			(&latex-author-1 body)
+			(&latex-inst-n (list body)))
+		       ((and (list? body)
+			     (every? (lambda (b) (is-markup? b 'author))
+				     body))
+			(define (institute=? n1 n2)
+			   (let ((aff1 (markup-option n1 :affiliation))
+				 (add1 (markup-option n1 :address))
+				 (aff2 (markup-option n2 :affiliation))
+				 (add2 (markup-option n2 :address)))
+			      (and (equal? aff1 aff2) (equal? add1 add2))))
+			(define (search-institute n i j)
+			   (cond
+			      ((null? i)
+			       #f)
+			      ((institute=? n (car i))
+			       j)
+			      (else
+			       (search-institute n (cdr i) (- j 1)))))
+			(if (null? (cdr body))
+			    (begin
+			       (markup-option-add! (car body) 'inst 1)
+			       (&latex-author-1 (car body))
+			       (&latex-inst-n body))
+			    ;; collect the institutes
+			    (let loop ((ns body)
+				       (is '())
+				       (j 1))
+			       (if (null? ns)
+				   (begin
+				      (&latex-author-n body)
+				      (&latex-inst-n (reverse! is)))
+				   (let* ((n (car ns))
+					  (si (search-institute n is (- j 1))))
+				      (if (integer? si)
+					  (begin
+					     (markup-option-add! n 'inst si)
+					     (loop (cdr ns) is j))
+					  (begin
+					     (markup-option-add! n 'inst j)
+					     (loop (cdr ns)
+						   (cons n is)
+						   (+ 1 j)))))))))
+		       (else
+			(skribe-error 'author
+				      "Illegal `lncs' author"
+				      body))))))
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (lambda (n e)
+		    (let ((name (markup-option n :name))
+			  (title (markup-option n :title))
+			  (inst (markup-option n 'inst)))
+		       (if name (output name e))
+		       (if title (output title e))
+		       (if inst (printf "\\inst{~a}\n" inst)))))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-lncs-abstract he
+      :action (lambda (n e)
+		 (let* ((bg (or (engine-custom e 'abstract-background)
+				"#cccccc"))
+			(exp (p (center (color :bg bg :width 90. 
+					   (markup-body n))))))
+		    (skribe-eval exp e)))))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key postscript)
+   (if (engine-format? "latex")
+       (section :number #f :title "ABSTRACT" (p (the-body opt)))
+       (let ((a (new markup
+		   (markup '&html-lncs-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+		       postscript))
+		(section :number #f :toc #f :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+		   (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (if (engine-format? "latex")
+	     (font :size -1 (flush :side 'left (the-bibliography)))
+	     (section :title "References"
+                      (font :size -1 (the-bibliography))))))
diff --git a/skr/scribe.skr b/skr/scribe.skr
new file mode 100644
index 0000000..d9e3bb8
--- /dev/null
+++ b/skr/scribe.skr
@@ -0,0 +1,229 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/scribe.skr                       */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Tue Jul 29 10:07:21 2003                          */
+;*    Last change :  Wed Oct  8 09:56:52 2003 (serrano)                */
+;*    Copyright   :  2003 Manuel Serrano                               */
+;*    -------------------------------------------------------------    */
+;*    Scribe Compatibility kit                                         */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    style ...                                                        */
+;*---------------------------------------------------------------------*/
+(define (style . styles)
+   (define (load-style style)
+      (let ((name (cond
+		     ((string? style)
+		      style)
+		     ((symbol? style)
+		      (string-append (symbol->string style) ".scr")))))
+	 (skribe-load name :engine *skribe-engine*)))
+   (for-each load-style styles))
+
+;*---------------------------------------------------------------------*/
+;*    chapter ...                                                      */
+;*---------------------------------------------------------------------*/
+(define skribe-chapter chapter)
+
+(define-markup (chapter #!rest opt #!key title subtitle split number toc file)
+   (apply skribe-chapter 
+	  :title (or title subtitle)
+	  :number number
+	  :toc toc
+	  :file file
+	  (the-body opt)))
+
+;*---------------------------------------------------------------------*/
+;*    table-of-contents ...                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (table-of-contents #!rest opts #!key chapter section subsection)
+   (apply toc opts))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(define skribe-frame frame)
+
+(define-markup (frame #!rest opt #!key width margin)
+   (apply skribe-frame 
+	  :width (if (real? width) (* 100 width) width)
+	  :margin margin
+	  (the-body opt)))
+
+;*---------------------------------------------------------------------*/
+;*    copyright ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (copyright)
+   (symbol 'copyright))
+
+;*---------------------------------------------------------------------*/
+;*    sect ...                                                         */
+;*---------------------------------------------------------------------*/
+(define (sect)
+   (symbol 'section))
+
+;*---------------------------------------------------------------------*/
+;*    euro ...                                                         */
+;*---------------------------------------------------------------------*/
+(define (euro)
+   (symbol 'euro))
+
+;*---------------------------------------------------------------------*/
+;*    tab ...                                                          */
+;*---------------------------------------------------------------------*/
+(define (tab)
+   (char #\tab))
+
+;*---------------------------------------------------------------------*/
+;*    space ...                                                        */
+;*---------------------------------------------------------------------*/
+(define (space)
+   (char #\space))
+
+;*---------------------------------------------------------------------*/
+;*    print-bibliography ...                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (print-bibliography #!rest opts 
+				   #!key all (sort bib-sort/authors))
+   (the-bibliography all sort))
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(define skribe-linebreak linebreak)
+
+(define-markup (linebreak . lnum)
+   (cond
+      ((null? lnum)
+       (skribe-linebreak))
+      ((string? (car lnum))
+       (skribe-linebreak (string->number (car lnum))))
+      (else
+       (skribe-linebreak (car lnum)))))
+
+;*---------------------------------------------------------------------*/
+;*    ref ...                                                          */
+;*---------------------------------------------------------------------*/
+(define skribe-ref ref)
+
+(define-markup (ref #!rest opts 
+		    #!key scribe url id page figure mark 
+		    chapter section subsection subsubsection subsubsection
+		    bib bib+ number)
+   (let ((bd (the-body opts))
+	 (args (apply append (the-options opts :id))))
+      (if id (set! args (cons* :mark id args)))
+      (if (pair? bd) (set! args (cons* :text bd args)))
+      (apply skribe-ref args)))
+
+;*---------------------------------------------------------------------*/
+;*    indexes ...                                                      */
+;*---------------------------------------------------------------------*/
+(define *scribe-indexes*
+   (list (cons "theindex" (make-index "theindex"))))
+
+(define skribe-index index)
+(define skribe-make-index make-index)
+
+(define-markup (make-index index)
+   (let ((i (skribe-make-index index)))
+      (set! *scribe-indexes* (cons (cons index i) *scribe-indexes*))
+      i))
+
+(define-markup (index #!rest opts #!key note index shape)
+   (let ((i (if (not index)
+		"theindex"
+		(let ((i (assoc index *scribe-indexes*)))
+		   (if (pair? i)
+		       (cdr i)
+		       (make-index index))))))
+      (apply skribe-index :note note :index i :shape shape (the-body opts))))
+
+(define-markup (print-index #!rest opts 
+			    #!key split (char-offset 0) (header-limit 100))
+   (apply the-index 
+	  :split split 
+	  :char-offset char-offset
+	  :header-limit header-limit
+	  (map (lambda (i)
+		(let ((c (assoc i *scribe-indexes*)))
+		   (if (pair? c)
+		       (cdr c)
+		       (skribe-error 'the-index "Unknown index" i))))
+	       (the-body opts))))
+	      
+;*---------------------------------------------------------------------*/
+;*    format?                                                          */
+;*---------------------------------------------------------------------*/
+(define (scribe-format? fmt) #f)
+
+;*---------------------------------------------------------------------*/
+;*    scribe-url ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (scribe-url) (skribe-url))
+
+;*---------------------------------------------------------------------*/
+;*    Various configurations                                           */
+;*---------------------------------------------------------------------*/
+(define *scribe-background* #f)
+(define *scribe-foreground* #f)
+(define *scribe-tbackground* #f)
+(define *scribe-tforeground* #f)
+(define *scribe-title-font* #f)
+(define *scribe-author-font* #f)
+(define *scribe-chapter-numbering* #f)
+(define *scribe-footer* #f)
+(define *scribe-prgm-color* #f)
+
+;*---------------------------------------------------------------------*/
+;*    prgm ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (prgm #!rest opts
+		     #!key lnum lnumwidth language bg frame (width 1.)
+		     colors (monospace #t))
+   (let* ((w (cond
+		((real? width) (* width 100.))
+		((number? width) width)
+		(else 100.)))
+	  (body (if language 
+		    (source :language language (the-body opts))
+		    (the-body opts)))
+	  (body (if monospace
+		    (prog :line lnum body)
+		    body))
+	  (body (if bg
+		    (color :width 100. :bg bg body)
+		    body)))
+      (skribe-frame :width w
+		    :border (if frame 1 #f)
+		    body)))
+   
+;*---------------------------------------------------------------------*/
+;*    latex configuration                                              */
+;*---------------------------------------------------------------------*/
+(define *scribe-tex-predocument* #f)
+
+;*---------------------------------------------------------------------*/
+;*    latex-prelude ...                                                */
+;*---------------------------------------------------------------------*/
+(define (latex-prelude e)
+   (if (engine-format? "latex" e)
+       (begin
+	  (if *scribe-tex-predocument*
+	      (engine-custom-set! e 'predocument *scribe-tex-predocument*)))))
+      
+;*---------------------------------------------------------------------*/
+;*    html-prelude ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (html-prelude e)
+   (if (engine-format? "html" e)
+       (begin
+	  #f)))
+      
+;*---------------------------------------------------------------------*/
+;*    prelude                                                          */
+;*---------------------------------------------------------------------*/
+(let ((p (user-prelude)))
+   (user-prelude-set! (lambda (e) (p e) (latex-prelude e))))
diff --git a/skr/sigplan.skr b/skr/sigplan.skr
new file mode 100644
index 0000000..9bdb939
--- /dev/null
+++ b/skr/sigplan.skr
@@ -0,0 +1,155 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/sigplan.skr                      */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sun Sep 28 14:40:38 2003                          */
+;*    Last change :  Wed May 18 16:00:38 2005 (serrano)                */
+;*    Copyright   :  2003-05 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Skribe style for ACMPROC articles.                           */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le
+		       'documentclass
+		       "\\documentclass[twocolumns]{sigplanconf}")
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :before (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (printf "\\authorinfo{\n"
+			    (if (pair? body) (length body) 1))))
+      :action (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (for-each (lambda (a)
+				 (display "}\n\\authorinfo{")
+				 (output a e))
+			      (if (pair? body) body (list body)))))
+      :after "}\n")
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (writer-action old-author)))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category le
+      :options '(:index :section :subsection)
+      :before (lambda (n e)
+		 (display "\\category{")
+		 (display (markup-option n :index))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :section))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :subsection))
+		 (display "}\n["))
+      :after "]\n")
+   (markup-writer '&acm-terms le
+      :before "\\terms{"
+      :after "}")
+   (markup-writer '&acm-keywords le
+      :before "\\keywords{"
+      :after "}")
+   (markup-writer '&acm-copyright le
+      :action (lambda (n e)
+		 (display "\\conferenceinfo{")
+		 (output (markup-option n :conference) e)
+		 (display ",} {")
+		 (output (markup-option n :location) e)
+		 (display "}\n")
+		 (display "\\copyrightyear{")
+		 (output (markup-option n :year) e)
+		 (display "}\n")
+		 (display "\\copyrightdata{")
+		 (output (markup-option n :crdata) e)
+		 (display "}\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-acmproc-abstract he
+      :action (lambda (n e)
+		 (let* ((ebg (engine-custom e 'abstract-background))
+			(bg (or (and (string? ebg) 
+				     (> (string-length ebg) 0))
+				ebg
+				"#cccccc"))
+			(exp (p (center (color :bg bg :width 90. 
+					   (markup-body n))))))
+		    (skribe-eval exp e))))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category :action #f)
+   (markup-writer '&acm-terms :action #f)
+   (markup-writer '&acm-keywords :action #f)
+   (markup-writer '&acm-copyright :action #f))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key postscript)
+   (if (engine-format? "latex")
+       (section :number #f :title "ABSTRACT" (p (the-body opt)))
+       (let ((a (new markup
+		   (markup '&html-acmproc-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+		       postscript))
+		(section :number #f :toc #f :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+		   (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-category ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-category #!rest opt #!key index section subsection)
+   (new markup
+      (markup '&acm-category)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-terms ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-terms #!rest opt)
+   (new markup
+      (markup '&acm-terms)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-keywords ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-keywords #!rest opt)
+   (new markup
+      (markup '&acm-keywords)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-copyright ...                                                */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-copyright #!rest opt #!key conference location year crdata)
+   (let* ((le (find-engine 'latex))
+	  (cop (format "\\conferenceinfo{~a,} {~a}
+\\CopyrightYear{~a}
+\\crdata{~a}\n" conference location year crdata))
+	  (old (engine-custom le 'predocument)))
+      (if (string? old)
+	  (engine-custom-set! le 'predocument (string-append cop old))
+	  (engine-custom-set! le 'predocument cop))))
+   
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (if (engine-format? "latex")
+	     (font :size -1 (flush :side 'left (the-bibliography)))
+	     (section :title "References"
+                      (font :size -1 (the-bibliography))))))
diff --git a/skr/skribe.skr b/skr/skribe.skr
new file mode 100644
index 0000000..86425ac
--- /dev/null
+++ b/skr/skribe.skr
@@ -0,0 +1,76 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/skribe.skr                       */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Fri Jan 11 11:23:12 2002                          */
+;*    Last change :  Sun Jul 11 12:22:38 2004 (serrano)                */
+;*    Copyright   :  2002-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The standard Skribe style (always loaded).                       */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    p ...                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (p #!rest opt #!key ident (class #f) &skribe-eval-location)
+   (paragraph :ident ident :class class :loc &skribe-eval-location
+      (the-body opt)))
+
+;*---------------------------------------------------------------------*/
+;*    fg ...                                                           */
+;*---------------------------------------------------------------------*/
+(define (fg c . body)
+   (color :fg c body))
+
+;*---------------------------------------------------------------------*/
+;*    bg ...                                                           */
+;*---------------------------------------------------------------------*/
+(define (bg c . body)
+   (color :bg c body))
+
+;*---------------------------------------------------------------------*/
+;*    counter ...                                                      */
+;*    -------------------------------------------------------------    */
+;*    This produces a kind of "local enumeration" that is:             */
+;*       (counting "toto," "tutu," "titi.")                            */
+;*    produces:                                                        */
+;*       i) toto, ii) tutu, iii) titi.                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (counter #!rest opts #!key (numbering 'roman))
+   (define items (if (eq? (car opts) :numbering) (cddr opts) opts))
+   (define vroman '#(- "i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix" "x"))
+   (define (the-roman-number num)
+      (if (< num (vector-length vroman))
+	  (list (list "(" (it (vector-ref vroman num)) ") "))
+	  (skribe-error 'counter
+			"too many items for roman numbering"
+			(length items))))
+   (define (the-arabic-number num)
+      (list (list "(" (it (integer->string num)) ") ")))
+   (define (the-alpha-number num)
+      (list (list "(" (it (+ (integer->char #\a) num -1)) ") ")))
+   (let ((the-number (case numbering
+			((roman) the-roman-number)
+			((arabic) the-arabic-number)
+			((alpha) the-alpha-number)
+			(else (skribe-error 'counter
+					    "Illegal numbering"
+					    numbering)))))
+      (let loop ((num 1)
+		 (items items)
+		 (res '()))
+	   (if (null? items)
+	       (reverse! res)
+	       (loop (+ num 1)
+		     (cdr items)
+		     (cons (list (the-number num) (car items)) res))))))
+
+;*---------------------------------------------------------------------*/
+;*    q                                                                */
+;*---------------------------------------------------------------------*/
+(define-markup (q #!rest opt)
+   (new markup
+      (markup 'q)
+      (options (the-options opt))
+      (body (the-body opt))))
+
diff --git a/skr/slide.skr b/skr/slide.skr
new file mode 100644
index 0000000..f8638ad
--- /dev/null
+++ b/skr/slide.skr
@@ -0,0 +1,664 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/slide.skr                        */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Fri Oct  3 12:22:13 2003                          */
+;*    Last change :  Mon Aug 23 09:08:21 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Skribe style for slides                                          */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    slide-options                                                    */
+;*---------------------------------------------------------------------*/
+(define &slide-load-options (skribe-load-options))
+
+;*---------------------------------------------------------------------*/
+;*    &slide-seminar-predocument ...                                   */
+;*---------------------------------------------------------------------*/
+(define &slide-seminar-predocument 
+   "\\special{landscape}
+   \\slideframe{none}
+   \\centerslidesfalse
+   \\raggedslides[0pt]
+   \\renewcommand{\\slideleftmargin}{0.2in}
+   \\renewcommand{\\slidetopmargin}{0.3in}
+   \\newdimen\\slidewidth \\slidewidth 9in")
+
+;*---------------------------------------------------------------------*/
+;*    &slide-seminar-maketitle ...                                     */
+;*---------------------------------------------------------------------*/
+(define &slide-seminar-maketitle 
+   "\\def\\labelitemi{$\\bullet$}
+   \\def\\labelitemii{$\\circ$}
+   \\def\\labelitemiii{$\\diamond$}
+   \\def\\labelitemiv{$\\cdot$}
+   \\pagestyle{empty}
+   \\slideframe{none}
+   \\centerslidestrue
+   \\begin{slide}
+   \\date{}
+   \\maketitle
+   \\end{slide}
+   \\slideframe{none}
+   \\centerslidesfalse")
+
+;*---------------------------------------------------------------------*/
+;*    &slide-prosper-predocument ...                                   */
+;*---------------------------------------------------------------------*/
+(define &slide-prosper-predocument 
+   "\\slideCaption{}\n")
+
+;*---------------------------------------------------------------------*/
+;*    %slide-the-slides ...                                            */
+;*---------------------------------------------------------------------*/
+(define %slide-the-slides '())
+(define %slide-the-counter 0)
+(define %slide-initialized #f)
+(define %slide-latex-mode 'seminar)
+
+;*---------------------------------------------------------------------*/
+;*    %slide-initialize! ...                                           */
+;*---------------------------------------------------------------------*/
+(define (%slide-initialize!)
+   (unless %slide-initialized
+      (set! %slide-initialized #t)
+      (case %slide-latex-mode
+	 ((seminar)
+	  (%slide-seminar-setup!))
+	 ((advi)
+	  (%slide-advi-setup!))
+	 ((prosper)
+	  (%slide-prosper-setup!))
+	 (else
+	  (skribe-error 'slide "Illegal latex mode" %slide-latex-mode)))))
+      
+;*---------------------------------------------------------------------*/
+;*    slide ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (slide #!rest opt
+		      #!key 
+		      (ident #f) (class #f)
+		      (toc #t)
+		      title (number #t)
+		      (vspace #f) (vfill #f)
+		      (transition #f)
+		      (bg #f) (image #f))
+   (%slide-initialize!)
+   (let ((s (new container
+	       (markup 'slide)
+	       (ident (symbol->string (gensym 'slide)))
+	       (class class)
+	       (required-options '(:title :number :toc))
+	       (options `((:number
+			   ,(cond
+			       ((number? number)
+				(set! %slide-the-counter number)
+				number)
+			       (number
+				(set! %slide-the-counter
+				      (+ 1 %slide-the-counter))
+				%slide-the-counter)
+			       (else
+				#f)))
+			  (:toc ,toc)
+			  ,@(the-options opt :ident :class :vspace :toc)))
+	       (body (if vspace
+			 (list (slide-vspace vspace) (the-body opt))
+			 (the-body opt))))))
+      (set! %slide-the-slides (cons s %slide-the-slides))
+      s))
+
+;*---------------------------------------------------------------------*/
+;*    ref ...                                                          */
+;*---------------------------------------------------------------------*/
+(define %slide-old-ref ref)
+
+(define-markup (ref #!rest opt #!key (slide #f))
+   (if (not slide)
+       (apply %slide-old-ref opt)
+       (new unresolved
+	  (proc (lambda (n e env)
+		   (cond
+		      ((eq? slide 'next)
+		       (let ((c (assq n %slide-the-slides)))
+			  (if (pair? c)
+			      (handle (cadr c))
+			      #f)))
+		      ((eq? slide 'prev)
+		       (let ((c (assq n (reverse %slide-the-slides))))
+			  (if (pair? c)
+			      (handle (cadr c))
+			      #f)))
+		      ((number? slide)
+		       (let loop ((s %slide-the-slides))
+			  (cond
+			     ((null? s)
+			      #f)
+			     ((= slide (markup-option (car s) :number))
+			      (handle (car s)))
+			     (else
+			      (loop (cdr s))))))
+		      (else
+		       #f)))))))
+   
+;*---------------------------------------------------------------------*/
+;*    slide-pause ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-pause)
+   (new markup
+      (markup 'slide-pause)))
+
+;*---------------------------------------------------------------------*/
+;*    slide-vspace ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-vspace #!rest opt #!key (unit 'cm))
+   (new markup
+      (markup 'slide-vspace)
+      (options `((:unit ,unit) ,@(the-options opt :unit)))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-embed ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-embed #!rest opt 
+			    #!key 
+			    command
+			    (geometry-opt "-geometry")
+			    (geometry #f) (rgeometry #f)
+			    (transient #f) (transient-opt #f)
+			    (alt #f)
+			    &skribe-eval-location)
+   (if (not (string? command))
+       (skribe-error 'slide-embed
+		     "No command provided"
+		     command)
+       (new markup
+	  (markup 'slide-embed)
+	  (loc &skribe-eval-location)
+	  (required-options '(:alt))
+	  (options `((:geometry-opt ,geometry-opt) 
+		     (:alt ,alt)
+		     ,@(the-options opt :geometry-opt :alt)))
+	  (body (the-body opt)))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-record ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-record #!rest opt #!key ident class tag (play #t))
+   (if (not tag)
+       (skribe-error 'slide-record "Tag missing" tag)
+       (new markup 
+	  (markup 'slide-record)
+	  (ident ident)
+	  (class class)
+	  (options `((:play ,play) ,@(the-options opt)))
+	  (body (the-body opt)))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-play ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-play #!rest opt #!key ident class tag color)
+   (if (not tag)
+       (skribe-error 'slide-play "Tag missing" tag)
+       (new markup 
+	  (markup 'slide-play)
+	  (ident ident)
+	  (class class)
+	  (options `((:color ,(if color (skribe-use-color! color) #f))
+		     ,@(the-options opt :color)))
+	  (body (the-body opt)))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-play* ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-play* #!rest opt 
+			    #!key ident class color (scolor "#000000"))
+   (let ((body (the-body opt)))
+      (for-each (lambda (lbl)
+		   (match-case lbl
+		      ((?id ?col)
+		       (skribe-use-color! col))))
+		body)
+      (new markup
+	 (markup 'slide-play*)
+	 (ident ident)
+	 (class class)
+	 (options `((:color ,(if color (skribe-use-color! color) #f))
+		    (:scolor ,(if color (skribe-use-color! scolor) #f))
+		    ,@(the-options opt :color :scolor)))
+	 (body body))))
+
+;*---------------------------------------------------------------------*/
+;*    base                                                             */
+;*---------------------------------------------------------------------*/
+(let ((be (find-engine 'base)))
+   (skribe-message "Base slides setup...\n")
+   ;; slide-pause
+   (markup-writer 'slide-pause be
+      :action #f)
+   ;; slide-vspace
+   (markup-writer 'slide-vspace be
+      :options '()
+      :action #f)
+   ;; slide-embed
+   (markup-writer 'slide-embed be
+      :options '(:alt :geometry-opt)
+      :action (lambda (n e)
+		 (output (markup-option n :alt) e)))
+   ;; slide-record
+   (markup-writer 'slide-record be
+      :options '(:tag :play)
+      :action (lambda (n e)
+		 (output (markup-body n) e)))
+   ;; slide-play
+   (markup-writer 'slide-play be
+      :options '(:tag :color)
+      :action (lambda (n e)
+		 (output (markup-option n :alt) e)))
+   ;; slide-play*
+   (markup-writer 'slide-play* be
+      :options '(:tag :color :scolor)
+      :action (lambda (n e)
+		 (output (markup-option n :alt) e))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-body-width ...                                             */
+;*---------------------------------------------------------------------*/
+(define (slide-body-width e)
+   (let ((w (engine-custom e 'body-width)))
+      (if (or (number? w) (string? w)) w 95.)))
+
+;*---------------------------------------------------------------------*/
+;*    html-slide-title ...                                             */
+;*---------------------------------------------------------------------*/
+(define (html-slide-title n e)
+   (let* ((title (markup-body n))
+          (authors (markup-option n 'author))
+          (tbg (engine-custom e 'title-background))
+          (tfg (engine-custom e 'title-foreground))
+          (tfont (engine-custom e 'title-font)))
+      (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>"
+              (html-width (slide-body-width e)))
+      (if (string? tbg)
+          (printf "<td bgcolor=\"~a\">" tbg)
+          (display "<td>"))
+      (if (string? tfg)
+          (printf "<font color=\"~a\">" tfg))
+      (if title
+          (begin
+             (display "<center>")
+             (if (string? tfont)
+                 (begin
+                    (printf "<font ~a><strong>" tfont)
+                    (output title e)
+                    (display "</strong></font>"))
+                 (begin
+		    (printf "<div class=\"skribetitle\"><strong><big><big><big>")
+                    (output title e)
+		    (display "</big></big></big></strong</div>")))
+             (display "</center>\n")))
+      (if (not authors)
+          (display "\n")
+          (html-title-authors authors e))
+      (if (string? tfg)
+          (display "</font>"))
+      (display "</td></tr></tbody></table></center>\n")))
+
+;*---------------------------------------------------------------------*/
+;*    slide-number ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (slide-number)
+   (length (filter (lambda (n)
+		      (and (is-markup? n 'slide)
+			   (markup-option n :number)))
+		   %slide-the-slides)))
+
+;*---------------------------------------------------------------------*/
+;*    html                                                             */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (skribe-message "HTML slides setup...\n")
+   ;; &html-page-title
+   (markup-writer '&html-document-title he
+      :predicate (lambda (n e) %slide-initialized)
+      :action html-slide-title)
+   ;; slide
+   (markup-writer 'slide he
+      :options '(:title :number :transition :toc :bg)
+      :before (lambda (n e)
+		 (printf "<a name=\"~a\">" (markup-ident n))
+		 (display "<br>\n"))
+      :action (lambda (n e)
+		 (let ((nb (markup-option n :number))
+		       (t (markup-option n :title)))
+		    (skribe-eval
+		     (center 
+			(color :width (slide-body-width e)
+			   :bg (or (markup-option n :bg) "#ffffff")
+			   (table :width 100.
+			      (tr (th :align 'left 
+				     (list
+				      (if nb 
+					  (format "~a / ~a -- " nb 
+						  (slide-number)))
+				      t)))
+			      (tr (td (hrule)))
+			      (tr (td :width 100. :align 'left 
+				     (markup-body n))))
+			   (linebreak)))
+		     e)))
+      :after "<br>")
+   ;; slide-vspace
+   (markup-writer 'slide-vspace he
+      :action (lambda (n e) (display "<br>"))))
+
+;*---------------------------------------------------------------------*/
+;*    latex                                                            */
+;*---------------------------------------------------------------------*/
+(define &latex-slide #f)
+(define &latex-pause #f)
+(define &latex-embed #f)
+(define &latex-record #f)
+(define &latex-play #f)
+(define &latex-play* #f)
+
+(let ((le (find-engine 'latex)))
+   ;; slide-vspace
+   (markup-writer 'slide-vspace le
+      :options '(:unit)
+      :action (lambda (n e)
+		 (display "\n\\vspace{")
+		 (output (markup-body n) e)
+		 (printf " ~a}\n\n" (markup-option n :unit))))
+   ;; slide-slide
+   (markup-writer 'slide le
+      :options '(:title :number :transition :vfill :toc :vspace :image)
+      :action (lambda (n e)
+		 (if (procedure? &latex-slide)
+		     (&latex-slide n e))))
+   ;; slide-pause
+   (markup-writer 'slide-pause le
+      :options '()
+      :action (lambda (n e)
+		 (if (procedure? &latex-pause)
+		     (&latex-pause n e))))
+   ;; slide-embed
+   (markup-writer 'slide-embed le
+      :options '(:alt :command :geometry-opt :geometry 
+		      :rgeometry :transient :transient-opt)
+      :action (lambda (n e)
+		 (if (procedure? &latex-embed)
+		     (&latex-embed n e))))
+   ;; slide-record
+   (markup-writer 'slide-record le
+      :options '(:tag :play)
+      :action (lambda (n e)
+		 (if (procedure? &latex-record)
+		     (&latex-record n e))))
+   ;; slide-play
+   (markup-writer 'slide-play le
+      :options '(:tag :color)
+      :action (lambda (n e)
+		 (if (procedure? &latex-play)
+		     (&latex-play n e))))
+   ;; slide-play*
+   (markup-writer 'slide-play* le
+      :options '(:tag :color :scolor)
+      :action (lambda (n e)
+		 (if (procedure? &latex-play*)
+		     (&latex-play* n e)))))
+
+;*---------------------------------------------------------------------*/
+;*    %slide-seminar-setup! ...                                        */
+;*---------------------------------------------------------------------*/
+(define (%slide-seminar-setup!)
+   (skribe-message "Seminar slides setup...\n")
+   (let ((le (find-engine 'latex))
+	 (be (find-engine 'base)))
+      ;; latex configuration
+      (define (seminar-slide n e)
+	 (let ((nb (markup-option n :number))
+	       (t (markup-option n :title)))
+	    (display "\\begin{slide}\n")
+	    (if nb (printf "~a/~a -- " nb (slide-number)))
+	    (output t e)
+	    (display "\\hrule\n"))
+	 (output (markup-body n) e)
+	 (if (markup-option n :vill) (display "\\vfill\n"))
+	 (display "\\end{slide}\n"))
+      (engine-custom-set! le 'documentclass
+	 "\\documentclass[landscape]{seminar}\n")
+      (let ((o (engine-custom le 'predocument)))
+	 (engine-custom-set! le 'predocument
+	    (if (string? o) 
+		(string-append &slide-seminar-predocument o)
+		&slide-seminar-predocument)))
+      (engine-custom-set! le 'maketitle
+	 &slide-seminar-maketitle)
+      (engine-custom-set! le 'hyperref-usepackage
+	 "\\usepackage[setpagesize=false]{hyperref}\n")
+      ;; slide-slide
+      (set! &latex-slide seminar-slide)))
+
+;*---------------------------------------------------------------------*/
+;*    %slide-advi-setup! ...                                           */
+;*---------------------------------------------------------------------*/
+(define (%slide-advi-setup!)
+   (skribe-message "Generating `Advi Seminar' slides...\n")
+   (let ((le (find-engine 'latex))
+	 (be (find-engine 'base)))
+      (define (advi-geometry geo)
+	 (let ((r (pregexp-match "([0-9]+)x([0-9]+)" geo)))
+	    (if (pair? r)
+		(let* ((w (cadr r))
+		       (w' (string->integer w))
+		       (w'' (number->string (/ w' *skribe-slide-advi-scale*)))
+		       (h (caddr r))
+		       (h' (string->integer h))
+		       (h'' (number->string (/ h' *skribe-slide-advi-scale*))))
+		   (values "" (string-append w "x" h "+!x+!y")))
+		(let ((r (pregexp-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo)))
+		   (if (pair? r)
+		       (let ((w (number->string (/ (string->integer (cadr r))
+						   *skribe-slide-advi-scale*)))
+			     (h (number->string (/ (string->integer (caddr r))
+						   *skribe-slide-advi-scale*)))
+			     (x (cadddr r))
+			     (y (car (cddddr r))))
+			  (values (string-append "width=" w "cm,height=" h "cm")
+				  "!g"))
+		       (values "" geo))))))
+      (define (advi-transition trans)
+	 (cond
+	    ((string? trans)
+	     (printf "\\advitransition{~s}" trans))
+	    ((and (symbol? trans)
+		  (memq trans '(wipe block slide)))
+	     (printf "\\advitransition{~s}" trans))
+	    (else
+	     #f)))
+      ;; latex configuration
+      (define (advi-slide n e)
+	 (let ((i (markup-option n :image))
+	       (n (markup-option n :number))
+	       (t (markup-option n :title))
+	       (lt (markup-option n :transition))
+	       (gt (engine-custom e 'transition)))
+	    (if (and i (engine-custom e 'advi))
+		(printf "\\advibg[global]{image=~a}\n" 
+			(if (and (pair? i)
+				 (null? (cdr i)) 
+				 (string? (car i)))
+			    (car i)
+			    i)))
+	    (display "\\begin{slide}\n")
+	    (advi-transition (or lt gt))
+	    (if n (printf "~a/~a -- " n (slide-number)))
+	    (output t e)
+	    (display "\\hrule\n"))
+	 (output (markup-body n) e)
+	 (if (markup-option n :vill) (display "\\vfill\n"))
+	 (display "\\end{slide}\n\n\n"))
+      ;; advi record
+      (define (advi-record n e)
+	 (display "\\advirecord")
+	 (when (markup-option n :play) (display "[play]"))
+	 (printf "{~a}{" (markup-option n :tag))
+	 (output (markup-body n) e)
+	 (display "}"))
+      ;; advi play
+      (define (advi-play n e)
+	 (display "\\adviplay")
+	 (let ((c (markup-option n :color)))
+	    (when c
+	       (display "[")
+	       (display (skribe-get-latex-color c))
+	       (display "]")))
+	 (printf "{~a}" (markup-option n :tag)))
+      ;; advi play*
+      (define (advi-play* n e)
+	 (let ((c (skribe-get-latex-color (markup-option n :color)))
+	       (d (skribe-get-latex-color (markup-option n :scolor))))
+	    (let loop ((lbls (markup-body n))
+		       (last #f))
+	       (when last 
+		  (display "\\adviplay[")
+		  (display d)
+		  (printf "]{~a}" last))
+	       (when (pair? lbls)
+		  (let ((lbl (car lbls)))
+		     (match-case lbl
+			((?id ?col)
+			 (display "\\adviplay[")
+			 (display (skribe-get-latex-color col))
+			 (printf "]{" ~a "}" id)
+			 (skribe-eval (slide-pause) e)
+			 (loop (cdr lbls) id))
+			(else
+			 (display "\\adviplay[")
+			 (display c)
+			 (printf "]{~a}" lbl)
+			 (skribe-eval (slide-pause) e)
+			 (loop (cdr lbls) lbl))))))))
+      (engine-custom-set! le 'documentclass
+	 "\\documentclass{seminar}\n")
+      (let ((o (engine-custom le 'predocument)))
+	 (engine-custom-set! le 'predocument
+	    (if (string? o) 
+		(string-append &slide-seminar-predocument o)
+		&slide-seminar-predocument)))
+      (engine-custom-set! le 'maketitle
+	 &slide-seminar-maketitle)
+      (engine-custom-set! le 'usepackage
+	 (string-append "\\usepackage{advi}\n"
+			(engine-custom le 'usepackage)))
+      ;; slide
+      (set! &latex-slide advi-slide)
+      (set! &latex-pause 
+	    (lambda (n e) (display "\\adviwait\n")))
+      (set! &latex-embed
+	    (lambda (n e)
+	       (let ((geometry-opt (markup-option n :geometry-opt))
+		     (geometry (markup-option n :geometry))
+		     (rgeometry (markup-option n :rgeometry))
+		     (transient (markup-option n :transient))
+		     (transient-opt (markup-option n :transient-opt))
+		     (cmd (markup-option n :command)))
+		  (let* ((a (string-append "ephemeral=" 
+					   (symbol->string (gensym))))
+			 (c (cond
+			       (geometry
+				(string-append cmd " "
+					       geometry-opt " " 
+					       geometry))
+			       (rgeometry
+				(multiple-value-bind (aopt dopt)
+				   (advi-geometry rgeometry)
+				   (set! a (string-append a "," aopt))
+				   (string-append cmd " " 
+						  geometry-opt " " 
+						  dopt)))
+			       (else
+				cmd)))
+			 (c (if (and transient transient-opt)
+				(string-append c " " transient-opt " !p")
+				c)))
+		     (printf "\\adviembed[~a]{~a}\n" a c)))))
+      (set! &latex-record advi-record)
+      (set! &latex-play advi-play)
+      (set! &latex-play* advi-play*)))
+
+;*---------------------------------------------------------------------*/
+;*    %slide-prosper-setup! ...                                        */
+;*---------------------------------------------------------------------*/
+(define (%slide-prosper-setup!)
+   (skribe-message "Generating `Prosper' slides...\n")
+   (let ((le (find-engine 'latex))
+	 (be (find-engine 'base))
+	 (overlay-count 0))
+      ;; transitions
+      (define (prosper-transition trans)
+	 (cond
+	    ((string? trans)
+	     (printf "[~s]" trans))
+	    ((eq? trans 'slide)
+	     (printf "[Blinds]"))
+	    ((and (symbol? trans)
+		  (memq trans '(split blinds box wipe dissolve glitter)))
+	     (printf "[~s]"
+		     (string-upcase (symbol->string trans))))
+	    (else
+	     #f)))
+      ;; latex configuration
+      (define (prosper-slide n e)
+	 (let* ((i (markup-option n :image))
+		(t (markup-option n :title))
+		(lt (markup-option n :transition))
+		(gt (engine-custom e 'transition))
+		(pa (search-down (lambda (x) (is-markup? x 'slide-pause)) n))
+		(lpa (length pa)))
+	    (set! overlay-count 1)
+	    (if (>= lpa 1) (printf "\\overlays{~a}{%\n" (+ 1 lpa)))
+	    (display "\\begin{slide}")
+	    (prosper-transition (or lt gt))
+	    (display "{")
+	    (output t e)
+	    (display "}\n")
+	    (output (markup-body n) e)
+	    (display "\\end{slide}\n")
+	    (if (>= lpa 1) (display "}\n"))
+	    (newline)
+	    (newline)))
+      (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n")
+      (let* ((cap (engine-custom le 'slide-caption))
+	     (o (engine-custom le 'predocument))
+	     (n (if (string? cap)
+		    (format "~a\\slideCaption{~a}\n"
+			    &slide-prosper-predocument
+			    cap)
+		    &slide-prosper-predocument)))
+	 (engine-custom-set! le 'predocument
+	    (if (string? o) (string-append n o) n)))
+      (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n")
+      ;; writers
+      (set! &latex-slide prosper-slide)
+      (set! &latex-pause
+	    (lambda (n e)
+	       (set! overlay-count (+ 1 overlay-count))
+	       (printf "\\FromSlide{~s}%\n" overlay-count)))))
+
+;*---------------------------------------------------------------------*/
+;*    Setup ...                                                        */
+;*---------------------------------------------------------------------*/
+(let* ((opt &slide-load-options)
+       (p (memq :prosper opt)))
+   (if (and (pair? p) (pair? (cdr p)) (cadr p))
+       ;; prosper
+       (set! %slide-latex-mode 'prosper)
+       (let ((a (memq :advi opt)))
+	  (if (and (pair? a) (pair? (cdr a)) (cadr a))
+	      ;; advi
+	      (set! %slide-latex-mode 'advi)))))
+		 
diff --git a/skr/web-article.skr b/skr/web-article.skr
new file mode 100644
index 0000000..e33328b
--- /dev/null
+++ b/skr/web-article.skr
@@ -0,0 +1,230 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/web-article.skr                  */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sat Jan 10 09:09:43 2004                          */
+;*    Last change :  Wed Mar 24 16:45:08 2004 (serrano)                */
+;*    Copyright   :  2004 Manuel Serrano                               */
+;*    -------------------------------------------------------------    */
+;*    A Skribe style for producing web articles                        */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    &web-article-load-options ...                                    */
+;*---------------------------------------------------------------------*/
+(define &web-article-load-options (skribe-load-options))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-body-width ...                                       */
+;*---------------------------------------------------------------------*/
+(define (web-article-body-width e)
+   (let ((w (engine-custom e 'body-width)))
+      (if (or (number? w) (string? w)) w 98.)))
+
+;*---------------------------------------------------------------------*/
+;*    html-document-title-web ...                                      */
+;*---------------------------------------------------------------------*/
+(define (html-document-title-web n e)
+   (let* ((title (markup-body n))
+	  (authors (markup-option n 'author))
+	  (tbg (engine-custom e 'title-background))
+	  (tfg (engine-custom e 'title-foreground))
+	  (tfont (engine-custom e 'title-font)))
+      (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>"
+	      (html-width (web-article-body-width e)))
+      (if (string? tbg)
+	  (printf "<td bgcolor=\"~a\">" tbg)
+	  (display "<td>"))
+      (if (string? tfg)
+	  (printf "<font color=\"~a\">" tfg))
+      (if title
+	  (begin
+	     (display "<center>")
+	     (if (string? tfont)
+		 (begin
+		    (printf "<font ~a><b>" tfont)
+		    (output title e)
+		    (display "</b></font>"))
+		 (begin
+		    (printf "<h1>")
+		    (output title e)
+		    (display "</h1>")))
+	     (display "</center>\n")))
+      (if (not authors)
+	  (display "\n")
+	  (html-title-authors authors e))
+      (if (string? tfg)
+	  (display "</font>"))
+      (display "</td></tr></tbody></table></center>\n")))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-css-document-title ...                               */
+;*---------------------------------------------------------------------*/
+(define (web-article-css-document-title n e)
+   (let* ((title (markup-body n))
+	  (authors (markup-option n 'author))
+	  (id (markup-ident n)))
+      ;; the title
+      (printf "<div id=\"~a\" class=\"document-title-title\">\n" 
+	      (string-canonicalize id))
+      (output title e)
+      (display "</div>\n")
+      ;; the authors
+      (printf "<div id=\"~a\" class=\"document-title-authors\">\n" 
+	      (string-canonicalize id))
+      (for-each (lambda (a) (output a e))
+		(cond
+		   ((is-markup? authors 'author)
+		    (list authors))
+		   ((list? authors)
+		    authors)
+		   (else
+		    '())))
+      (display "</div>\n")))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-css-author ...                                       */
+;*---------------------------------------------------------------------*/
+(define (web-article-css-author 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))
+	 (nfn (engine-custom e 'author-font))
+	 (align (markup-option n :align)))
+      (when name 
+	 (printf "<span class=\"document-author-name\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output name e) 
+	 (display "</span>\n"))
+      (when title 
+	 (printf "<span class=\"document-author-title\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output title e)
+	 (display "</span>\n"))
+      (when affiliation
+	 (printf "<span class=\"document-author-affiliation\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output affiliation e)
+	 (display "</span>\n"))
+      (when (pair? address) 
+	 (printf "<span class=\"document-author-address\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (for-each (lambda (a) 
+		      (output a e)
+		      (newline))
+		   address)
+	 (display "</span>\n"))
+      (when phone
+	 (printf "<span class=\"document-author-phone\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output phone e)
+	 (display "</span>\n"))
+      (when email 
+	 (printf "<span class=\"document-author-email\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output email e)
+	 (display "</span>\n"))
+      (when url 
+	 (printf "<span class=\"document-author-url\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output url e) 
+	 (display "</span>\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML settings                                                    */
+;*---------------------------------------------------------------------*/
+(define (web-article-modern-setup he)
+   (let ((sec (markup-writer-get 'section he))
+	 (ft (markup-writer-get '&html-footnotes he)))
+      ;; &html-document-title
+      (markup-writer '&html-document-title he
+	 :action html-document-title-web)
+      ;; section
+      (markup-writer 'section he
+	 :options 'all
+	 :before "<br>"
+	 :action (lambda (n e) 
+		    (let ((e1 (make-engine 'html-web :delegate e))
+			  (bg (engine-custom he 'section-background)))
+		       (markup-writer 'section e1
+			  :options 'all
+			  :action (lambda (n e2) (output n e sec)))
+		       (skribe-eval 
+			(center (color :width (web-article-body-width e)
+				   :margin 5 :bg bg n))
+			e1))))
+      ;; &html-footnotes
+      (markup-writer '&html-footnotes he
+	 :options 'all
+	 :before "<br>"
+	 :action (lambda (n e) 
+		    (let ((e1 (make-engine 'html-web :delegate e))
+			  (bg (engine-custom he 'section-background))
+			  (fg (engine-custom he 'subsection-title-foreground)))
+		       (markup-writer '&html-footnotes e1
+			  :options 'all
+			  :action (lambda (n e2) 
+				     (invoke (writer-action ft) n e)))
+		       (skribe-eval 
+			(center (color :width (web-article-body-width e)
+				   :margin 5 :bg bg :fg fg n))
+			e1))))))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-css-setup ...                                        */
+;*---------------------------------------------------------------------*/
+(define (web-article-css-setup he)
+   (let ((sec (markup-writer-get 'section he))
+	 (ft (markup-writer-get '&html-footnotes he)))
+      ;; &html-document-title
+      (markup-writer '&html-document-title he
+	 :before (lambda (n e)
+		    (printf "<div id=\"~a\" class=\"document-title\">\n" 
+			    (string-canonicalize (markup-ident n))))
+	 :action web-article-css-document-title
+	 :after "</div>\n")
+      ;; author
+      (markup-writer 'author he
+	 :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+	 :before (lambda (n e)
+		    (printf "<span id=\"~a\" class=\"document-author\">\n" 
+			    (string-canonicalize (markup-ident n))))
+	 :action web-article-css-author
+	 :after "</span\n")
+      ;; section
+      (markup-writer 'section he
+	 :options 'all
+	 :before (lambda (n e)
+		    (printf "<div class=\"section\" id=\"~a\">"
+			    (string-canonicalize (markup-ident n))))
+	 :action (lambda (n e) (output n e sec))
+	 :after "</div>\n")
+      ;; &html-footnotes
+      (markup-writer '&html-footnotes he
+	 :options 'all
+	 :before (lambda (n e)
+		    (printf "<div class=\"footnotes\" id=\"~a\">"
+			    (string-canonicalize (markup-ident n))))
+	 :action (lambda (n e) 
+		    (output n e ft))
+	 :after "</div>\n")))
+
+;*---------------------------------------------------------------------*/
+;*    Setup ...                                                        */
+;*---------------------------------------------------------------------*/
+(let* ((opt &web-article-load-options)
+       (p (memq :style opt))
+       (css (memq :css opt))
+       (he (find-engine 'html)))
+   (cond
+      ((and (pair? p) (pair? (cdr p)) (eq? (cadr p) 'css))
+       (web-article-css-setup he))
+      ((and (pair? css) (pair? (cdr css)) (string? (cadr css)))
+       (engine-custom-set! he 'css (cadr css))
+       (web-article-css-setup he))
+      (else
+       (web-article-modern-setup he))))
diff --git a/skr/web-book.skr b/skr/web-book.skr
new file mode 100644
index 0000000..f907c8b
--- /dev/null
+++ b/skr/web-book.skr
@@ -0,0 +1,107 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/web-book.skr                     */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Mon Sep  1 10:54:32 2003                          */
+;*    Last change :  Mon Nov  8 10:43:46 2004 (eg)                     */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Skribe web book style.                                       */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    html customization                                               */
+;*---------------------------------------------------------------------*/
+(define he (find-engine 'html))
+(engine-custom-set! he 'main-browsing-extra #f)
+(engine-custom-set! he 'chapter-file #t)
+
+;*---------------------------------------------------------------------*/
+;*    main-browsing ...                                                */
+;*---------------------------------------------------------------------*/
+(define main-browsing 
+   (lambda (n e)
+      ;; search the document
+      (let ((p (ast-document n)))
+	 (cond
+	    ((document? p)
+	     ;; got it
+	     (let* ((mt (markup-option p :margin-title))
+ 		    (r (ref :handle (handle p)
+ 			    :text (or mt (markup-option p :title))))
+ 		    (fx (engine-custom e 'web-book-main-browsing-extra)))
+		(center
+		 (table :width 97. :border 1 :frame 'box
+		    :cellpadding 0 :cellspacing 0
+		    (tr :bg (engine-custom e 'title-background) 
+		       (th (color :fg (engine-custom e 'background) 
+			      (bold "main page"))))
+		    (tr :bg (engine-custom e 'background) 
+		       (td (apply table :width 100. :border 0
+				  (tr (td :align 'left 
+					 :valign 'top 
+					 (bold "top:"))
+				     (td :align 'right 
+					:valign 'top r))
+				  (if (procedure? fx)
+				      (list (tr (td :width 100. 
+						   :colspan 2 
+						   (fx n e))))
+				      '()))))))))
+	    ((not p)
+	     ;; no document!!!
+	     #f)))))
+
+;*---------------------------------------------------------------------*/
+;*    chapter-browsing ...                                             */
+;*---------------------------------------------------------------------*/
+(define chapter-browsing
+   (lambda (n e)
+      (center
+       (table :width 97. :border 1 :frame 'box 
+	  :cellpadding 0 :cellspacing 0
+	      (tr :bg (engine-custom e 'title-background) 
+		  (th (color :fg (engine-custom e 'background) 
+			     (bold (markup-option n :title)))))
+	      (tr :bg (engine-custom e 'background) 
+		  (td (toc (handle n) :chapter #t :section #t :subsection #t)))))))
+
+;*---------------------------------------------------------------------*/
+;*    document-browsing ...                                            */
+;*---------------------------------------------------------------------*/
+(define document-browsing
+   (lambda (n e)
+      (let ((chap (find1-down (lambda (n)
+				 (is-markup? n 'chapter))
+			      n)))
+	 (center
+	    (table :width 97. :border 1 :frame 'box
+	       :cellpadding 0 :cellspacing 0
+	       (tr :bg (engine-custom e 'title-background) 
+		  (th (color :fg (engine-custom e 'background)
+			 (bold (if chap "Chapters" "Sections")))))
+	       (tr :bg (engine-custom e 'background) 
+		  (td (if chap
+			  (toc (handle n) :chapter #t :section #f)
+			  (toc (handle n) :section #t :subsection #t)))))))))
+
+;*---------------------------------------------------------------------*/
+;*    left margin ...                                                  */
+;*---------------------------------------------------------------------*/
+(engine-custom-set! he 'left-margin-size 20.)
+
+(engine-custom-set! he 'left-margin
+   (lambda (n e) 
+      (let ((d (ast-document n))
+	    (c (ast-chapter n)))
+	 (list (linebreak 1)
+	       (main-browsing n e)
+	       (if (is-markup? c 'chapter)
+		   (list (linebreak 2)
+			 (chapter-browsing c e))
+		   #f)
+	       (if (document? d)
+		   (list (linebreak 2)
+			 (document-browsing d e))
+		   #f)))))
+
diff --git a/skr/xml.skr b/skr/xml.skr
new file mode 100644
index 0000000..784b6f0
--- /dev/null
+++ b/skr/xml.skr
@@ -0,0 +1,111 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/xml.skr                          */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Tue Sep  2 09:46:09 2003                          */
+;*    Last change :  Sat Mar  6 11:22:05 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Generic XML Skribe engine                                        */
+;*    -------------------------------------------------------------    */
+;*    Implementation:                                                  */
+;*       common: @path ../src/common/api.src@                          */
+;*       bigloo: @path ../src/bigloo/api.bgl@                          */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/xmle.skb:ref@                             */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    xml-engine ...                                                   */
+;*---------------------------------------------------------------------*/
+(define xml-engine
+   ;; setup the xml engine
+   (default-engine-set!
+      (make-engine 'xml
+		   :version 1.0
+		   :format "html"
+		   :delegate (find-engine 'base)
+		   :filter (make-string-replace '((#\< "&lt;")
+						  (#\> "&gt;")
+						  (#\& "&amp;")
+						  (#\" "&quot;")
+						  (#\@ "&#x40;"))))))
+
+;*---------------------------------------------------------------------*/
+;*    markup ...                                                       */
+;*---------------------------------------------------------------------*/
+(let ((xml-margin 0))
+   (define (make-margin)
+      (make-string xml-margin #\space))
+   (define (xml-attribute? val)
+      (cond
+	 ((or (string? val) (number? val) (boolean? val))
+	  #t)
+	 ((list? val)
+	  (every? xml-attribute? val))
+	 (else
+	  #f)))
+   (define (xml-attribute att val)
+      (let ((s (keyword->string att)))
+	 (printf " ~a=\"" (substring s 1 (string-length s)))
+	 (let loop ((val val))
+	    (cond
+	       ((or (string? val) (number? val))
+		(display val))
+	       ((boolean? val)
+		(display (if val "true" "false")))
+	       ((pair? val)
+		(for-each loop val))
+	       (else
+		#f)))
+	 (display #\")))
+   (define (xml-option opt val e)
+      (let* ((m (make-margin))
+	     (ks (keyword->string opt))
+	     (s (substring ks 1 (string-length ks))))
+	 (printf "~a<~a>\n" m s)
+	 (output val e)
+	 (printf "~a</~a>\n" m s)))
+   (define (xml-options n e)
+      ;; display the true options
+      (let ((opts (filter (lambda (o)
+			     (and (keyword? (car o))
+				  (not (xml-attribute? (cadr o)))))
+			  (markup-options n))))
+	 (if (pair? opts)
+	     (let ((m (make-margin)))
+		(display m)
+		(display "<options>\n")
+		(set! xml-margin (+ xml-margin 1))
+		(for-each (lambda (o)
+			     (xml-option (car o) (cadr o) e))
+			  opts)
+		(set! xml-margin (- xml-margin 1))
+		(display m)
+		(display "</options>\n")))))
+   (markup-writer #t
+      :options 'all
+      :before (lambda (n e)
+		 (printf "~a<~a" (make-margin) (markup-markup n))
+		 ;; display the xml attributes
+		 (for-each (lambda (o)
+			      (if (and (keyword? (car o))
+				       (xml-attribute? (cadr o)))
+				  (xml-attribute (car o) (cadr o))))
+			   (markup-options n))
+		 (set! xml-margin (+ xml-margin 1))
+		 (display ">\n"))
+      :action (lambda (n e)
+		 ;; options
+		 (xml-options n e)
+		 ;; body
+		 (output (markup-body n) e))
+      :after (lambda (n e)
+		(printf "~a</~a>\n" (make-margin) (markup-markup n))
+		(set! xml-margin (- xml-margin 1)))))
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))