The first vaguely working version.

Patches applied:

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-4
   First real document produced!


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-8

20 files changed, 3210 insertions, 210 deletions

diff --git a/src/guile/README b/src/guile/README
index 4bd7eff..8b1502c 100644
--- a/src/guile/README
+++ b/src/guile/README
@@ -11,6 +11,12 @@ Here are a few goals.
 
 ** Better error handling, automatic back-traces, etc.
 
+** Add useful markups
+
+- numbered references
+
+- improved footnotes
+
 ** Add an option to continuously watch a file and re-compile it
 
 * Font-ends (readers)
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index a43ec66..33c2bb4 100755
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -387,7 +387,7 @@ Processes a Skribilo/Skribe source file and produces its output.
 					 skribilo-options))
 	 (engine            (string->symbol
 			     (option-ref options 'target "html")))
-	 (debugging-level   (option-ref options 'debug 0))
+	 (debugging-level   (option-ref options 'debug "0"))
 	 (load-path         (option-ref options 'load-path "."))
 	 (bib-path          (option-ref options 'bib-path "."))
 	 (preload           '())
@@ -455,6 +455,8 @@ Processes a Skribilo/Skribe source file and produces its output.
 			   (with-output-to-file dest-file doskribe)
 			   (doskribe)))))
 
+	(set! *skribe-dest* dest-file)
+
 	(if (and dest-file (file-exists? dest-file))
 	    (delete-file dest-file))
 
diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
index b880a66..cc0dfb2 100644
--- a/src/guile/skribilo/debug.scm
+++ b/src/guile/skribilo/debug.scm
@@ -27,7 +27,8 @@
 (define-module (skribilo debug)
    :export (with-debug %with-debug
 	    debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
-	    no-debug-color))
+	    no-debug-color)
+   :use-module (srfi srfi-17))
 
 
 (define *skribe-debug*			0)
@@ -50,8 +51,9 @@
 (define (no-debug-color)
   (set! *skribe-debug-color* #f))
 
-(define (skribe-debug)
-  *skribe-debug*)
+(define-public skribe-debug
+  (getter-with-setter (lambda () *skribe-debug*)
+		      (lambda (val) (set! *skribe-debug* val))))
 
 ;;
 ;;   debug-port
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index 1b39ec6..0353e2d 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -26,11 +26,12 @@
 ;;;
 
 (define-module (skribilo engine)
+  :use-module (skribilo module)
   :use-module (skribilo debug)
-;  :use-module (skribilo evaluator)
   :use-module (skribilo writer)
   :use-module (skribilo types)
   :use-module (skribilo lib)
+  :use-module (skribilo vars)
 
   :use-module (oop goops)
   :use-module (ice-9 optargs)
@@ -99,7 +100,7 @@
 	     ((engine? *skribe-engine*) *skribe-engine*)
 	     (else (find-engine *skribe-engine*)))))
     (if (not (engine? e))
-	(skribe-error 'engine-format? "No engine" e)
+	(skribe-error 'engine-format? "no engine" e)
 	(string=? fmt (engine-format e)))))
 
 ;;;
diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm
index 53d837d..ed15da4 100644
--- a/src/guile/skribilo/engine/base.scm
+++ b/src/guile/skribilo/engine/base.scm
@@ -152,9 +152,9 @@
 		     (k (markup-option n 'kind))
 		     (f (cond
 			   (s
-			    (format "?~a@~a " k s))
+			    (format #f "?~a@~a " k s))
 			   (else
-			    (format "?~a " k))))
+			    (format #f "?~a " k))))
 		     (msg (list f (markup-body n)))
 		     (n (list "[" (color :fg "red" (bold msg)) "]")))
 		 (skribe-eval n e))))
diff --git a/src/guile/skribilo/engine/context.scm b/src/guile/skribilo/engine/context.scm
index 48a069e..a79e88a 100644
--- a/src/guile/skribilo/engine/context.scm
+++ b/src/guile/skribilo/engine/context.scm
@@ -386,7 +386,7 @@
 	 :format "context"
 	 :delegate (find-engine 'base)
 	 :filter (make-string-replace context-encoding)
-	 :symbol-table (context-symbol-table (lambda (m) (format "$~a$" m)))
+	 :symbol-table (context-symbol-table (lambda (m) (format #f "$~a$" m)))
 	 :custom context-customs)))
 
 ;;;; ======================================================================
@@ -647,7 +647,7 @@
 			       (if (not (number? nb))
 				   (skribe-error
 				    'font
-				    (format "Illegal font size ~s" size)
+				    (format #f "Illegal font size ~s" size)
 				    nb)
 				   (+ cs nb))))))
 		     (ne (make-engine (gensym 'context)
@@ -980,7 +980,7 @@
 	     (let ((text (markup-option n :text))
 		   (url  (markup-body n)))
 	       (when (pair? url)
-		 (context-url (format "mailto:~A" (car url))
+		 (context-url (format #f "mailto:~A" (car url))
 			      (or text
 				  (car url))
 			      e)))))
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index c85f18f..3ad7da6 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -39,7 +39,7 @@
 		      (begin
 			 (set! table (cons (cons base 1) table))
 			 1))))
-	   (format "~a-~a.~a" base n suf)))
+	   (format #f "~a-~a.~a" base n suf)))
       (lambda (node e)
 	(let ((f (markup-option node filename))
 	      (file (markup-option node :file)))
@@ -517,12 +517,12 @@
       ((not (pair? cnts))
        cnts)
       ((null? (cdr cnts))
-       (format "~a." (car cnts)))
+       (format #f "~a." (car cnts)))
       (else
        (let loop ((cnts cnts))
 	  (if (null? (cdr cnts))
-	      (format "~a" (car cnts))
-	      (format "~a.~a" (car cnts) (loop (cdr cnts))))))))
+	      (format #f "~a" (car cnts))
+	      (format #f "~a.~a" (car cnts) (loop (cdr cnts))))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    html-width ...                                                   */
@@ -530,9 +530,9 @@
 (define (html-width width)
    (cond
       ((and (integer? width) (exact? width))
-       (format "~A" width))
+       (format #f "~A" width))
       ((real? width)
-       (format "~A%" (inexact->exact (round width))))
+       (format #f "~A%" (inexact->exact (round width))))
       ((string? width)
        width)
       (else
@@ -688,7 +688,7 @@
 	  (id (markup-ident n)))
       (unless (string? id)
 	 (skribe-error '&html-generic-header
-		       (format "Illegal identifier `~a'" id)
+		       (format #f "Illegal identifier `~a'" id)
 		       n))
       ;; title
       (output (new markup
@@ -769,7 +769,7 @@
 		 (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 hd (display (format #f "  ~a\n" hd)))
 		 (when (pair? icss)
 		    (for-each (lambda (css)
 				 (let ((p (open-input-file css)))
@@ -984,7 +984,7 @@
       (sui-blocks 'subsubsection n e)
       (display "  )\n"))
    (if (string? *skribe-dest*)
-       (let ((f (format "~a.sui" (prefix *skribe-dest*))))
+       (let ((f (format #f "~a.sui" (prefix *skribe-dest*))))
 	  (with-output-to-file f sui))
        (sui)))
 
@@ -1117,7 +1117,7 @@
 			(f (html-file c e)))
 		    (unless (string? id)
 		       (skribe-error 'toc
-				     (format "Illegal identifier `~a'" id)
+				     (format #f "illegal identifier `~a'" id)
 				     c))
 		    (display " <tr>")
 		    ;; blank columns
@@ -1129,7 +1129,8 @@
 		    (printf "<td colspan=\"~a\" width=\"100%\">"
 			    (- 4 level))
 		    (printf "<a href=\"~a#~a\">"
-			    (if (string=? f *skribe-dest*)
+			    (if (and *skribe-dest*
+				     (string=? f *skribe-dest*))
 				""
 				(strip-ref-base (or f *skribe-dest* "")))
 			    (string-canonicalize id))
@@ -1913,7 +1914,7 @@
 				(markup-class n)
 				"inbound")))
 		 (printf "<a href=\"~a#~a\" class=\"~a\""
-			 (if (string=? f *skribe-dest*)
+			 (if (and *skribe-dest* (string=? f *skribe-dest*))
 			     ""
 			     (strip-ref-base (or f *skribe-dest* "")))
 			 (string-canonicalize id)
diff --git a/src/guile/skribilo/engine/html4.scm b/src/guile/skribilo/engine/html4.scm
index 614ca99..ddc7c73 100644
--- a/src/guile/skribilo/engine/html4.scm
+++ b/src/guile/skribilo/engine/html4.scm
@@ -123,14 +123,15 @@
 			       ((or (unspecified? sz) (not sz))
 				#f)
 			       ((and (number? sz) (or (inexact? sz) (negative? sz)))
-				(format "~a%"
+				(format #f "~a%"
 					(+ 100
 					   (* 20 (inexact->exact (truncate sz))))))
 			       ((number? sz)
 				sz)
 			       (else
 				(skribe-error 'font
-					      (format "Illegal font size ~s" sz)
+					      (format #f
+						      "illegal font size ~s" sz)
 					      n))))))
 		 (display "<span ")
 		 (html-class n)
diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm
index bc20493..8bd0ae3 100644
--- a/src/guile/skribilo/engine/latex.scm
+++ b/src/guile/skribilo/engine/latex.scm
@@ -350,7 +350,7 @@
 		   (index-page-ref #t))
 	 :symbol-table (latex-symbol-table 
 			(lambda (m)
-			   (format "\\begin{math}~a\\end{math}" m))))))
+			   (format #f "\\begin{math}~a\\end{math}" m))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    latex-title-engine ...                                           */
@@ -361,7 +361,7 @@
       :format "latex-title"
       :delegate latex-engine
       :filter (make-string-replace latex-encoding)
-      :symbol-table (latex-symbol-table (lambda (m) (format "$~a$" m)))))
+      :symbol-table (latex-symbol-table (lambda (m) (format #f "$~a$" m)))))
 
 ;*---------------------------------------------------------------------*/
 ;*    latex-color? ...                                                 */
@@ -453,7 +453,7 @@
 	  "1.,1.,1.")
 	 (else
 	  (let ((ff (exact->inexact #xff)))
-	    (format "~a,~a,~a"
+	    (format #f "~a,~a,~a"
 		    (number->string (/ r ff))
 		    (number->string (/ g ff))
 		    (number->string (/ b ff))))))))
@@ -887,7 +887,7 @@
 				(if (not (number? nb))
 				    (skribe-error 
 				     'font
-				     (format "Illegal font size ~s" size)
+				     (format #f "Illegal font size ~s" size)
 				     nb)
 				    (+ cs nb))))))
 		     (ne (make-engine (gensym 'latex)
@@ -1170,7 +1170,7 @@
 			(output (new markup
 				   (markup '&latex-table-hline)
 				   (parent n)
-				   (ident (format "~a-above" id))
+				   (ident (format #f "~a-above" id))
 				   (class "table-line-above"))
 				e))
 		       ((above hsides)
@@ -1178,7 +1178,7 @@
 			(output (new markup
 				   (markup '&latex-table-hline)
 				   (parent n)
-				   (ident (format "~a-above" id))
+				   (ident (format #f "~a-above" id))
 				   (class "table-line-above"))
 				e))
 		       ((vsides)
@@ -1225,7 +1225,7 @@
 		 (output (new markup
 			    (markup '&latex-table-hline)
 			    (parent n)
-			    (ident (format "~a-below" (markup-ident n)))
+			    (ident (format #f "~a-below" (markup-ident n)))
 			    (class "table-hline-below"))
 			 e)))
 	     (output (new markup
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
new file mode 100644
index 0000000..b675e8a
--- /dev/null
+++ b/src/guile/skribilo/engine/lout.scm
@@ -0,0 +1,2977 @@
+;*=====================================================================*/
+;*    Lout Skribe engine                                               */
+;*    -------------------------------------------------------------    */
+;*    (C) Copyright 2004, 2005 Ludovic Courtès                         */
+;*                                                                     */
+;*    Taken from `lcourtes@laas.fr--2004-libre/                        */
+;*                skribe-lout--main--0.2--patch-15'                    */
+;*    Based on `latex.skr', copyright 2003,2004 Manuel Serrano.        */
+;*=====================================================================*/
+
+(define-skribe-module (skribilo engine lout))
+
+;*  This is the Lout engine, part of Skribilo.
+;*
+;*  Skribe 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.
+;*
+;*  Skribe 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 Skribe; if not, write to the Free Software
+;*  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+;*---------------------------------------------------------------------*/
+;*    lout-verbatim-encoding ...                                       */
+;*---------------------------------------------------------------------*/
+(define lout-verbatim-encoding
+   '((#\/ "\"/\"")
+     (#\\ "\"\\\\\"")
+     (#\| "\"|\"")
+     (#\& "\"&\"")
+     (#\@ "\"@\"")
+     (#\" "\"\\\"\"")
+     (#\{ "\"{\"")
+     (#\} "\"}\"")
+     (#\$ "\"$\"")
+     (#\# "\"#\"")
+     (#\_ "\"_\"")
+     (#\~ "\"~\"")))
+
+;*---------------------------------------------------------------------*/
+;*    lout-encoding ...                                                */
+;*---------------------------------------------------------------------*/
+(define lout-encoding
+  `(,@lout-verbatim-encoding
+    (#\ç "{ @Char ccedilla }")
+    (#\Ç "{ @Char Ccdeilla }")
+    (#\â "{ @Char acircumflex }")
+    (#\Â "{ @Char Acircumflex }")
+    (#\à "{ @Char agrave }")
+    (#\À "{ @Char Agrave }")
+    (#\é "{ @Char eacute }")
+    (#\É "{ @Char Eacute }")
+    (#\è "{ @Char egrave }")
+    (#\È "{ @Char Egrave }")
+    (#\ê "{ @Char ecircumflex }")
+    (#\Ê "{ @Char Ecircumflex }")
+    (#\ù "{ @Char ugrave }")
+    (#\Ù "{ @Char Ugrave }")
+    (#\û "{ @Char ucircumflex }")
+    (#\Û "{ @Char Ucircumflex }")
+    (#\ø "{ @Char oslash }")
+    (#\ô "{ @Char ocircumflex }")
+    (#\Ô "{ @Char Ocircumflex }")
+    (#\ö "{ @Char odieresis }")
+    (#\Ö "{ @Char Odieresis }")
+    (#\î "{ @Char icircumflex }")
+    (#\Î "{ @Char Icircumflex }")
+    (#\ï "{ @Char idieresis }")
+    (#\Ï "{ @Char Idieresis }")
+    (#\] "\"]\"")
+    (#\[ "\"[\"")
+    (#\» "{ @Char guillemotright }")
+    (#\« "{ @Char guillemotleft }")))
+
+
+;; XXX:  This is just here for experimental purposes.
+(define lout-french-punctuation-encoding
+  (let ((space (lambda (before after thing)
+		 (string-append "{ "
+				(if before
+				    (string-append "{ " before " @Wide {} }")
+				    "")
+				"\"" thing "\""
+				(if after
+				    (string-append "{ " after " @Wide {} }")
+				    "")
+				" }"))))
+    `((#\; ,(space "0.5s" #f ";"))
+      (#\? ,(space "0.5s" #f ";"))
+      (#\! ,(space "0.5s" #f ";")))))
+
+(define lout-french-encoding
+  (let ((punctuation (map car lout-french-punctuation-encoding)))
+    (append (let loop ((ch lout-encoding)
+		       (purified '()))
+	      (if (null? ch)
+		  purified
+		  (loop (cdr ch)
+			(if (member (car ch) punctuation)
+			    purified
+			    (cons (car ch) purified)))))
+	    lout-french-punctuation-encoding)))
+
+;*---------------------------------------------------------------------*/
+;*    lout-symbol-table ...                                            */
+;*---------------------------------------------------------------------*/
+(define (lout-symbol-table math)
+   `(("iexcl" "{ @Char exclamdown }")
+     ("cent" "{ @Char cent }")
+     ("pound" "{ @Char sterling }")
+     ("yen" "{ @Char yen }")
+     ("section" "{ @Char section }")
+     ("mul" "{ @Char multiply }")
+     ("copyright" "{ @Char copyright }")
+     ("lguillemet" "{ @Char guillemotleft }")
+     ("not" "{ @Char logicalnot }")
+     ("degree" "{ @Char degree }")
+     ("plusminus" "{ @Char plusminus }")
+     ("micro" "{ @Char mu }")
+     ("paragraph" "{ @Char paragraph }")
+     ("middot" "{ @Char periodcentered }")
+     ("rguillemet" "{ @Char guillemotright }")
+     ("1/4" "{ @Char onequarter }")
+     ("1/2" "{ @Char onehalf }")
+     ("3/4" "{ @Char threequarters }")
+     ("iquestion" "{ @Char questiondown }")
+     ("Agrave" "{ @Char Agrave }")
+     ("Aacute" "{ @Char Aacute }")
+     ("Acircumflex" "{ @Char Acircumflex }")
+     ("Atilde" "{ @Char Atilde }")
+     ("Amul" "{ @Char Adieresis }") ;;; FIXME:  Why `mul' and not `uml'?!
+     ("Aring" "{ @Char Aring }")
+     ("AEligature" "{ @Char oe }")
+     ("Oeligature" "{ @Char OE }")  ;;; FIXME:  Should be `OEligature'?!
+     ("Ccedilla" "{ @Char Ccedilla }")
+     ("Egrave" "{ @Char Egrave }")
+     ("Eacute" "{ @Char Eacute }")
+     ("Ecircumflex" "{ @Char Ecircumflex }")
+     ("Euml" "{ @Char Edieresis }")
+     ("Igrave" "{ @Char Igrave }")
+     ("Iacute" "{ @Char Iacute }")
+     ("Icircumflex" "{ @Char Icircumflex }")
+     ("Iuml" "{ @Char Idieresis }")
+     ("ETH" "{ @Char Eth }")
+     ("Ntilde" "{ @Char Ntilde }")
+     ("Ograve" "{ @Char Ograve }")
+     ("Oacute" "{ @Char Oacute }")
+     ("Ocircumflex" "{ @Char Ocircumflex }")
+     ("Otilde" "{ @Char Otilde }")
+     ("Ouml" "{ @Char Odieresis }")
+     ("times" "{ @Sym multiply }")
+     ("Oslash" "{ @Char oslash }")
+     ("Ugrave" "{ @Char Ugrave }")
+     ("Uacute" "{ @Char Uacute }")
+     ("Ucircumflex" "{ @Char Ucircumflex }")
+     ("Uuml" "{ @Char Udieresis }")
+     ("Yacute" "{ @Char Yacute }")
+     ("szlig" "{ @Char germandbls }")
+     ("agrave" "{ @Char agrave }")
+     ("aacute" "{ @Char aacute }")
+     ("acircumflex" "{ @Char acircumflex }")
+     ("atilde" "{ @Char atilde }")
+     ("amul" "{ @Char adieresis }")
+     ("aring" "{ @Char aring }")
+     ("aeligature" "{ @Char ae }")
+     ("oeligature" "{ @Char oe }")
+     ("ccedilla" "{ @Char ccedilla }")
+     ("egrave" "{ @Char egrave }")
+     ("eacute" "{ @Char eacute }")
+     ("ecircumflex" "{ @Char ecircumflex }")
+     ("euml" "{ @Char edieresis }")
+     ("igrave" "{ @Char igrave }")
+     ("iacute" "{ @Char iacute }")
+     ("icircumflex" "{ @Char icircumflex }")
+     ("iuml" "{ @Char idieresis }")
+     ("ntilde" "{ @Char ntilde }")
+     ("ograve" "{ @Char ograve }")
+     ("oacute" "{ @Char oacute }")
+     ("ocurcumflex" "{ @Char ocircumflex }") ;; FIXME: `ocIrcumflex'
+     ("otilde" "{ @Char otilde }")
+     ("ouml" "{ @Char odieresis }")
+     ("divide" "{ @Char divide }")
+     ("oslash" "{ @Char oslash }")
+     ("ugrave" "{ @Char ugrave }")
+     ("uacute" "{ @Char uacute }")
+     ("ucircumflex" "{ @Char ucircumflex }")
+     ("uuml" "{ @Char udieresis }")
+     ("yacute" "{ @Char yacute }")
+     ("ymul" "{ @Char ydieresis }")  ;; FIXME: `yUMl'
+     ;; Greek
+     ("Alpha" "{ @Sym Alpha }")
+     ("Beta" "{ @Sym Beta }")
+     ("Gamma" "{ @Sym Gamma }")
+     ("Delta" "{ @Sym Delta }")
+     ("Epsilon" "{ @Sym Epsilon }")
+     ("Zeta" "{ @Sym Zeta }")
+     ("Eta" "{ @Sym Eta }")
+     ("Theta" "{ @Sym Theta }")
+     ("Iota" "{ @Sym Iota }")
+     ("Kappa" "{ @Sym Kappa }")
+     ("Lambda" "{ @Sym Lambda }")
+     ("Mu" "{ @Sym Mu }")
+     ("Nu" "{ @Sym Nu }")
+     ("Xi" "{ @Sym Xi }")
+     ("Omicron" "{ @Sym Omicron }")
+     ("Pi" "{ @Sym Pi }")
+     ("Rho" "{ @Sym Rho }")
+     ("Sigma" "{ @Sym Sigma }")
+     ("Tau" "{ @Sym Tau }")
+     ("Upsilon" "{ @Sym Upsilon }")
+     ("Phi" "{ @Sym Phi }")
+     ("Chi" "{ @Sym Chi }")
+     ("Psi" "{ @Sym Psi }")
+     ("Omega" "{ @Sym Omega }")
+     ("alpha" "{ @Sym alpha }")
+     ("beta" "{ @Sym beta }")
+     ("gamma" "{ @Sym gamma }")
+     ("delta" "{ @Sym delta }")
+     ("epsilon" "{ @Sym epsilon }")
+     ("zeta" "{ @Sym zeta }")
+     ("eta" "{ @Sym eta }")
+     ("theta" "{ @Sym theta }")
+     ("iota" "{ @Sym iota }")
+     ("kappa" "{ @Sym kappa }")
+     ("lambda" "{ @Sym lambda }")
+     ("mu" "{ @Sym mu }")
+     ("nu" "{ @Sym nu }")
+     ("xi" "{ @Sym xi }")
+     ("omicron" "{ @Sym omicron }")
+     ("pi" "{ @Sym pi }")
+     ("rho" "{ @Sym rho }")
+     ("sigmaf" "{ @Sym sigmaf }") ;; FIXME!
+     ("sigma" "{ @Sym sigma }")
+     ("tau" "{ @Sym tau }")
+     ("upsilon" "{ @Sym upsilon }")
+     ("phi" "{ @Sym phi }")
+     ("chi" "{ @Sym chi }")
+     ("psi" "{ @Sym psi }")
+     ("omega" "{ @Sym omega }")
+     ("thetasym" "{ @Sym thetasym }")
+     ("piv" "{ @Sym piv }") ;; FIXME!
+     ;; punctuation
+     ("bullet" "{ @Sym bullet }")
+     ("ellipsis" "{ @Sym ellipsis }")
+     ("weierp" "{ @Sym  weierstrass }")
+     ("image" "{ @Sym Ifraktur }")
+     ("real" "{ @Sym Rfraktur }")
+     ("tm" "{ @Sym trademarksans }") ;; alt: @Sym trademarkserif
+     ("alef" "{ @Sym aleph }")
+     ("<-" "{ @Sym arrowleft }")
+     ("<--" "{ { 1.6 1 } @Scale { @Sym arrowleft } }") ;; copied from `eqf'
+     ("uparrow" "{ @Sym arrowup }")
+     ("->" "{ @Sym arrowright }")
+     ("-->" "{ { 1.6 1 } @Scale { @Sym arrowright } }")
+     ("downarrow" "{ @Sym arrowdown }")
+     ("<->" "{ @Sym arrowboth }")
+     ("<-->" "{ { 1.6 1 } @Scale { @Sym arrowboth } }")
+     ("<+" "{ @Sym carriagereturn }")
+     ("<=" "{ @Sym arrowdblleft }")
+     ("<==" "{ { 1.6 1 } @Scale { @Sym arrowdblleft } }")
+     ("Uparrow" "{ @Sym arrowdblup }")
+     ("=>" "{ @Sym arrowdblright }")
+     ("==>" "{ { 1.6 1 } @Scale { @Sym arrowdblright } }")
+     ("Downarrow" "{ @Sym arrowdbldown }")
+     ("<=>" "{ @Sym arrowdblboth }")
+     ("<==>" "{ { 1.6 1 } @Scale { @Sym arrowdblboth } }")
+     ;; Mathematical operators (we try to avoid `@Eq' since it
+     ;; requires to `@SysInclude { eq }' -- one solution consists in copying
+     ;; the symbol definition from `eqf')
+     ("forall" "{ { Symbol Base } @Font \"\\042\" }")
+     ("partial" "{ @Sym partialdiff }")
+     ("exists" "{ { Symbol Base } @Font \"\\044\" }")
+     ("emptyset" "{ { Symbol Base } @Font \"\\306\" }")
+     ("infinity" "{ @Sym infinity }")
+     ("nabla" "{ { Symbol Base } @Font \"\\321\" }")
+     ("in" "{ @Sym element }")
+     ("notin" "{ @Sym notelement }")
+     ("ni" "{ 180d @Rotate @Sym element }")
+     ("prod" "{ @Sym product }")
+     ("sum" "{ @Sym summation }")
+     ("asterisk" "{ @Sym asteriskmath }")
+     ("sqrt" "{ @Sym radical }")
+     ("propto" ,(math "propto"))
+     ("angle" "{ @Sym angle }")
+     ("and" ,(math "bwedge"))
+     ("or" ,(math "bvee"))
+     ("cap" ,(math "bcap"))
+     ("cup" ,(math "bcup"))
+     ("integral" ,(math "int"))
+     ("models" ,(math "models"))
+     ("vdash" ,(math "vdash"))
+     ("dashv" ,(math "dashv"))
+     ("sim" "{ @Sym similar }")
+     ("cong" "{ @Sym congruent }")
+     ("approx" "{ @Sym approxequal }")
+     ("neq" "{ @Sym notequal }")
+     ("equiv" "{ @Sym equivalence }")
+     ("le" "{ @Sym lessequal }")
+     ("ge" "{ @Sym greaterequal }")
+     ("subset" "{ @Sym propersubset }")
+     ("supset" "{ @Sym propersuperset }")
+     ("subseteq" "{ @Sym reflexsubset }")
+     ("supseteq" "{ @Sym reflexsuperset }")
+     ("oplus" "{ @Sym circleplus }")
+     ("otimes" "{ @Sym circlemultiply }")
+     ("perp" "{ @Sym perpendicular }")
+     ("mid" "{ @Sym bar }")
+     ("lceil" "{ @Sym bracketlefttp }")
+     ("rceil" "{ @Sym bracketrighttp }")
+     ("lfloor" "{ @Sym bracketleftbt }")
+     ("rfloor" "{ @Sym bracketrightbt }")
+     ("langle" "{ @Sym angleleft }")
+     ("rangle" "{ @Sym angleright }")
+     ;; Misc
+     ("loz" "{ @Lozenge }")
+     ("spades" "{ @Sym spade }")
+     ("clubs" "{ @Sym club }")
+     ("hearts" "{ @Sym heart }")
+     ("diams" "{ @Sym diamond }")
+     ("euro" "{ @Euro }")
+     ;; Lout
+     ("dag" "{ @Dagger }")
+     ("ddag" "{ @DaggerDbl }")
+     ("circ" ,(math "circle"))
+     ("top" ,(math "top"))
+     ("bottom" ,(math "bot"))
+     ("lhd" ,(math "triangleleft"))
+     ("rhd" ,(math "triangleright"))
+     ("parallel" ,(math "dbar"))))
+
+
+;;; Debugging support
+
+(define *lout-debug?* #f)
+
+(define-macro (lout-debug fmt . args)
+  `(if *lout-debug?*
+       (with-output-to-port (current-error-port)
+	  (lambda ()
+	     (printf (string-append ,fmt "~%") ,@args
+		     (current-error-port))))
+       #t))
+
+(define (lout-tagify ident)
+  ;; Return an "clean" identifier (a string) based on `ident' (a string),
+  ;; suitable for Lout as an `@Tag' value.
+  (let ((tag-encoding '((#\, "-")
+			(#\( "-")
+			(#\) "-")
+			(#\[ "-")
+			(#\] "-")
+			(#\/ "-")
+			(#\| "-")
+			(#\& "-")
+			(#\@ "-")
+			(#\! "-")
+			(#\? "-")
+			(#\: "-")
+			(#\; "-")))
+	(tag (string-canonicalize ident)))
+    ((make-string-replace tag-encoding) tag)))
+
+
+;; Default values of various customs (procedures)
+
+(define (lout-definitions engine)
+  ;; Return a string containing a set of useful Lout definitions that should
+  ;; be inserted at the beginning of the output document.
+  (let ((leader (engine-custom engine 'toc-leader))
+	(leader-space (engine-custom engine 'toc-leader-space)))
+    (apply string-append
+	   `("# @SkribeMark implements Skribe's marks "
+	     "(i.e. cross-references)\n"
+	     "def @SkribeMark\n"
+	     "    right @Tag\n"
+	     "{\n"
+	     "    @PageMark @Tag\n"
+	     "}\n\n"
+
+	     "# @SkribeLeaders is used in `toc'\n"
+	     "# (this is mostly copied from the expert's guide)\n"
+	     "def @SkribeLeaders { "
+	     ,leader " |" ,leader-space " @SkribeLeaders }\n\n"))))
+
+(define (lout-make-doc-cover-sheet doc engine)
+  ;; Create a cover sheet for node `doc' which is a doc-style Lout document.
+  ;; This is the default implementation, i.e. the default value of the
+  ;; `doc-cover-sheet-proc' custom.
+  (let ((title (markup-option doc :title))
+	(author (markup-option doc :author))
+	(date-line (engine-custom engine 'date-line))
+	(cover-sheet? (engine-custom engine 'cover-sheet?))
+	(multi-column? (> 1 (engine-custom engine 'column-number))))
+    (if multi-column?
+	;; In single-column document, `@FullWidth' yields a blank page.
+	(display "\n@FullWidth {"))
+    (display "\n//3.0fx\n")
+    (display "\n@Center 1.4f @Font @B { ")
+    (if title
+       (output title engine)
+       (display "The Lout Document"))
+    (display " }\n")
+    (display "//1.7fx\n")
+    (if date-line
+	(begin
+	  (display "@Center { ")
+	  (output date-line engine)
+	  (display " }\n//1.4fx\n")))
+    (if author
+       (begin
+         (display "@Center { ")
+         (output author engine)
+         (display " }\n")
+         (display "//4fx\n")))
+    (if multi-column?
+	(display "\n} # @FullWidth\n"))))
+
+(define (lout-split-external-link markup)
+  ;; Shorten `markup', an URL `url-ref' markup, by splitting it into an URL
+  ;; `ref' followed by plain text.  This is useful because Lout's
+  ;; @ExternalLink symbols are unbreakable to the embodied text should _not_
+  ;; be too large (otherwise it is scaled down).
+  (let* ((url (markup-option markup :url))
+	 (text (or (markup-option markup :text) url)))
+    (lout-debug "lout-split-external-link: text=~a" text)
+    (cond ((pair? text)
+	   ;; no need to go recursive here: we'll get called again later
+	   `(,(ref :url url :text (car text)) ,@(cdr text)))
+
+	  ((string? text)
+	   (let ((len (string-length text)))
+	     (if (> (- len 8) 2)
+		 ;; don't split on a whitespace or it will vanish
+		 (let ((split (let loop ((where 10))
+				(if (= 0 where)
+				    10
+				    (if (char=? (string-ref text
+							    (- where 1))
+						#\space)
+					(loop (- where 1))
+					where)))))
+		   `(,(ref :url url :text (substring text 0 split))
+		     ,(substring text split len)))
+		 (list markup))))
+
+	  ((markup? text)
+	   (let ((kind (markup-markup text)))
+	     (lout-debug "lout-split-external-link: kind=~a" kind)
+	     (if (member kind '(bold it underline))
+		 ;; get the ornament markup out of the `:text' argument
+		 (list (apply (eval kind (interaction-environment))
+			      (list (ref :url url
+					 :text (markup-body text)))))
+ 		 ;; otherwise, leave it as is
+		 (list markup))))
+
+	  (else (list markup)))))
+
+(define (lout-make-toc-entry node engine)
+  ;; Default implementation of the `toc-entry-proc' custom that produces the
+  ;; number and title of `node' for use in the table of contents.
+  (let ((num (markup-option node :number))
+	(title (markup-option node :title))
+	(lang (engine-custom engine 'initial-language)))
+    (if num
+	(begin
+	  (if (is-markup? node 'chapter) (display "@B { "))
+	  (printf "~a. |2s " (lout-structure-number-string node))
+	  (output title engine)
+	  (if (is-markup? node 'chapter) (display " }")))
+	(if (is-markup? node 'chapter)
+	    (output (bold title) engine)
+	    (output title engine)))))
+
+(define (lout-bib-refs-sort/number entry1 entry2)
+  ;; Default implementation of the `bib-refs-sort-proc' custom.  Compare
+  ;; bibliography entries `entry1' and `entry2' (of type `&bib-entry') for
+  ;; use by `sort' in `bib-ref+'.
+  (let ((ident1 (markup-option entry1 :title))
+	(ident2 (markup-option entry2 :title)))
+    (if (and (markup? ident1) (markup? ident2))
+	(< (markup-option ident1 'number)
+	   (markup-option ident2 'number))
+	(begin
+	  (fprint (current-error-port) "i1: " ident1 ", " entry1)
+	  (fprint (current-error-port) "i2: " ident2 ", " entry2)))))
+
+(define (lout-pdf-bookmark-title node engine)
+  ;; Default implementation of the `pdf-bookmark-title-proc' custom that
+  ;; returns a title (a string) for the PDF bookmark of `node'.
+  (let ((number (lout-structure-number-string node)))
+    (string-append  (if (string=? number "") "" (string-append number ". "))
+		    (ast->string (markup-option node :title)))))
+
+(define (lout-pdf-bookmark-node? node engine)
+  ;; Default implementation of the `pdf-bookmark-node-pred' custom that
+  ;; returns a boolean.
+  (or (is-markup? node 'chapter)
+      (is-markup? node 'section)
+      (is-markup? node 'subsection)
+      (is-markup? node 'slide)))
+
+
+
+
+;*---------------------------------------------------------------------*/
+;*    lout-engine ...                                                 */
+;*---------------------------------------------------------------------*/
+(define lout-engine
+   (default-engine-set!
+      (make-engine 'lout
+		   :version 0.2
+		   :format "lout"
+		   :delegate (find-engine 'base)
+		   :filter (make-string-replace lout-encoding)
+		   :custom `(;; The underlying Lout document type, i.e. one
+			     ;; of `doc', `report', `book' or `slides'.
+			     (document-type report)
+
+			     ;; Document style file include line (a string
+			     ;; such as `@Include { doc-style.lout }') or
+			     ;; `auto' (symbol) in which case the include
+			     ;; file is deduced from `document-type'.
+			     (document-include auto)
+
+			     (includes "@SysInclude { tbl }\n")
+			     (initial-font "Palatino Base 10p")
+			     (initial-break
+			      ,(string-append "unbreakablefirst "
+					      "unbreakablelast "
+					      "hyphen adjust 1.2fx"))
+
+			     ;; The document's language, used for hyphenation
+			     ;; and other things.
+			     (initial-language "English")
+
+			     ;; Number of columns.
+			     (column-number 1)
+
+			     ;; First page number.
+			     (first-page-number 1)
+
+			     ;; Page orientation, `portrait', `landscape',
+			     ;; `reverse-portrait' or `reverse-landscape'.
+			     (page-orientation portrait)
+
+			     ;; For reports, whether to produce a cover
+			     ;; sheet.  The `doc-cover-sheet-proc' custom may
+			     ;; also honor this custom for `doc' documents.
+			     (cover-sheet? #t)
+
+			     ;; For reports, the date line.
+			     (date-line #t)
+
+			     ;; For reports, an abstract.
+			     (abstract #f)
+
+			     ;; For reports, title/name of the abstract.  If
+			     ;; `#f', the no abstract title will be
+			     ;; produced.  If `#t', a default name in the
+			     ;; current language is chosen.
+			     (abstract-title #t)
+
+			     ;; Whether to optimize pages.
+			     (optimize-pages? #f)
+
+			     ;; For docs, the procedure that produces the
+			     ;; Lout code for the cover sheet or title.
+			     (doc-cover-sheet-proc
+			      ,lout-make-doc-cover-sheet)
+
+			     ;; Procedure used to sort bibliography
+			     ;; references when several are referred to at
+			     ;; the same time, as in:
+			     ;;  (ref :bib '("smith03" "jones98")) .
+			     ;; By default they are sorted by number.  If
+			     ;; `#f' is given, they are left as is.
+			     (bib-refs-sort-proc
+			      ,lout-bib-refs-sort/number)
+
+			     ;; Lout code for paragraph gaps (similar to
+			     ;; `@PP' with `@ParaGap' equal to `1.0vx' by
+			     ;; default)
+			     (paragraph-gap
+			      "\n//1.0vx @ParaIndent @Wide &{0i}\n")
+
+			     ;; For multi-page tables, it may be
+			     ;; useful to set this to `#t'.  However,
+			     ;; this looks kind of buggy.
+			     (use-header-rows? #f)
+
+			     ;; Tells whether to use Skribe's footnote
+			     ;; numbers or Lout's numbering scheme (the
+			     ;; latter may be better, typography-wise).
+			     (use-skribe-footnote-numbers? #t)
+
+			     ;; A procedure that is passed the engine
+			     ;; and produces Lout definitions.
+			     (inline-definitions-proc ,lout-definitions)
+
+			     ;; A procedure that takes a URL `ref' markup and
+			     ;; returns a list containing (maybe) one such
+			     ;; `ref' markup.  This custom can be used to
+			     ;; modified the way URLs are rendered.  The
+			     ;; default value is a procedure that limits the
+			     ;; size of Lout's @ExternalLink symbols since
+			     ;; they are unbreakable.  In order to completely
+			     ;; disable use of @ExternalLinks, just set it to
+			     ;; `markup-body'.
+			     (transform-url-ref-proc
+			      ,lout-split-external-link)
+
+			     ;; Leader used in the table of contents entries.
+			     (toc-leader ".")
+
+			     ;; Inter-leader spacing in the TOC entries.
+			     (toc-leader-space "2.5s")
+
+			     ;; Procedure that takes a large-scale structure
+			     ;; (chapter, section, etc.) and the engine and
+			     ;; produces the number and possibly title of
+			     ;; this structure for use the TOC.
+			     (toc-entry-proc ,lout-make-toc-entry)
+
+			     ;; The Lout program name, only useful when using
+			     ;; `lout-illustration' on other back-ends.
+			     (lout-program-name "lout")
+
+			     ;; Title and author information in the PDF
+			     ;; document information.  If `#t', the
+			     ;; document's `:title' and `:author' are used.
+			     (pdf-title #t)
+			     (pdf-author #t)
+
+			     ;; Keywords (a list of string) in the PDF
+			     ;; document information.
+			     (pdf-keywords #f)
+
+			     ;; Extra PDF information, an alist of key-value
+			     ;; pairs (string pairs).
+			     (pdf-extra-info (("SkribeVersion"
+					       ,(skribe-release))))
+
+			     ;; Tells whether to produce PDF "docinfo"
+			     ;; (meta-information with title, author,
+			     ;; keywords, etc.).
+			     (make-pdf-docinfo? #t)
+
+			     ;; Tells whether a PDF outline
+			     ;; (aka. "bookmarks") should be produced.
+			     (make-pdf-outline? #t)
+
+			     ;; Procedure that takes a node and an engine and
+			     ;; return a string representing the title of
+			     ;; that node's PDF bookmark.
+			     (pdf-bookmark-title-proc ,lout-pdf-bookmark-title)
+
+			     ;; Procedure that takes a node and an engine and
+			     ;; returns true if that node should have a PDF
+			     ;; outline entry.
+			     (pdf-bookmark-node-pred ,lout-pdf-bookmark-node?)
+
+			     ;; Procedure that takes a node and an engine and
+			     ;; returns true if the bookmark for that node
+			     ;; should be closed ("folded") when the user
+			     ;; opens the PDF document.
+			     (pdf-bookmark-closed-pred
+			      ,(lambda (n e)
+				 (not (is-markup? n 'chapter))))
+
+			     ;; color
+			     (color? #t)
+
+			     ;; source fontification
+			     (source-color #t)
+			     (source-comment-color "#ffa600")
+			     (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"))
+
+		   :symbol-table (lout-symbol-table
+				  (lambda (m)
+				     (format #f "@Eq { ~a }\n" m))))))
+
+
+
+;; User-level implementation of PDF bookmarks.
+;;
+;; Basically, Lout code is produced that produces (via `@Graphic') PostScript
+;; code.  That PostScript code is a `pdfmark' command (see Adobe's "pdfmark
+;; Reference Manual") which, when converted to PDF (e.g. with `ps2pdf'),
+;; produces a PDF outline, aka. "bookmarks" (see "PDF Reference, Fifth
+;; Edition", section 8.2.2).
+
+(define (lout-internal-dest-name ident)
+  ;; Return the Lout-generated `pdfmark' named destination for `ident'.  This
+  ;; function mimics Lout's `ConvertToPDFName ()', in `z49.c' (Lout's
+  ;; PostScript back-end).  In Lout, `ConvertToPDFName ()' produces
+  ;; destination names for the `/Dest' function of the `pdfmark' operator.
+  ;; This implementation is valid as of Lout 3.31 and hopefully it won't
+  ;; change in the future.
+  (string-append "LOUT"
+		 (list->string (map (lambda (c)
+				      (if (or (char-alphabetic? c)
+					      (char-numeric? c))
+					  c
+					  #\_))
+				    (string->list ident)))))
+
+(define (lout-pdf-bookmark node children closed? engine)
+  ;; Return the PostScript `pdfmark' operation (a string) that creates a PDF
+  ;; bookmark for node `node'.  `children' is the number of children of
+  ;; `node' in the PDF outline.  If `closed?' is true, then the bookmark will
+  ;; be close (i.e. its children are hidden).
+  ;;
+  ;; Note:  Here, we use a `GoTo' action, while we could instead simply
+  ;; produce a `/Page' attribute without having to use the
+  ;; `lout-internal-dest-name' hack.  The point for doing this is that Lout's
+  ;; `@PageOf' operator doesn't return an "actual" page number within the
+  ;; document, but rather a "typographically correct" page number (e.g. `i'
+  ;; for the cover sheet, `1' for the second page, etc.).  See
+  ;; http://lists.planix.com/pipermail/lout-users/2005q1/003925.html for
+  ;; details.
+  (let* ((filter-title (make-string-replace `(,@lout-verbatim-encoding
+					      (#\newline " "))))
+	 (make-bookmark-title (lambda (n e)
+				(filter-title
+				 ((engine-custom
+				   engine 'pdf-bookmark-title-proc)
+				  n e))))
+	 (ident (markup-ident node)))
+    (string-append "["
+		   (if (= 0 children)
+		       ""
+		       (string-append "\"/\"Count "
+				      (if closed? "-" "")
+				      (number->string children) " "))
+		   "\"/\"Title \"(\"" (make-bookmark-title node engine)
+		   "\")\" "
+		   (if (not ident) ""
+		       (string-append "\"/\"Action \"/\"GoTo \"/\"Dest \"/\""
+				      (lout-internal-dest-name ident) " "))
+		   "\"/\"OUT pdfmark\n")))
+
+(define (lout-pdf-outline node engine . children)
+  ;; Return the PDF outline string (in the form of a PostScript `pdfmark'
+  ;; command) for `node' whose child nodes are assumed to be `children',
+  ;; unless `node' is a document.
+  (let* ((choose-node? (lambda (n)
+			 ((engine-custom engine 'pdf-bookmark-node-pred)
+			  n engine)))
+	 (nodes (if (document? node)
+		    (filter choose-node? (markup-body node))
+		    children)))
+    (apply string-append
+	   (map (lambda (node)
+		  (let* ((children (filter choose-node? (markup-body node)))
+			 (closed? ((engine-custom engine
+						  'pdf-bookmark-closed-pred)
+				   node engine))
+			 (bm (lout-pdf-bookmark node (length children)
+						closed? engine)))
+		    (string-append bm (apply lout-pdf-outline
+					     `(,node ,engine ,@children)))))
+		nodes))))
+
+(define (lout-embedded-postscript-code postscript)
+  ;; Return a string embedding PostScript code `postscript' into Lout code.
+  (string-append "\n"
+		 "{ @BackEnd @Case {\n"
+		 "    PostScript @Yield {\n"
+		 postscript
+		 "        }\n"
+		 "} } @Graphic { }\n"))
+
+(define (lout-pdf-docinfo doc engine)
+  ;; Produce PostScript code that will produce PDF document information once
+  ;; converted to PDF.
+  (let* ((filter-string (make-string-replace `(,@lout-verbatim-encoding
+					       (#\newline " "))))
+	 (docinfo-field (lambda (key value)
+			  (string-append "\"/\"" key " \"(\""
+					 (filter-string value)
+					 "\")\"\n")))
+	 (author (let ((a (engine-custom engine 'pdf-author)))
+		   (if (or (string? a) (ast? a))
+		       a
+		       (markup-option doc :author))))
+	 (title  (let ((t (engine-custom engine 'pdf-title)))
+		   (if (or (string? t) (ast? t))
+		       t
+		       (markup-option doc :title))))
+	 (keywords (engine-custom engine 'pdf-keywords))
+	 (extra-fields (engine-custom engine 'pdf-extra-info))
+	 (stringify-kw (lambda (kws)
+			 (let loop ((kws kws) (s ""))
+			   (if (null? kws) s
+			       (loop (cdr kws)
+				     (string-append s (car kws)
+						    (if (pair? (cdr kws))
+							", " ""))))))))
+    (string-append "[ "
+		   (if title
+		       (docinfo-field "Title" (ast->string title))
+		       "")
+		   (if author
+		       (docinfo-field "Author"
+				      (or (cond ((markup? author)
+						 (ast->string
+						  (or (markup-option
+						       author :name)
+						      (markup-option
+						       author :affiliation))))
+						((string? author) author)
+						(else (ast->string author)))
+					  ""))
+		       "")
+		   (if keywords
+		       (docinfo-field "Keywords"
+				      (cond ((string? keywords)
+					     keywords)
+					    ((pair? keywords)
+					     (stringify-kw keywords))
+					    (else "")))
+		       "")
+		   ;; arbitrary key-value pairs, see sect. 4.7, "Info
+		   ;; dictionary" of the `pdfmark' reference.
+		   (if (or (not extra-fields) (null? extra-fields))
+		       ""
+		       (apply string-append
+			      (map (lambda (p)
+				     (docinfo-field (car p) (cadr p)))
+				   extra-fields)))
+		   "\"/\"DOCINFO pdfmark\n")))
+
+(define (lout-output-pdf-meta-info doc engine)
+  ;; Produce PDF bookmarks (aka. "outline") for document `doc', as well as
+  ;; document meta-information (or "docinfo").  This function makes sure that
+  ;; both are only produced once, and only if the relevant customs ask for
+  ;; them.
+  (if (and doc (engine-custom engine 'make-pdf-outline?)
+	   (not (markup-option doc '&pdf-outline-produced?)))
+      (begin
+	(display
+	 (lout-embedded-postscript-code (lout-pdf-outline doc engine)))
+	(markup-option-add! doc '&pdf-outline-produced? #t)))
+  (if (and doc (engine-custom engine 'make-pdf-docinfo?)
+	   (not (markup-option doc '&pdf-docinfo-produced?)))
+      (begin
+	(display
+	 (lout-embedded-postscript-code (lout-pdf-docinfo doc engine)))
+	(markup-option-add! doc '&pdf-docinfo-produced? #t))))
+
+
+
+;*---------------------------------------------------------------------*/
+;*    lout ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (!lout fmt #!rest opt)
+   (if (engine-format? "lout")
+       (apply ! fmt opt)
+       #f))
+
+;*---------------------------------------------------------------------*/
+;*    lout-width ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (lout-width width)
+   (cond ((flonum? width) ;; a relative size
+	  ;; FIXME: Hack ahead: assuming A4 with a 2.5cm margin
+	  ;; on both sides
+	  (let* ((orientation (let ((lout (find-engine 'lout)))
+				 (or (and lout
+					  (engine-custom lout
+							 'page-orientation))
+				     'portrait)))
+		 (margins 5)
+		 (paper-width (case orientation
+				 ((portrait reverse-portrait)
+				  (- 21 margins))
+				 (else (- 29.7 margins)))))
+	     (string-append (number->string (* paper-width
+					       (/ (abs width) 100.)))
+			    "c")))
+	 ((string? width) ;; an engine-dependent width
+	  width)
+	 (else ;; an absolute "pixel" size
+	  (string-append (number->string width) "p"))))
+
+;*---------------------------------------------------------------------*/
+;*    lout-font-size ...                                               */
+;*---------------------------------------------------------------------*/
+(define (lout-font-size size)
+   (case size
+      ((4) "3.5f")
+      ((3) "2.0f")
+      ((2) "1.5f")
+      ((1) "1.2f")
+      ((0) "1.0f")
+      ((-1) "0.8f")
+      ((-2) "0.5f")
+      ((-3) "0.3f")
+      ((-4) "0.2f")
+      (else (if (number? size)
+		(if (< size 0) "0.3f" "1.5f")
+		"1.0f"))))
+
+(define (lout-color-specification skribe-color)
+  ;; Return a Lout color name, ie. a string which is either an English color
+  ;; name or something like "rgb 0.5 0.2 0.6".  `skribe-color' is a string
+  ;; representing a Skribe color such as "black" or "#ffffff".
+   (let ((b&w? (let ((lout (find-engine 'lout)))
+		  (and lout (not (engine-custom lout 'color?)))))
+	 (actual-color
+	  (if (and (string? skribe-color)
+		   (char=? (string-ref skribe-color 0) #\#))
+	      (string->number (substring skribe-color 1
+					 (string-length skribe-color))
+			      16)
+	      skribe-color)))
+      (receive (r g b)
+	 (skribe-color->rgb actual-color)
+	 (apply format #f
+		(cons "rgb ~a ~a ~a"
+		      (map (if b&w?
+			       (let ((avg (exact->inexact (/ (+ r g b)
+							     (* 256 3)))))
+				  (lambda (x) avg))
+			       (lambda (x)
+				 (exact->inexact (/ x 256))))
+			   (list r g b)))))))
+
+;*---------------------------------------------------------------------*/
+;*    &~ ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer '&~ :before "~" :action #f)
+
+(define (lout-page-orientation orientation)
+  ;; Return a string representing the Lout page orientation name for symbol
+  ;; `orientation'.
+  (let* ((alist '((portrait . "Portrait")
+		  (landscape . "Landscape")
+		  (reverse-portrait . "ReversePortrait")
+		  (reverse-landscape . "ReverseLandscape")))
+	 (which (assoc orientation alist)))
+    (if (not which)
+	(skribe-error 'lout
+		      "`page-orientation' should be either `portrait' or `landscape'"
+		      orientation)
+	(cdr which))))
+
+
+;*---------------------------------------------------------------------*/
+;*    document ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+   :options '(:title :author :ending :env)
+   :before (lambda (n e) ;; `e' is the engine
+	     (let* ((doc-type (let ((d (engine-custom e 'document-type)))
+				(if (string? d)
+				    (begin
+				      (engine-custom-set! e 'document-type
+							  (string->symbol d))
+				      (string->symbol d))
+				    d)))
+		    (doc-style? (eq? doc-type 'doc))
+		    (slides? (eq? doc-type 'slides))
+		    (doc-include (engine-custom e 'document-include))
+		    (includes (engine-custom e 'includes))
+		    (font (engine-custom e 'initial-font))
+		    (lang (engine-custom e 'initial-language))
+		    (break (engine-custom e 'initial-break))
+		    (column-number (engine-custom e 'column-number))
+		    (first-page-number (engine-custom e 'first-page-number))
+		    (page-orientation (engine-custom e 'page-orientation))
+		    (title (markup-option n :title)))
+
+	       ;; Add this markup option, used by
+	       ;; `lout-start-large-scale-structure' et al.
+	       (markup-option-add! n '&substructs-started? #f)
+
+	       (if (eq? doc-include 'auto)
+		   (case doc-type
+		     ((report)  (display "@SysInclude { report }\n"))
+		     ((book)    (display "@SysInclude { book }\n"))
+		     ((doc)     (display "@SysInclude { doc }\n"))
+		     ((slides)  (display "@SysInclude { slides }\n"))
+		     (else     (skribe-error
+				'lout
+				"`document-type' should be one of `book', `report' or `doc'"
+				doc-type)))
+		   (printf "# Custom document includes\n~a\n" doc-include))
+
+	       (if includes
+		   (printf "# Additional user includes\n~a\n" includes)
+		   (display "@SysInclude { tbl }\n"))
+
+	       ;; Write additional Lout definitions
+	       (display (lout-definitions e))
+
+	       (case doc-type
+		 ((report) (display "@Report\n"))
+		 ((book)   (display "@Book\n"))
+		 ((doc)    (display "@Document\n"))
+		 ((slides) (display "@OverheadTransparencies\n")))
+
+	       (display (string-append "  @InitialSpace { tex } "
+				       "# avoid having too many spaces\n"))
+
+	       ;; The `doc' style doesn't have @Title, @Author and the likes
+	       (if (not doc-style?)
+		   (begin
+		     (display "  @Title { ")
+		     (if title
+			 (output title e)
+			 (display "The Lout-Skribe Book"))
+		     (display " }\n")
+
+		     ;; The author
+		     (let* ((author (markup-option n :author)))
+
+		       (display "  @Author { ")
+		       (output author e)
+		       (display " }\n")
+
+		       ;; Lout reports support `@Institution' while books
+		       ;; don't.
+		       (if (and (eq? doc-type 'report)
+				(is-markup? author 'author))
+			   (let ((institution (markup-option author
+							     :affiliation)))
+			     (if institution
+				 (begin
+				   (printf "  @Institution { ")
+				   (output institution e)
+				   (printf " }\n"))))))))
+
+	       ;; Lout reports make it possible to choose whether to prepend
+	       ;; a cover sheet (books and docs don't).  Same for a date
+	       ;; line.
+	       (if (eq? doc-type 'report)
+		   (let ((cover-sheet?   (engine-custom e 'cover-sheet?))
+			 (date-line      (engine-custom e 'date-line))
+			 (abstract       (engine-custom e 'abstract))
+			 (abstract-title (engine-custom e 'abstract-title)))
+		     (display (string-append "  @CoverSheet { "
+					     (if cover-sheet?
+						 "Yes" "No")
+					     " }\n"))
+		     (display "  @DateLine { ")
+		     (if (string? date-line)
+			 (output date-line e)
+			 (display (if date-line "Yes" "No")))
+		     (display " }\n")
+
+		     (if abstract
+			 (begin
+			   (if (not (eq? abstract-title #t))
+			       (begin
+				 (display "  @AbstractTitle { ")
+				 (cond
+				  ((not abstract-title) #t)
+				  (else (output abstract-title e)))
+				 (display " }\n")))
+
+			   (display "  @Abstract {\n")
+			   (output abstract e)
+			   (display "\n}\n")))))
+
+	       (printf "  @OptimizePages { ~a }\n"
+		       (if (engine-custom e 'optimize-pages?)
+			   "Yes" "No"))
+
+	       (printf "  @InitialFont { ~a }\n"
+		       (cond ((string? font) font)
+			     ((symbol? font)
+			      (string-append (symbol->string font)
+					     " Base 10p"))
+			     ((number? font)
+			      (string-append "Palatino Base "
+					     (number->string font)
+					     "p"))
+			     (#t
+			      (skribe-error
+			       'lout 'initial-font
+			       "Should be a Lout font name, a symbol, or a number"))))
+	       (printf "  @InitialBreak { ~a }\n"
+		       (if break break "adjust 1.2fx hyphen"))
+	       (if (not slides?)
+		   (printf "  @ColumnNumber { ~a }\n"
+			   (if (number? column-number)
+			       column-number 1)))
+	       (printf "  @FirstPageNumber { ~a }\n"
+		       (if (number? first-page-number)
+			   first-page-number 1))
+	       (printf "  @PageOrientation { ~a }\n"
+		       (lout-page-orientation page-orientation))
+	       (printf "  @InitialLanguage { ~a }\n"
+		       (if lang lang "English"))
+
+	       ;; FIXME: Insert a preface for text preceding the first ch.
+	       ;; FIXME: Create an @Introduction for the first chapter
+	       ;;        if its title is "Introduction" (for books).
+
+	       (display "//\n\n")
+
+	       (if doc-style?
+		   ;; `doc' documents don't have @Title and the likes so
+		   ;; we need to implement them "by hand"
+		   (let ((make-cover-sheet
+			  (engine-custom e 'doc-cover-sheet-proc)))
+		     (display "@Text @Begin\n")
+		     (if make-cover-sheet
+			 (make-cover-sheet n e)
+			 (lout-make-doc-cover-sheet n e))))
+
+	       (if doc-style?
+		   ;; Putting it here will only works with `doc' documents.
+		   (lout-output-pdf-meta-info n e))))
+
+   :after (lambda (n e)
+	    (let ((doc-type (engine-custom e 'document-type)))
+	      (if (eq? doc-type 'doc)
+		  (begin
+		    (if (markup-option n '&substructs-started?)
+			(display "\n@EndSections\n"))
+		    (display "\n@End @Text\n")))
+	      (display "\n\n# Lout document ends here.\n"))))
+
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address
+	      :phone :photo :align)
+
+   :action (lambda (n e)
+	      (let ((doc-type (engine-custom e 'document-type))
+		    (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))
+		    (photo (markup-option n :photo)))
+
+		(define (row x)
+		  (display "\n//1.5fx\n@Center { ")
+		  (output x e)
+		  (display " }\n"))
+
+		(if email
+		    (row (list (if name name "")
+			       (! " <@I{")
+			       (cond ((string? email) email)
+				     ((markup? email)
+				      (markup-body email))
+				     (#t ""))
+			       (! "}> ")))
+		    (if name (row name)))
+
+		(if title (row title))
+
+		;; In reports, the affiliation is passed to `@Institution'.
+		;; However, books do not have an `@Institution' parameter.
+		(if (and affiliation (not (eq? doc-type 'report)))
+		    (row affiliation))
+
+		(if address (row address))
+		(if phone (row phone))
+		(if url (row (it url)))
+		(if photo (row photo)))))
+
+
+(define (lout-toc-entry node depth engine)
+  ;; Produce a TOC entry of depth `depth' (a integer greater than or equal to
+  ;; zero) for `node' using engine `engine'.  The Lout code here is mostly
+  ;; copied from Lout's `dsf' (see definition of `@Item').
+  (let ((ident (markup-ident node))
+	(entry-proc (engine-custom engine 'toc-entry-proc)))
+    (if (markup-option node :toc)
+	(begin
+	  (display "@LP\n")
+	  (if ident
+	      ;; create an internal for PDF navigation
+	      (printf "{ ~a } @LinkSource { " (lout-tagify ident)))
+
+	  (if (> depth 0)
+	      (printf "|~as " (number->string (* 6 depth))))
+	  (display " @HExpand { ")
+
+	  ;; output the number and title of this node
+	  (entry-proc node engine)
+
+	  (display " &1rt @OneCol { ")
+	  (printf " @SkribeLeaders & @PageOf { ~a }"
+		  (lout-tagify (markup-ident node)))
+	  (display " &0io } }")
+
+	  (if ident (display " }"))
+	  (display "\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    toc ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'toc
+   :options '(:class :chapter :section :subsection)
+   :action (lambda (n e)
+	     (display "\n# toc\n")
+	     (if (markup-option n :chapter)
+		 (let ((chapters (filter (lambda (n)
+					    (or (is-markup? n 'chapter)
+						(is-markup? n 'slide)))
+					 (markup-body (ast-document n)))))
+		   (for-each (lambda (c)
+			       (let ((sections
+				      (search-down (lambda (n)
+						     (is-markup? n 'section))
+						   c)))
+				 (lout-toc-entry c 0 e)
+				 (if (markup-option n :section)
+				     (for-each
+				      (lambda (s)
+					(lout-toc-entry s 1 e)
+					(if (markup-option n :subsection)
+					    (let ((subs
+						   (search-down
+						    (lambda (n)
+						      (is-markup?
+						       n 'subsection))
+						    s)))
+					      (for-each
+					       (lambda (s)
+						 (lout-toc-entry s 2 e))
+					       subs))))
+				      sections))))
+			     chapters)))))
+
+(define lout-book-markup-alist
+  '((chapter . "Chapter")
+    (section . "Section")
+    (subsection . "SubSection")
+    (subsubsection . "SubSubSection")))
+
+(define lout-report-markup-alist
+  '((chapter . "Section")
+    (section . "SubSection")
+    (subsection . "SubSubSection")
+    (subsubsection . #f)))
+
+(define lout-doc-markup-alist lout-report-markup-alist)
+
+(define (lout-structure-markup skribe-markup engine)
+  ;; Return the Lout structure name for `skribe-markup' (eg. "Chapter" for
+  ;; `chapter' markups when `engine''s document type is `book').
+  (let ((doc-type (engine-custom engine 'document-type))
+	(assoc-ref (lambda (alist key)
+		      (and-let* ((as (assoc key alist))) (cdr as)))))
+    (case doc-type
+      ((book)    (assoc-ref lout-book-markup-alist skribe-markup))
+      ((report)  (assoc-ref lout-report-markup-alist skribe-markup))
+      ((doc)     (assoc-ref lout-doc-markup-alist skribe-markup))
+      (else
+       (skribe-error 'lout
+		     "`document-type' should be one of `book', `report' or `doc'"
+		     doc-type)))))
+
+(define (lout-structure-number-string markup)
+  ;; Return a structure number string such as "1.2".
+  (let loop ((struct markup))
+    (if (document? struct)
+	""
+	(let ((parent-num (loop (ast-parent struct)))
+	      (num (markup-option struct :number)))
+	  (string-append parent-num
+			 (if (string=? "" parent-num) "" ".")
+			 (if (number? num) (number->string num) ""))))))
+
+;*---------------------------------------------------------------------*/
+;*    lout-block-before ...                                            */
+;*---------------------------------------------------------------------*/
+(define (lout-block-before n e)
+  ;; Produce the Lout code that introduces node `n', a large-scale
+  ;; structure (chapter, section, etc.).
+  (let ((lout-markup (lout-structure-markup (markup-markup n) e))
+	(title (markup-option n :title))
+	(number (markup-option n :number))
+	(ident (markup-ident n)))
+
+    (if (not lout-markup)
+	(begin
+	   ;; the fallback method (i.e. when there exists no equivalent
+	   ;; Lout markup)
+	   (display "\n//1.8vx\n@B { ")
+	   (output title e)
+	   (display " }\n@SkribeMark { ")
+	   (display (lout-tagify ident))
+	   (display " }\n//0.8vx\n\n"))
+	(begin
+	   (printf "\n@~a\n  @Title { " lout-markup)
+	   (output title e)
+	   (printf " }\n")
+
+	   (if (number? number)
+	       (printf "  @BypassNumber { ~a }\n"
+		       (lout-structure-number-string n))
+	       (if (not number)
+		   ;; this trick hides the section number
+		   (printf "  @BypassNumber { } # unnumbered\n")))
+
+	   (cond ((string? ident)
+		  (begin
+		     (display "  @Tag { ")
+		     (display (lout-tagify ident))
+		     (display " }\n")))
+		 ((symbol? ident)
+		  (begin
+		     (display "  @Tag { ")
+		     (display (lout-tagify (symbol->string ident)))
+		     (display " }\n")))
+		 (#t
+		  (skribe-error 'lout
+				"Node identifiers should be strings"
+				ident)))
+
+	   (display "\n@Begin\n")))))
+
+(define (lout-block-after n e)
+  ;; Produce the Lout code that terminates node `n', a large-scale
+  ;; structure (chapter, section, etc.).
+  (let ((lout-markup (lout-structure-markup (markup-markup n) e)))
+     (if (not lout-markup)
+	 (printf "\n\n//0.3vx\n\n") ;; fallback method
+	 (printf "\n\n@End @~a\n\n" lout-markup))))
+
+
+(define (markup-option-set! m opt val)
+  ;; Sets the value of markup option `opt' of markup `m' to `val'.
+  (let ((o (assoc opt (markup-options m))))
+    (if o
+	(begin
+;	  (set-cdr! o val)
+	  (markup-option-add! m opt val) ;; FIXME: the above method fails
+	  (if (not (eq? (markup-option m opt) val))
+	      (skribe-error 'markup-option-set!
+			    "Doesn't work!" (markup-option m opt))))
+	(begin
+	  (lout-debug "markup-option-set!: markup ~a doesn't have option ~a"
+		      m opt)
+	  #f))))
+
+(define (lout-markup-child-type skribe-markup)
+  ;; Return the child markup type of `skribe-markup' (e.g. for `chapter',
+  ;; return `section').
+  (let loop ((structs '(document chapter section subsection subsubsection)))
+    (if (null? structs)
+	#f
+	(if (eq? (car structs) skribe-markup)
+	    (cadr structs)
+	    (loop (cdr structs))))))
+
+(define (lout-start-large-scale-structure markup engine)
+  ;; Perform the necessary step and produce output as a result of starting
+  ;; large-scale structure `markup' (ie. a chapter, section, subsection,
+  ;; etc.).
+  (let* ((doc-type (engine-custom engine 'document-type))
+	 (doc-style? (eq? doc-type 'doc))
+	 (parent (ast-parent markup))
+	 (markup-type (markup-markup markup))
+	 (lout-markup-name (lout-structure-markup markup-type
+						  engine)))
+    (lout-debug "start-struct: markup=~a parent=~a"
+		markup parent)
+
+    ;; add an `&substructs-started?' option to the markup
+    (markup-option-add! markup '&substructs-started? #f)
+
+    (if (and lout-markup-name
+	     parent (or doc-style? (not (document? parent))))
+	(begin
+	  (if (not (markup-option parent '&substructs-started?))
+	      ;; produce an `@BeginSubSections' or equivalent; `doc'-style
+	      ;; documents need to preprend an `@BeginSections' before the
+	      ;; first section while other styles don't.
+	      (printf "\n@Begin~as\n" lout-markup-name))
+
+	  ;; update the `&substructs-started?' option of the parent
+	  (markup-option-set! parent '&substructs-started? #t)
+	  (lout-debug "start-struct: updated parent: ~a"
+		      (markup-option parent '&substructs-started?))))
+
+    ;; output the `@Section @Title { ... } @Begin' thing
+    (lout-block-before markup engine)))
+
+(define (lout-end-large-scale-structure markup engine)
+  ;; Produce Lout code for ending structure `markup' (a chapter, section,
+  ;; subsection, etc.).
+  (let* ((doc-type (engine-custom engine 'document-type))
+	 (doc-style? (eq? doc-type 'doc))
+	 (markup-type (markup-markup markup))
+	 (lout-markup-name (lout-structure-markup markup-type
+						  engine)))
+
+    (if (and lout-markup-name
+	     (markup-option markup '&substructs-started?)
+	     (or doc-style? (not (document? markup))))
+	(begin
+	  ;; produce an `@EndSubSections' or equivalent; `doc'-style
+	  ;; documents need to issue an `@EndSections' after the last section
+	  ;; while other types of documents don't.
+	  (lout-debug "end-struct: closing substructs for ~a" markup)
+	  (printf "\n@End~as\n"
+		  (lout-structure-markup (lout-markup-child-type markup-type)
+					 engine))
+	  (markup-option-set! markup '&substructs-started? #f)))
+
+    (lout-block-after markup engine)))
+
+
+;*---------------------------------------------------------------------*/
+;*    section ... .. @label chapter@                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'chapter
+   :options '(:title :number :toc :file :env)
+   :validate (lambda (n e)
+	       (document? (ast-parent n)))
+
+   :before (lambda (n e)
+	     (lout-start-large-scale-structure n e)
+
+	     ;; `doc' documents produce their PDF outline right after
+	     ;; `@Text @Begin'; other types of documents must produce it
+	     ;; as part of their first chapter.
+	     (lout-output-pdf-meta-info (ast-document n) e))
+
+   :after lout-end-large-scale-structure)
+
+;*---------------------------------------------------------------------*/
+;*    section ... . @label section@                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'section
+   :options '(:title :number :toc :file :env)
+   :validate (lambda (n e)
+	       (is-markup? (ast-parent n) 'chapter))
+   :before lout-start-large-scale-structure
+   :after lout-end-large-scale-structure)
+
+;*---------------------------------------------------------------------*/
+;*    subsection ... @label subsection@                                */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsection
+   :options '(:title :number :toc :file :env)
+   :validate (lambda (n e)
+	       (is-markup? (ast-parent n) 'section))
+   :before lout-start-large-scale-structure
+   :after lout-end-large-scale-structure)
+
+;*---------------------------------------------------------------------*/
+;*    subsubsection ... @label subsubsection@                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsubsection
+   :options '(:title :number :toc :file :env)
+   :validate (lambda (n e)
+	       (is-markup? (ast-parent n) 'subsection))
+   :before lout-start-large-scale-structure
+   :after lout-end-large-scale-structure)
+
+
+;*---------------------------------------------------------------------*/
+;*    paragraph ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'paragraph
+   :options '()
+   :validate (lambda (n e)
+	       (or (eq? 'doc (engine-custom e 'document-type))
+		   (memq (and (markup? (ast-parent n))
+			      (markup-markup (ast-parent n)))
+			 '(chapter section subsection subsubsection slide))))
+   :before (lambda (n e)
+	     (let ((gap (engine-custom e 'paragraph-gap)))
+	       (display (if (string? gap) gap "\n@PP\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    footnote ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'footnote
+   :options '(:number)
+   :before (lambda (n e)
+	     (let ((number (markup-option n :number))
+		   (use-number?
+		    (engine-custom e 'use-skribe-footnote-numbers?)))
+	       (if use-number?
+		   (printf "{ @FootNote @Label { ~a } { "
+			   (if number number ""))
+		   (printf "{ @FootNote ~a{ "
+			   (if (not number) "@Label { } " "")))))
+   :after (lambda (n e)
+	    (display " } }")))
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'linebreak
+   :action (lambda (n e)
+	      (display "\n@LP\n")))
+
+;*---------------------------------------------------------------------*/
+;*    hrule ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'hrule
+   :options '()
+   :action "\n@LP\n@FullWidthRule\n@LP\n")
+
+;*---------------------------------------------------------------------*/
+;*    color ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'color
+   :options '(:fg :bg :width)
+   ;; FIXME: `:bg' not supported
+   ;; FIXME: `:width' is not supported either.  Rather use `frame' for that
+   ;; kind of options.
+   :before (lambda (n e)
+	     (let* ((w (markup-option n :width))
+		    (fg (markup-option n :fg)))
+	       (printf "{ ~a } @Color { " (lout-color-specification fg))))
+
+   :after (lambda (n e)
+	    (display " }")))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'frame
+   ;; @Box won't span over several pages so this may cause
+   ;; problems if large frames are used.  The workaround here consists
+   ;; in using an @Tbl with one single cell.
+   :options '(:width :border :margin :bg)
+   :before (lambda (n e)
+	     (let ((width (markup-option n :width))
+		   (margin (markup-option n :margin))
+		   (border (markup-option n :border))
+		   (bg (markup-option n :bg)))
+
+	       ;; The user manual seems to expect `frame' to imply a
+	       ;; linebreak.  However, the LaTeX engine doesn't seem to
+	       ;; agree.
+	       ;(display "\n@LP")
+	       (printf (string-append "\n@Tbl # frame\n"
+				      "  rule { yes }\n"))
+	       (if border (printf     "  rulewidth { ~a }\n"
+				      (lout-width border)))
+	       (if width  (printf     "  width { ~a }\n"
+				      (lout-width width)))
+	       (if margin (printf     "  margin { ~a }\n"
+				      (lout-width margin)))
+	       (if bg     (printf     "  paint { ~a }\n"
+				      (lout-color-specification bg)))
+	       (display "{ @Row format { @Cell A } A { "))
+
+; 	     (printf "\n@Box linewidth { ~a } margin { ~a } { "
+; 		     (lout-width (markup-option n :width))
+; 		     (lout-width (markup-option n :margin)))
+	     )
+   :after (lambda (n e)
+	    (display " } }\n")))
+
+;*---------------------------------------------------------------------*/
+;*    font ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'font
+   :options '(:size :face)
+   :before (lambda (n e)
+	     (let ((face (markup-option n :face))
+		   (size (lout-font-size (markup-option n :size))))
+	       (printf "\n~a @Font { " size)))
+   :after (lambda (n e)
+	    (display " }\n")))
+
+;*---------------------------------------------------------------------*/
+;*    flush ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'flush
+   :options '(:side)
+   :before (lambda (n e)
+	      (display "\n@LP")
+	      (case (markup-option n :side)
+		 ((center)
+		  (display "\n@Center { # flush-center\n"))
+		 ((left)
+		  (display "\n# flush-left\n"))
+		 ((right)
+		  (display (string-append "\n@Right "
+					  "{ rragged hyphen } @Break "
+					  "{ # flush-right\n")))))
+   :after (lambda (n e)
+	     (case (markup-option n :side)
+		((left)
+		 (display ""))
+		(else
+		 (display "\n}")))
+	     (display " # flush\n")))
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+   ;; Note: We prepend and append a newline in order to make sure
+   ;; things work as expected.
+   :before "\n@LP\n@Center {"
+   :after "}\n@LP\n")
+
+;*---------------------------------------------------------------------*/
+;*    pre ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'pre
+   :before "\n@LP lines @Break lout @Space { # pre\n"
+   :after "\n} # pre\n")
+
+;*---------------------------------------------------------------------*/
+;*    prog ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'prog
+   :options '(:line :mark)
+   :before "\nlines @Break lout @Space {\n"
+   :after "\n} # @Break\n")
+
+;*---------------------------------------------------------------------*/
+;*    &prog-line ...                                                   */
+;*---------------------------------------------------------------------*/
+;; Program lines appear within a `lines @Break' block.
+(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 (lambda (n e)
+	     (let ((symbol (markup-option n :symbol)))
+	       (if symbol
+		   (begin
+		     (display "\n@List style { ")
+		     (output symbol e)
+		     (display " } # itemize\n"))
+		   (display "\n@BulletList # itemize\n"))))
+   :after "\n@EndList\n")
+
+;*---------------------------------------------------------------------*/
+;*    enumerate ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'enumerate
+   :options '(:symbol)
+   :before (lambda (n e)
+	     (let ((symbol (markup-option n :symbol)))
+	       (if symbol
+		   (printf "\n@List style { ~a } # enumerate\n"
+			   symbol)
+		   (display "\n@NumberedList # enumerate\n"))))
+   :after "\n@EndList\n")
+
+;*---------------------------------------------------------------------*/
+;*    description ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'description
+   :options '(:symbol) ;; `symbol' doesn't make sense here
+   :before "\n@TaggedList # description\n"
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (let ((k (markup-option item :key)))
+			     (display "@DropTagItem { ")
+			     (for-each (lambda (i)
+					 (output i e)
+					 (display " "))
+				       (if (pair? k) k (list k)))
+			     (display " } { ")
+			     (output (markup-body item) e)
+			     (display " }\n")))
+			(markup-body n)))
+   :after "\n@EndList\n")
+
+;*---------------------------------------------------------------------*/
+;*    item ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'item
+   :options '(:key)
+   :before "\n@LI { "
+   :after  " }")
+
+;*---------------------------------------------------------------------*/
+;*    blockquote ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'blockquote
+   :before "\n@ID {"
+   :after  "\n} # @ID\n")
+
+;*---------------------------------------------------------------------*/
+;*    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 "\n@Figure\n")
+		 (display "  @Tag { ")
+		 (display (lout-tagify ident))
+		 (display " }\n")
+		 (printf  "  @BypassNumber { ~a }\n" number)
+		 (display "  @InitialLanguage { ")
+		 (display (engine-custom e 'initial-language))
+		 (display " }\n")
+
+		 (if legend
+		     (begin
+		       (lout-debug "figure: ~a, \"~a\"" ident legend)
+		       (printf  "  @Caption { ")
+		       (output legend e)
+		       (printf  " }\n")))
+		 (printf "  @Location { ~a }\n"
+			 (if mc? "PageTop" "ColTop"))
+		 (printf  "{\n")
+		 (output (markup-body n) e)))
+   :after (lambda (n e)
+	    (display "}\n")))
+
+
+;*---------------------------------------------------------------------*/
+;*    lout-table-column-number ...                                          */
+;*    -------------------------------------------------------------    */
+;*    This function computes how columns are contained by the table.   */
+;*---------------------------------------------------------------------*/
+(define (lout-table-column-number t)
+   (define (row-columns row)
+      (let loop ((cells (markup-body row))
+		 (nbcols 0))
+	 (if (null? cells)
+	     nbcols
+	     (loop (cdr cells)
+		   (+ nbcols (markup-option (car cells) :colspan))))))
+   (let loop ((rows (markup-body t))
+	      (nbcols 0))
+      (if (null? rows)
+	  nbcols
+	  (loop (cdr rows)
+		(max (row-columns (car rows)) nbcols)))))
+
+(define (lout-table-cell-indent align)
+  ;; Return the Lout name (a string) for cell alignment `align' (a symbol).
+  (case align
+    ((center #f #t) "ctr")
+    ((right)        "right")
+    ((left)         "left")
+    (else (skribe-error 'td align
+			"Unknown alignment type"))))
+
+(define (lout-table-cell-vindent align)
+  ;; Return the Lout name (a string) for cell alignment `align' (a symbol).
+  (case align
+    ((center #f #t) "ctr")
+    ((top)          "top")
+    ((bottom)       "foot")
+    (else (skribe-error 'td align
+			"Unknown alignment type"))))
+
+(define (lout-table-cell-vspan cell-letter row-vspan)
+   ;; Return the vspan information (an alist) for the cell whose
+   ;; letter is `cell-letter', within the row whose vspan information
+   ;; is given by `row-vspan'.  If the given cell doesn't span over
+   ;; rows, then #f is returned.
+   (and-let* ((as (assoc cell-letter row-vspan)))
+	     (cdr as)))
+
+(define (lout-table-cell-vspan-start? vspan-alist)
+   ;; For the cell whose vspan information is given by `vspan-alist',
+   ;; return #t if that cell starts spanning vertically.
+   (and vspan-alist
+	(cdr (assoc 'start? vspan-alist))))
+
+(define-macro (char+int c i)
+  `(integer->char (+ ,i (char->integer ,c))))
+
+(define-macro (-- i)
+  `(- ,i 1))
+
+
+(define (lout-table-cell-option-string cell)
+  ;; Return the Lout cell option string for `cell'.
+  (let ((align (markup-option cell :align))
+	(valign (markup-option cell :valign))
+	(width (markup-option cell :width))
+	(bg (markup-option cell :bg)))
+    (string-append (lout-table-cell-rules cell) " "
+		   (string-append
+		    "indent { "
+		    (lout-table-cell-indent align)
+		    " } ")
+		   (string-append
+		    "indentvertical { "
+		    (lout-table-cell-vindent valign)
+		    " } ")
+		   (if (not width) ""
+		       (string-append "width { "
+				      (lout-width width)
+				      " } "))
+		   (if (not bg) ""
+		       (string-append "paint { "
+				      (lout-color-specification bg)
+				      " } ")))))
+
+(define (lout-table-cell-format-string cell vspan-alist)
+  ;; Return a Lout cell format string for `cell'.  It uses the `&cell-name'
+  ;; markup option of its cell as its Lout cell name and `vspan-alist' as the
+  ;; source of information regarding its vertical spanning (#f means that
+  ;; `cell' is not vertically spanned).
+  (let ((cell-letter (markup-option cell '&cell-name))
+	(cell-options (lout-table-cell-option-string cell))
+	(colspan (if vspan-alist
+		     (cdr (assoc 'hspan vspan-alist))
+		     (markup-option cell :colspan)))
+	(vspan-start? (and vspan-alist
+			   (cdr (assoc 'start? vspan-alist)))))
+    (if (and (not vspan-start?) vspan-alist)
+	"@VSpan"
+	(let* ((cell-fmt (string-append "@Cell " cell-options
+					(string cell-letter))))
+	  (string-append
+	   (if (> colspan 1)
+	       (string-append (if (and vspan-start? vspan-alist)
+				  "@StartHVSpan " "@StartHSpan ")
+			      cell-fmt
+			      (let pool ((cnt (- colspan 1))
+					 (span-cells ""))
+				(if (= cnt 0)
+				    span-cells
+				    (pool (- cnt 1)
+					  (string-append span-cells
+							 " | @HSpan")))))
+	       (string-append (if (and vspan-alist vspan-start?)
+				  "@StartVSpan " "")
+			      cell-fmt)))))))
+
+
+(define (lout-table-row-format-string row)
+  ;; Return a Lout row format string for row `row'.  It uses the `&cell-name'
+  ;; markup option of its cell as its Lout cell name.
+
+  ;; FIXME: This function has become quite ugly
+  (let ((cells (markup-body row))
+	(row-vspan (markup-option row '&vspan-alist)))
+
+    (let loop ((cells cells)
+	       (cell-letter #\A)
+	       (delim "")
+	       (fmt ""))
+      (lout-debug "looping on cell ~a" cell-letter)
+
+      (if (null? cells)
+
+	  ;; The final `|' prevents the rightmost column to be
+	  ;; expanded to full page width (see sect. 6.11, p. 133).
+	  (if row-vspan
+	      ;; In the end, there can be vspan columns left so we need to
+	      ;; mark them
+	      (let final-loop ((cell-letter cell-letter)
+			       (fmt fmt))
+		(let* ((cell-vspan (lout-table-cell-vspan cell-letter
+							  row-vspan))
+		       (hspan (if cell-vspan
+				  (cdr (assoc 'hspan cell-vspan))
+				  1)))
+		  (lout-debug "final-loop: ~a ~a" cell-letter cell-vspan)
+		  (if (not cell-vspan)
+		      (string-append fmt " |")
+		      (final-loop (integer->char
+				   (+ hspan (char->integer cell-letter)))
+				  (string-append fmt " | @VSpan |")))))
+
+	      (string-append fmt " |"))
+
+	  (let* ((cell (car cells))
+		 (vspan-alist (lout-table-cell-vspan cell-letter row-vspan))
+		 (vspan-start? (lout-table-cell-vspan-start? vspan-alist))
+		 (colspan (if vspan-alist
+			      (cdr (assoc 'hspan vspan-alist))
+			      (markup-option cell :colspan)))
+		 (cell-format
+		  (lout-table-cell-format-string cell vspan-alist)))
+
+	    (loop (if (or (not vspan-alist) vspan-start?)
+		      (cdr cells)
+		      cells)  ;; don't skip pure vspan cells
+
+		  ;; next cell name
+		  (char+int cell-letter colspan)
+
+		  " | "  ;; the cell delimiter
+		  (string-append fmt delim cell-format)))))))
+
+
+
+;; A row vspan alist describes the cells of a row that span vertically
+;; and it looks like this:
+;;
+;;    ((#\A . ((start? . #t) (hspan . 1) (vspan . 3)))
+;;     (#\C . ((start? . #f) (hspan . 2) (vspan . 1))))
+;;
+;; which means that cell `A' start spanning vertically over three rows
+;; including this one, while cell `C' is an "empty" cell that continues
+;; the vertical spanning of a cell appearing on some previous row.
+;;
+;; The running "global" (or "table-wide") vspan alist looks the same
+;; except that it doesn't have the `start?' tags.
+
+(define (lout-table-compute-row-vspan-alist row global-vspan-alist)
+  ;; Compute the vspan alist of row `row' based on the current table vspan
+  ;; alist `global-vspan-alist'.  As a side effect, this function stores the
+  ;; Lout cell name (a character between #\A and #\Z) as the value of markup
+  ;; option `&cell-name' of each cell.
+  (if (pair? (markup-body row))
+      ;; Mark the first cell as such.
+      (markup-option-add! (car (markup-body row)) '&first-cell? #t))
+
+  (let cell-loop ((cells (markup-body row))
+		  (cell-letter #\A)
+		  (row-vspan-alist '()))
+    (lout-debug "cell: ~a ~a" cell-letter
+		(if (null? cells) '() (car cells)))
+
+    (if (null? cells)
+
+	;; In the end, we must retain any vspan cell that occurs after the
+	;; current cell name (note: we must add a `start?' tag at this point
+	;; since the global table vspan alist doesn't have that).
+	(let ((additional-cells (filter (lambda (c)
+					  (char>=? (car c) cell-letter))
+					global-vspan-alist)))
+	  (lout-debug "compute-row-vspan-alist returning: ~a + ~a (~a)"
+		      row-vspan-alist additional-cells
+		      (length global-vspan-alist))
+	  (append row-vspan-alist
+		  (map (lambda (c)
+			 `(,(car c) . ,(cons '(start? . #f) (cdr c))))
+		       additional-cells)))
+
+	(let* ((current-cell-vspan (assoc cell-letter global-vspan-alist))
+	       (hspan (if current-cell-vspan
+			  (cdr (assoc 'hspan (cdr current-cell-vspan)))
+			  (markup-option (car cells) :colspan))))
+
+	  (if (null? (cdr cells))
+	      ;; Mark the last cell as such
+	      (markup-option-add! (car cells) '&last-cell? #t))
+
+	  (cell-loop (if current-cell-vspan
+			 cells ;; this cell is vspanned, so don't skip it
+			 (cdr cells))
+
+		     ;; next cell name
+		     (char+int cell-letter (or hspan 1))
+
+		     (begin ;; updating the row vspan alist
+		       (lout-debug "cells: ~a" (length cells))
+		       (lout-debug "current-cell-vspan for ~a: ~a"
+				   cell-letter current-cell-vspan)
+
+		       (if current-cell-vspan
+
+			   ;; this cell is currently vspanned, ie. a previous
+			   ;; row defined a vspan for it and that it is still
+			   ;; spanning on this row
+			   (cons `(,cell-letter
+				   . ((start? . #f)
+				      (hspan  . ,(cdr
+						  (assoc
+						   'hspan
+						   (cdr current-cell-vspan))))))
+				 row-vspan-alist)
+
+			   ;; this cell is not currently vspanned
+			   (let ((vspan (markup-option (car cells) :rowspan)))
+			     (lout-debug "vspan-option for ~a: ~a"
+					 cell-letter vspan)
+
+			     (markup-option-add! (car cells)
+						 '&cell-name cell-letter)
+			     (if (and vspan (> vspan 1))
+				 (cons `(,cell-letter . ((start? . #t)
+							 (hspan . ,hspan)
+							 (vspan . ,vspan)))
+				       row-vspan-alist)
+				 row-vspan-alist)))))))))
+
+(define (lout-table-update-table-vspan-alist table-vspan-alist
+					     row-vspan-alist)
+  ;; Update `table-vspan-alist' based on `row-vspan-alist', the alist
+  ;; representing vspan cells for the last row that has been read."
+  (lout-debug "update-table-vspan: ~a and ~a"
+	      table-vspan-alist row-vspan-alist)
+
+  (let ((new-vspan-cells (filter (lambda (cell)
+				   (cdr (assoc 'start? (cdr cell))))
+				 row-vspan-alist)))
+
+    ;; Append the list of new vspan cells described in `row-vspan-alist'
+    (let loop ((cells (append table-vspan-alist new-vspan-cells))
+	       (result '()))
+      (if (null? cells)
+	  (begin
+	    (lout-debug "update-table-vspan returning: ~a" result)
+	    result)
+	  (let* ((cell (car cells))
+		 (cell-letter (car cell))
+		 (cell-hspan (cdr (assoc 'hspan (cdr cell))))
+		 (cell-vspan (-- (cdr (assoc 'vspan (cdr cell))))))
+	    (loop (cdr cells)
+		  (if (> cell-vspan 0)
+
+		      ;; Keep information about this vspanned cell
+		      (cons `(,cell-letter . ((hspan . ,cell-hspan)
+					      (vspan . ,cell-vspan)))
+			    result)
+
+		      ;; Vspan for this cell has been done so we can remove
+		      ;; it from the running table vspan alist
+		      result)))))))
+
+(define (lout-table-mark-vspan! tab)
+  ;; Traverse the rows of table `tab' and add them an `&vspan-alist' option
+  ;; that describes which of its cells are to be vertically spanned.
+  (let loop ((rows (markup-body tab))
+	     (global-vspan-alist '()))
+    (if (null? rows)
+
+	;; At this point, each row holds its own vspan information alist (the
+	;; `&vspan-alist' option) so we don't care anymore about the running
+	;; table vspan alist
+	#t
+
+	(let* ((row (car rows))
+	       (row-vspan-alist (lout-table-compute-row-vspan-alist
+				 row global-vspan-alist)))
+
+	  ;; Bind the row-specific vspan information to the row object
+	  (markup-option-add! row '&vspan-alist row-vspan-alist)
+
+	  (if (null? (cdr rows))
+	      ;; Mark the last row as such
+	      (markup-option-add! row '&last-row? #t))
+
+	  (loop (cdr rows)
+		(lout-table-update-table-vspan-alist global-vspan-alist
+						     row-vspan-alist))))))
+
+(define (lout-table-first-row? row)
+   (markup-option row '&first-row?))
+
+(define (lout-table-last-row? row)
+   (markup-option row '&last-row?))
+
+(define (lout-table-first-cell? cell)
+   (markup-option cell '&first-cell?))
+
+(define (lout-table-last-cell? cell)
+   (markup-option cell '&last-cell?))
+
+(define (lout-table-row-rules row)
+   ;; Return a string representing the Lout option string for
+   ;; displaying rules of `row'.
+   (let* ((table (ast-parent row))
+	  (frames (markup-option table :frame))
+	  (rules (markup-option table :rules))
+	  (first? (lout-table-first-row? row))
+	  (last? (lout-table-last-row? row)))
+      (string-append (if (and first?
+			      (member frames '(above hsides box border)))
+			 "ruleabove { yes } " "")
+		     (if (and last?
+			      (member frames '(below hsides box border)))
+			 "rulebelow { yes } " "")
+		     ;; rules
+		     (case rules
+			((header)
+			 ;; We consider the first row to be a header row.
+			 (if first? "rulebelow { yes }" ""))
+			((rows all)
+			 ;; We use redundant rules because coloring
+			 ;; might make them disappear otherwise.
+			 (string-append (if first? "" "ruleabove { yes } ")
+					(if last? "" "rulebelow { yes }")))
+			(else "")))))
+
+(define (lout-table-cell-rules cell)
+   ;; Return a string representing the Lout option string for
+   ;; displaying rules of `cell'.
+   (let* ((row (ast-parent cell))
+	  (table (ast-parent row))
+	  (frames (markup-option table :frame))
+	  (rules (markup-option table :rules))
+	  (first? (lout-table-first-cell? cell))
+	  (last? (lout-table-last-cell? cell)))
+      (string-append (if (and first?
+			      (member frames '(vsides lhs box border)))
+			 "ruleleft { yes } " "")
+		     (if (and last?
+			      (member frames '(vsides rhs box border)))
+			 "ruleright { yes } " "")
+		     ;; rules
+		     (case rules
+			((cols all)
+			 ;; We use redundant rules because coloring
+			 ;; might make them disappear otherwise.
+			 (string-append (if last? "" "ruleright { yes } ")
+					(if first? "" "ruleleft { yes }")))
+			(else "")))))
+
+;*---------------------------------------------------------------------*/
+;*    table ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'table
+   :options '(:frame :rules :border :width :cellpadding)
+   ;; XXX: `:cellstyle' `separate' and `:cellspacing' not supported
+   ;; by Lout's @Tbl.
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (border (markup-option n :border))
+		    (cp (markup-option n :cellpadding))
+		    (rows (markup-body n)))
+
+		 (define (cell-width row col)
+		    (let ((cells (markup-body row))
+			  (bg (markup-option row :bg)))
+		       (let loop ((cells cells)
+				  (c 0))
+			  (if (pair? cells)
+			      (let* ((ce (car cells))
+				     (width (markup-option ce :width))
+				     (colspan (markup-option ce :colspan)))
+				 (if (= col c)
+				     (if (number? width) width 0)
+				     (loop (cdr cells) (+ c colspan))))
+			      0))))
+
+		 (define (col-width col)
+		    (let loop ((rows rows)
+			       (width 0))
+		       (if (null? rows)
+			   (if (= width 0)
+			       0
+			       width)
+			   (loop (cdr rows)
+				 (max width (cell-width (car rows) col))))))
+
+		 (if (pair? (markup-body n))
+		     ;; Mark the first row as such
+		     (markup-option-add! (car (markup-body n))
+					 '&first-row? #t))
+
+		 ;; Mark each row with vertical spanning information
+		 (lout-table-mark-vspan! n)
+
+		 (display "\n@Tbl # table\n")
+
+		 (if (number? border)
+		     (printf "  rulewidth { ~a }\n"
+			     (lout-width (markup-option n :border))))
+		 (if (number? cp)
+		     (printf "  margin { ~ap }\n"
+			     (number->string cp)))
+
+		 (display "{\n")))
+
+   :after (lambda (n e)
+	    (let ((header-rows (or (markup-option n '&header-rows) 0)))
+	      ;; Issue an `@EndHeaderRow' symbol for each `@HeaderRow' symbol
+	      ;; previously produced.
+	      (let ((cnt header-rows))
+		(if (> cnt 0)
+		    (display "\n@EndHeaderRow"))))
+
+	    (display "\n} # @Tbl\n")))
+
+;*---------------------------------------------------------------------*/
+;*    'tr ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tr
+   :options '(:bg)
+   :action (lambda (row e)
+	     (let* ((bg (markup-option row :bg))
+		    (bg-color (if (not bg) ""
+				  (string-append
+				   "paint { "
+				   (lout-color-specification bg) " } ")))
+		    (first-row? (markup-option row '&first-row?))
+		    (header-row? (any (lambda (n)
+					(eq? (markup-option n 'markup)
+					     'th))
+				      (markup-body row)))
+		    (fmt (lout-table-row-format-string row))
+		    (rules (lout-table-row-rules row)))
+
+	       ;; Use `@FirstRow' and `@HeaderFirstRow' for the first
+	       ;; row.  `@HeaderFirstRow' seems to be buggy though.
+	       ;; (see section 6.1, p.119 of the User's Guide).
+
+	       (printf "\n@~aRow ~aformat { ~a }"
+		       (if first-row? "First" "")
+		       bg-color fmt)
+	       (display (string-append " " rules))
+	       (output (markup-body row) e)
+
+	       (if (and header-row? (engine-custom e 'use-header-rows?))
+		   ;; `@HeaderRow' symbols are not actually printed
+		   ;; (see section 6.11, p. 134 of the User's Guide)
+		   ;; FIXME:  This all seems buggy on the Lout side.
+		   (let* ((tab (ast-parent row))
+			  (hrows (and (markup? tab)
+				      (or (markup-option tab '&header-rows)
+					  0))))
+		     (if (not (is-markup? tab 'table))
+			 (skribe-error 'lout
+				       "tr's parent not a table!" tab))
+		     (markup-option-add! tab '&header-rows (+ hrows 1))
+		     (printf "\n@Header~aRow ~aformat { ~a }"
+			     ""   ; (if first-row? "First" "")
+			     bg-color fmt)
+		     (display (string-append " " rules))
+		     
+		     ;; the cells must be produced once here
+		     (output (markup-body row) e))))))
+
+;*---------------------------------------------------------------------*/
+;*    tc                                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tc
+   :options '(markup :width :align :valign :colspan :rowspan :bg)
+   :before (lambda (cell e)
+	     (printf "\n  ~a { " (markup-option cell '&cell-name)))
+   :after (lambda (cell e)
+	    (display " }")))
+
+
+;*---------------------------------------------------------------------*/
+;*    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 url ;; maybe we should run `wget' then?  :-)
+		    (skribe-error 'lout "Image URLs not supported" url))
+		(if (not (string? img))
+		    (skribe-error 'lout "Illegal image" file)
+		    (begin
+		      (if width
+			  (printf "\n~a @Wide" (lout-width width)))
+		      (if height
+			  (printf "\n~a @High" (lout-width height)))
+		      (if zoom
+			  (printf "\n~a @Scale" zoom))
+		      (printf "\n@IncludeGraphic { \"~a\" }\n" img))))))
+
+;*---------------------------------------------------------------------*/
+;*    Ornaments ...                                                    */
+;*---------------------------------------------------------------------*/
+;; Each ornament is enclosed in braces to allow such things as
+;; "he,(bold "ll")o" to work without adding an extra space.
+(markup-writer 'roman :before "{ @R { " :after " } }")
+(markup-writer 'underline :before  "{ @Underline { " :after " } }")
+(markup-writer 'code :before "{ @F { " :after " } }")
+(markup-writer 'var :before "{ @F { " :after " } }")
+(markup-writer 'sc :before "{ @S {" :after " } }")
+(markup-writer 'sf :before "{ { Helvetica Base } @Font { " :after " } }")
+(markup-writer 'sub :before "{ @Sub { " :after " } }")
+(markup-writer 'sup :before "{ @Sup { " :after " } }")
+(markup-writer 'tt :before "{ @F { " :after " } }")
+
+
+;; `(bold (it ...))' and `(it (bold ...))' should both lead to `@BI { ... }'
+;; instead of `@B { @I { ... } }' (which is different).
+;; Unfortunately, it is not possible to use `ast-parent' and
+;; `find1-up' to check whether `it' (resp. `bold') was invoked within
+;; a `bold' (resp. `it') markup, hence the `&italics' and `&bold'
+;; option trick.   FIXME:  This would be much more efficient if
+;; `ast-parent' would work as expected.
+
+(markup-writer 'it
+   :before (lambda (node engine)
+	      (let ((bold-children (search-down (lambda (n)
+						   (is-markup? n 'bold))
+						node)))
+		 (map (lambda (b)
+			 (markup-option-add! b '&italics #t))
+		      bold-children)
+		 (printf "{ ~a { "
+		      (if (markup-option node '&bold)
+			  "@BI" "@I"))))
+   :after " } }")
+
+(markup-writer 'emph
+   :before (lambda (n e)
+	      (invoke (writer-before (markup-writer-get 'it e))
+		      n e))
+   :after (lambda (n e)
+	     (invoke (writer-after (markup-writer-get 'it e))
+		     n e)))
+
+(markup-writer 'bold
+   :before (lambda (node engine)
+	      (let ((it-children (search-down (lambda (n)
+						 (or (is-markup? n 'it)
+						     (is-markup? n 'emph)))
+					      node)))
+		 (map (lambda (i)
+			 (markup-option-add! i '&bold #t))
+		      it-children)
+		 (printf "{ ~a { "
+			 (if (markup-option node '&italics)
+			     "@BI" "@B"))))
+   :after " } }")
+
+;*---------------------------------------------------------------------*/
+;*    q ... @label q@                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'q
+   :before "{ @Char guillemotleft }\" \""
+   :after "\" \"{ @Char guillemotright }")
+
+;*---------------------------------------------------------------------*/
+;*    mailto ... @label mailto@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+   :options '(:text)
+   :before " @I { "
+   :action (lambda (n e)
+	      (let ((text (markup-option n :text)))
+		 (output (or text (markup-body n)) e)))
+   :after " }")
+
+;*---------------------------------------------------------------------*/
+;*    mark ... @label mark@                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mark
+   :action (lambda (n e)
+	     (if (markup-ident n)
+		 (begin
+		   (display "{ @SkribeMark { ")
+		   (display (lout-tagify (markup-ident n)))
+		   (display " } }"))
+		 (skribe-error 'lout "mark: Node has no identifier" n))))
+
+(define (lout-page-of ident)
+  ;; Return a string for the `@PageOf' statement for `ident'.
+  (let ((tag (lout-tagify ident)))
+    (string-append ", { " tag " } @CrossLink { "
+		   "p. @PageOf { " tag " } }")))
+
+
+;*---------------------------------------------------------------------*/
+;*    ref ... @label ref@                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer 'ref
+   :options '(:text :chapter :section :subsection :subsubsection
+	      :figure :mark :handle :ident :page)
+   :action (lambda (n e)
+	     (let ((url (markup-option n :url))
+		   (text (markup-option n :text))
+		   (mark (markup-option n :mark))
+		   (handle (markup-option n :handle))
+		   (chapter (markup-option n :chapter))
+		   (section (markup-option n :section))
+		   (subsection (markup-option n :subsection))
+		   (subsubsection (markup-option n :subsubsection))
+		   (show-page-num? (markup-option n :page)))
+
+		;; A handle to the target is automagically passed
+		;; as the body of each `ref' instance (see `api.scm').
+		(let* ((target (handle-ast (markup-body n)))
+		       (ident (markup-ident target))
+		       (title (markup-option target :title))
+		       (number (markup-option target :number)))
+		   (lout-debug "ref: target=~a ident=~a" target ident)
+		   (if text (output text e))
+
+		   ;; Marks don't have a number
+		   (if (eq? (markup-markup target) 'mark)
+		       (printf (lout-page-of ident))
+		       (begin
+			  ;; Don't output a section/whatever number
+			  ;; when text is provided in order to be
+			  ;; consistent with the HTML back-end.
+			  ;; Sometimes (eg. for user-defined markups),
+			  ;; we don't even know how to reference them
+			  ;; anyway.
+			  (if (not text)
+			      (printf " @NumberOf { ~a }"
+				      (lout-tagify ident)))
+			  (if show-page-num?
+			      (printf (lout-page-of ident)))))))))
+
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e)
+	     (let ((entry (handle-ast (markup-body n))))
+	       (output (markup-option entry :title) e)))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref+ ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref+
+   ;; When several references are passed.  Strangely enough, the list of
+   ;; entries passed to this writer (as its body) contains both `bib-ref' and
+   ;; `bib-entry' objects, hence the `canonicalize-entry' function below.
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e)
+	     (let* ((entries (markup-body n))
+		    (canonicalize-entry (lambda (x)
+					  (cond
+					   ((is-markup? x 'bib-entry) x)
+					   ((is-markup? x 'bib-ref)
+					    (handle-ast (markup-body x)))
+					   (else
+					    (skribe-error
+					     'lout
+					     "bib-ref+: invalid entry type"
+					     x)))))
+		    (help-proc (lambda (proc)
+				 (lambda (e1 e2)
+				   (proc (canonicalize-entry e1)
+					 (canonicalize-entry e2)))))
+		    (sort-proc (engine-custom e 'bib-refs-sort-proc)))
+	       (let loop ((rs (if sort-proc
+				  (sort entries (help-proc sort-proc))
+				  entries)))
+		 (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 ((url (markup-option n :url))
+		   (text (markup-option n :text))
+		   (transform (engine-custom e 'transform-url-ref-proc)))
+	       (if (or (not transform)
+		       (markup-option n '&transformed))
+		   (begin
+		     (printf "{ \"~a\" @ExternalLink { " url)
+		     (if text ;; FIXME: Should be (not (string-index text #\space))
+			 (output text e)
+			 (let ((filter-url (make-string-replace
+					    `((#\/ "\"/\"&-")
+					      (#\. ".&-")
+					      (#\- "&-")
+					      (#\_ "_&-")
+					      ,@lout-verbatim-encoding
+					      (#\newline "")))))
+			   ;; Filter the URL in a way to give Lout hints on
+			   ;; where hyphenation should take place.
+			   (fprint (current-error-port) "Here!!!" filter-url)
+			   (display (filter-url url) e)))
+		     (printf " } }"))
+		   (begin
+		     (markup-option-add! n '&transformed #t)
+		     (output (transform n) e))))))
+
+;*---------------------------------------------------------------------*/
+;*    line-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+   :options '(:offset)
+   :before "{ @I {" ;; FIXME: Not tested
+   :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)
+	     ;; Compute the length (in characters) of the longest entry label
+	     ;; so that the label width of the list is adjusted.
+	     (let loop ((entries (markup-body n))
+			(label-width 0))
+	       (if (null? entries)
+		   (begin
+		     (display "\n# the-bibliography\n@LP\n")
+		     ;; usually, the tag with be something like "[7]", hence
+		     ;; the `+ 1' below (`[]' is narrower than 2f)
+		     (printf  "@TaggedList labelwidth { ~af }\n"
+			      (+ 1 label-width)))
+		   (loop (cdr entries)
+			 (let ((entry-length
+				(let liip ((e (car entries)))
+				  (cond
+				   ((markup? e)
+				    (cond ((is-markup? e '&bib-entry)
+					   (liip (markup-option e :title)))
+					  ((is-markup? e '&bib-entry-ident)
+					   (liip (markup-option e 'number)))
+					  (else
+					   (liip (markup-body e)))))
+				   ((string? e)
+				    (string-length e))
+				   ((number? e)
+				    (liip (number->string e)))
+				   ((list? e)
+				    (apply + (map liip e)))
+				   (else 0)))))
+; 			   (fprint (current-error-port)
+; 				   "node=" (car entries)
+; 				   " body=" (markup-body (car entries))
+; 				   " title=" (markup-option (car entries)
+; 							    :title)
+; 				   " len=" entry-length)
+			   (if (> label-width entry-length)
+			       label-width
+			       entry-length))))))
+   :after (lambda (n e)
+	     (display "\n@EndList # the-bibliography (end)\n")))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry
+   :options '(:title)
+   :before "@TagItem "
+   :action (lambda (n e)
+	     (display " { ")
+	     (output n e (markup-writer-get '&bib-entry-label e))
+	     (display " }  { ")
+	     (output n e (markup-writer-get '&bib-entry-body e))
+	     (display " }"))
+   :after "\n")
+
+;*---------------------------------------------------------------------*/
+;*    &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 (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 " \"[\""
+   :action (lambda (n e) (output (markup-option n :title) e))
+   :after "\"]\" ")
+
+;*---------------------------------------------------------------------*/
+;*    &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 { ") ;; FIXME:  Needs to be rewritten.
+	      (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 " }")
+	      (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-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-bracket ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-bracket
+   :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))))
+
+
+;*---------------------------------------------------------------------*/
+;*    Illustrations                                                    */
+;*---------------------------------------------------------------------*/
+(define (lout-illustration . args)
+  ;; Introduce a Lout illustration (such as a diagram) whose code is either
+  ;; the body of `lout-illustration' or the contents of `file'.  For engines
+  ;; other than Lout, an EPS file is produced and then converted if needed.
+  ;; The `:alt' option is equivalent to HTML's `alt' attribute for the `img'
+  ;; markup, i.e. it is passed as the body of the `image' markup for
+  ;; non-Lout back-ends.
+
+  (define (file-contents file)
+    ;; Return the contents (a string) of file `file'.
+    (with-input-from-file file
+      (lambda ()
+	(let loop ((contents "")
+		   (line (read-line)))
+	  (if (eof-object? line)
+	      contents
+	      (loop (string-append contents line "\n")
+		    (read-line)))))))
+
+  (define (illustration-header)
+    ;; Return a string denoting the header of a Lout illustration.
+    (let ((lout (find-engine 'lout)))
+      (string-append "@SysInclude { picture }\n"
+		     (engine-custom lout 'includes)
+		     "\n\n@Illustration\n"
+		     "  @InitialFont { "
+		     (engine-custom lout 'initial-font)
+		     " }\n"
+		     "  @InitialBreak { "
+		     (engine-custom lout 'initial-break)
+		     " }\n"
+		     "  @InitialLanguage { "
+		     (engine-custom lout 'initial-language)
+		     " }\n"
+		     "  @InitialSpace { tex }\n"
+		     "{\n")))
+
+  (define (illustration-ending)
+    ;; Return a string denoting the end of a Lout illustration.
+    "\n}\n")
+
+  (let* ((opts (the-options args '(file ident alt)))
+	 (file* (assoc ':file opts))
+	 (ident* (assoc ':ident opts))
+	 (alt* (assoc ':alt opts))
+	 (file (and file* (cadr file*)))
+	 (ident (and ident* (cadr ident*)))
+	 (alt (or (and alt* (cadr alt*)) "An illustration")))
+
+    (let ((contents (if (not file)
+			(car (the-body args))
+			(file-contents file))))
+      (if (engine-format? "lout")
+	  (! contents) ;; simply inline the illustration
+	  (cond-expand
+	   (bigloo
+	    (let* ((lout (find-engine 'lout))
+		   (output (string-append (or ident
+					      (symbol->string
+					       (gensym 'lout-illustration)))
+					  ".eps"))
+		   (proc (run-process (or (engine-custom lout
+							 'lout-program-name)
+					  "lout")
+				      "-o" output
+				      "-EPS"
+				      input: pipe:))
+		   (port (process-input-port proc)))
+
+	      ;; send the illustration to Lout's standard input
+	      (display (illustration-header) port)
+	      (display contents port)
+	      (display (illustration-ending) port)
+	      (close-output-port port)
+
+	      (process-wait proc)
+	      (if (not (= 0 (process-exit-status proc)))
+		  (skribe-error 'lout-illustration
+				"lout exited with error code"
+				(process-exit-status proc)))
+	      (if (not (file-exists? output))
+		  (skribe-error 'lout-illustration "file not created"
+				output))
+	      (if (= 0 (file-size output))
+		  (skribe-error 'lout-illustration
+				"empty output file" output))
+
+	      ;; the image
+	      (image :file output alt)))
+
+	   (else ;; Unfortunately, chances are low that STklos has the same
+	         ;; process API as the one Bigloo has.
+	    (skribe-error 'lout
+			  "lout-illustration: Not implemented" file)))))))
+
+
+;*---------------------------------------------------------------------*/
+;*    Slides                                                           */
+;*                                                                     */
+;* At some point, this should move to `slide.skr'.                     */
+;*---------------------------------------------------------------------*/
+; (skribe-load "slide.skr")
+
+; (markup-writer 'slide
+;    ;; FIXME:  In `slide.skr', `:ident' is systematically generated.
+;    :options '(:title :number :toc :ident) ;; '(:bg :vspace :image)
+
+;    :validate (lambda (n e)
+; 		(eq? (engine-custom e 'document-type) 'slides))
+
+;    :before (lambda (n e)
+; 	      (display "\n@Overhead\n")
+; 	      (display "  @Title { ")
+; 	      (output (markup-option n :title) e)
+; 	      (display " }\n")
+; 	      (if (markup-ident n)
+; 		  (begin
+; 		     (display "  @Tag { ")
+; 		     (display (lout-tagify (markup-ident n)))
+; 		     (display " }\n")))
+; 	      (if (markup-option n :number)
+; 		  (begin
+; 		     (display "  @BypassNumber { ")
+; 		     (output (markup-option n :number) e)
+; 		     (display " }\n")))
+; 	      (display "@Begin\n")
+
+; 	      ;; `doc' documents produce their PDF outline right after
+; 	      ;; `@Text @Begin'; other types of documents must produce it
+; 	      ;; as part of their first chapter.
+; 	      (lout-output-pdf-meta-info (ast-document n) e))
+
+;    :after "@End @Overhead\n")
+
+; (markup-writer 'slide-vspace
+;    :options '(:unit)
+;    :validate (lambda (n e)
+; 		(and (pair? (markup-body n))
+; 		     (number? (car (markup-body n)))))
+;    :action (lambda (n e)
+; 	      (printf "\n//~a~a # slide-vspace\n"
+; 		      (car (markup-body n))
+; 		      (case (markup-option n :unit)
+; 			 ((cm)              "c")
+; 			 ((point points pt) "p")
+; 			 ((inch inches)     "i")
+; 			 (else
+; 			  (skribe-error 'lout
+; 					"Unknown vspace unit"
+; 					(markup-option n :unit)))))))
+
+; (markup-writer 'slide-pause
+;    ;; FIXME:  Use a `pdfmark' custom action and a PDF transition action.
+;    ;; << /Type /Action
+;    ;; << /S /Trans
+;    ;; entry in the trans dict
+;    ;; << /Type /Trans  /S /Dissolve >>
+;    :action (lambda (n e)
+; 	     (let ((filter (make-string-replace lout-verbatim-encoding))
+; 		   (pdfmark "
+; [ {ThisPage} << /Trans << /S /Wipe /Dm /V /D 3 /M /O >> >> /PUT pdfmark"))
+;                (display (lout-embedded-postscript-code
+;                          (filter pdfmark))))))
+
+; ;; For movies, see
+; ;; http://www.tug.org/tex-archive/macros/latex/contrib/movie15/movie15.sty .
+; (markup-writer 'slide-embed
+;    :options '(:alt :geometry :rgeometry :geometry-opt :command)
+;    ;; FIXME:  `pdfmark'.
+;    ;; << /Type /Action   /S /Launch
+;    :action (lambda (n e)
+; 	     (let ((command (markup-option n :command))
+; 		   (filter (make-string-replace lout-verbatim-encoding))
+; 		   (pdfmark "[ /Rect [ 0 ysize xsize 0 ]
+;   /Name /Comment
+;   /Contents (This is an embedded application)
+;   /ANN pdfmark
+
+; [ /Type /Action
+;   /S    /Launch
+;   /F    (~a)
+;   /OBJ pdfmark"))
+; 	     (display (string-append
+; 		       "4c @Wide 3c @High "
+; 		       (lout-embedded-postscript-code
+; 			(filter (format #f pdfmark command))))))))
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
+
+
+;; Local Variables: --
+;; mode: Scheme --
+;; coding: latin-1 --
+;; scheme-program-name: "guile" --
+;; End: --
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index ef8ef8d..aaf1a8f 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -194,8 +194,9 @@
 ;;;
 (define (%skribe-warn level file line lst)
   (let ((port (current-error-port)))
-    (format port "**** WARNING:\n")
-    (when (and file line) (format port "~a: ~a: " file line))
+    (when (and file line)
+      (format port "~a:~a: " file line))
+    (format port "warning: ")
     (for-each (lambda (x) (format port "~a " x)) lst)
     (newline port)))
 
@@ -346,7 +347,7 @@
 (define hashtable-put!		hash-set!)
 (define hashtable-update!	hash-set!)
 (define hashtable->list	(lambda (h)
-                          (map cdr (hash-table->list h))))
+                          (map cdr (hash-map->list cons h))))
 
 (define find-runtime-type	(lambda (obj) obj))
 
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index 854c50d..1a8f622 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -44,6 +44,8 @@
     ;(srfi srfi-19)        ;; date and time
     (oop goops)           ;; `make'
     (ice-9 optargs)       ;; `define*'
+    (ice-9 and-let-star)  ;; `and-let*'
+    (ice-9 receive)       ;; `receive'
 
     (skribilo module)
     (skribilo types)      ;; `<document>', `document?', etc.
@@ -56,7 +58,9 @@
     (skribilo engine)
     (skribilo writer)
     (skribilo output)
-    (skribilo evaluator)))
+    (skribilo evaluator)
+    (skribilo color)
+    (skribilo debug)))
 
 (define *skribe-core-modules*
   '("utils" "api" "bib" "index" "param" "sui"))
diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm
index 1f411dc..03e515c 100644
--- a/src/guile/skribilo/runtime.scm
+++ b/src/guile/skribilo/runtime.scm
@@ -25,9 +25,10 @@
 ;;;
 
 (define-module (skribilo runtime)
+  ;; FIXME:  Useful procedures are scattered between here and
+  ;;         `(skribilo skribe utils)'.
   :export (;; Utilities
 	   strip-ref-base ast->file-location string-canonicalize
-	   the-options the-body
 
 	   ;; Markup functions
 	   markup-option markup-option-add! markup-output
@@ -42,7 +43,10 @@
 	   make-string-replace
 
 	   ;; AST
-	   ast->string))
+	   ast-parent ast->string
+	   markup-parent markup-document markup-chapter
+
+	   handle-body))
 
 (use-modules (skribilo debug)
 	     (skribilo types)
@@ -51,6 +55,7 @@
 	     (skribilo output)
 	     (skribilo evaluator)
 	     (skribilo vars)
+	     (skribilo lib)
 	     (srfi srfi-13)
 	     (oop goops))
 
@@ -201,7 +206,7 @@
   (let ((path (search-path (skribe-image-path) file)))
     (if (not path)
 	(skribe-error 'convert-image
-		      (format "Can't find `~a' image file in path: " file)
+		      (format #f "can't find `~a' image file in path: " file)
 		      (skribe-image-path))
 	(let ((suf (suffix file)))
 	  (if (member suf formats)
@@ -224,6 +229,7 @@
 			   p
 			   (loop (cdr fmts)))))))))))
 
+
 ;;; ======================================================================
 ;;;
 ;;;			S T R I N G - W R I T I N G
@@ -316,7 +322,7 @@
 
 
 
-
+
 ;;; ======================================================================
 ;;;
 ;;;				    A S T
@@ -346,120 +352,53 @@
   (ast->string (slot-ref ast 'body)))
 
 
-;;NEW ;;
-;;NEW ;; AST-PARENT
-;;NEW ;;
-;;NEW (define (ast-parent n)
-;;NEW   (slot-ref n 'parent))
-;;NEW
-;;NEW ;;
-;;NEW ;; MARKUP-PARENT
-;;NEW ;;
-;;NEW (define (markup-parent m)
-;;NEW   (let ((p (slot-ref m 'parent)))
-;;NEW     (if (eq? p 'unspecified)
-;;NEW	(skribe-error 'markup-parent "Unresolved parent reference" m)
-;;NEW	p)))
-;;NEW
-;;NEW
-;;NEW ;;
-;;NEW ;; MARKUP-DOCUMENT
-;;NEW ;;
-;;NEW (define (markup-document m)
-;;NEW   (let Loop ((p m)
-;;NEW	     (l #f))
-;;NEW     (cond
-;;NEW       ((is-markup? p 'document)           p)
-;;NEW       ((or (eq? p 'unspecified) (not p))  l)
-;;NEW       (else			          (Loop (slot-ref p 'parent) p)))))
-;;NEW
-;;NEW ;;
-;;NEW ;; MARKUP-CHAPTER
-;;NEW ;;
-;;NEW (define (markup-chapter m)
-;;NEW   (let loop ((p m)
-;;NEW	     (l #f))
-;;NEW     (cond
-;;NEW       ((is-markup? p 'chapter)           p)
-;;NEW       ((or (eq? p 'unspecified) (not p)) l)
-;;NEW       (else				 (loop (slot-ref p 'parent) p)))))
-;;NEW
-;;NEW
-;;NEW ;;;; ======================================================================
-;;NEW ;;;;
-;;NEW ;;;;				H A N D L E S
-;;NEW ;;;;
-;;NEW ;;;; ======================================================================
-;;NEW (define (handle-body h)
-;;NEW   (slot-ref h 'body))
-;;NEW
-;;NEW
-;;NEW ;;;; ======================================================================
-;;NEW ;;;;
-;;NEW ;;;;				F I N D
-;;NEW ;;;;
-;;NEW ;;;; ======================================================================
-;;NEW (define (find pred obj)
-;;NEW   (with-debug 4 'find
-;;NEW     (debug-item "obj=" obj)
-;;NEW     (let loop ((obj (if (is-a? obj <container>) (container-body obj) obj)))
-;;NEW       (cond
-;;NEW	((pair? obj)
-;;NEW	 (apply append (map (lambda (o) (loop o)) obj)))
-;;NEW	((is-a? obj <container>)
-;;NEW	 (debug-item "loop=" obj " " (slot-ref obj 'ident))
-;;NEW	 (if (pred obj)
-;;NEW	     (list (cons obj (loop (container-body obj))))
-;;NEW	     '()))
-;;NEW	(else
-;;NEW	 (if (pred obj)
-;;NEW	     (list obj)
-;;NEW	     '()))))))
-;;NEW
+
+;;
+;; AST-PARENT
+;;
+(define (ast-parent n)
+  (slot-ref n 'parent))
+
+;;
+;; MARKUP-PARENT
+;;
+(define (markup-parent m)
+  (let ((p (slot-ref m 'parent)))
+    (if (eq? p 'unspecified)
+	(skribe-error 'markup-parent "Unresolved parent reference" m)
+	p)))
+
+
+;;
+;; MARKUP-DOCUMENT
+;;
+(define (markup-document m)
+  (let Loop ((p m)
+	     (l #f))
+    (cond
+      ((is-markup? p 'document)           p)
+      ((or (eq? p 'unspecified) (not p))  l)
+      (else			          (Loop (slot-ref p 'parent) p)))))
+
+;;
+;;
+;; MARKUP-CHAPTER
+;;
+(define (markup-chapter m)
+  (let loop ((p m)
+	     (l #f))
+    (cond
+      ((is-markup? p 'chapter)           p)
+      ((or (eq? p 'unspecified) (not p)) l)
+      (else				 (loop (slot-ref p 'parent) p)))))
+
 
 
 ;;;; ======================================================================
 ;;;;
-;;;;		M A R K U P   A R G U M E N T   P A R S I N G
+;;;;				H A N D L E S
 ;;;;
 ;;;; ======================================================================
-(define (the-body opt)
-  ;; Filter out the options
-  (let loop ((opt* opt)
-	     (res '()))
-    (cond
-     ((null? opt*)
-      (reverse! res))
-     ((not (pair? opt*))
-      (skribe-error 'the-body "Illegal body" opt))
-     ((keyword? (car opt*))
-      (if (null? (cdr opt*))
-	  (skribe-error 'the-body "Illegal option" (car opt*))
-	  (loop (cddr opt*) res)))
-     (else
-      (loop (cdr opt*) (cons (car opt*) res))))))
-
-
-
-(define (the-options opt+ . out)
-  ;; Returns an list made of options.The OUT argument contains
-  ;; keywords that are filtered out.
-  (let loop ((opt* opt+)
-	     (res '()))
-    (cond
-     ((null? opt*)
-      (reverse! res))
-     ((not (pair? opt*))
-      (skribe-error 'the-options "Illegal options" opt*))
-     ((keyword? (car opt*))
-      (cond
-       ((null? (cdr opt*))
-	(skribe-error 'the-options "Illegal option" (car opt*)))
-       ((memq (car opt*) out)
-	(loop (cdr opt*) res))
-       (else
-	(loop (cdr opt*)
-	      (cons (list (car opt*) (cadr opt*)) res)))))
-     (else
-      (loop (cdr opt*) res)))))
+(define (handle-body h)
+  (slot-ref h 'body))
 
diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/skribe/api.scm
index e7ba4a6..d66b3b4 100644
--- a/src/guile/skribilo/skribe/api.scm
+++ b/src/guile/skribilo/skribe/api.scm
@@ -40,6 +40,7 @@
           (gensym-orig (cond ((symbol? obj) (symbol->string obj))
                              (else obj))))))
 
+
 ;*---------------------------------------------------------------------*/
 ;*    include ...                                                      */
 ;*---------------------------------------------------------------------*/
@@ -253,7 +254,6 @@
 ;*    paragraph ...                                                    */
 ;*---------------------------------------------------------------------*/
 (define-simple-markup paragraph)
-(define-public p      paragraph)
 
 ;*---------------------------------------------------------------------*/
 ;*    footnote ...                                                     */
@@ -464,7 +464,7 @@
 	 ((and (integer? start) (integer? stop) (> start stop))
 	  (skribe-error 'source
 			"start line > stop line"
-			(format "~a/~a" start stop)))
+			(format #f "~a/~a" start stop)))
 	 ((and language (not (language? language)))
 	  (skribe-error 'source "Illegal language" language))
 	 ((and tab (not (integer? tab)))
@@ -553,7 +553,7 @@
 		 (if (not (is-markup? r markup))
 		     (skribe-warning 2
 				     for
-				     (format "Illegal `~a' element, `~a' expected"
+				     (format #f "illegal `~a' element, `~a' expected"
 					     (if (markup? r)
 						 (markup-markup r)
 						 (find-runtime-type r))
@@ -643,17 +643,17 @@
       (cond
 	 ((and frame (not (memq frame frame-vals)))
 	  (skribe-error 'table
-			(format "frame should be one of \"~a\"" frame-vals)
+			(format #f "frame should be one of \"~a\"" frame-vals)
 			frame))
 	 ((and rules (not (memq rules rules-vals)))
 	  (skribe-error 'table
-			(format "rules should be one of \"~a\"" rules-vals)
+			(format #f "rules should be one of \"~a\"" rules-vals)
 			rules))
 	 ((not (or (memq cellstyle cells-vals)
 		   (string? cellstyle)
 		   (number? cellstyle)))
 	  (skribe-error 'table
-			(format "cellstyle should be one of \"~a\", or a number, or a string" cells-vals)
+			(format #f "cellstyle should be one of \"~a\", or a number, or a string" cells-vals)
 			cellstyle))
 	 (else
 	  (new container
@@ -689,7 +689,7 @@
 		   #!key
 		   (ident #f) (class #f)
 		   (width #f) (align 'center) (valign #f)
-		   (colspan 1) (bg #f))
+		   (colspan 1) (rowspan 1) (bg #f))
    (let ((align (if (string? align)
 		    (string->symbol align)
 		    align))
@@ -735,7 +735,7 @@
 		   #!key
 		   (ident #f) (class #f)
 		   (width #f) (align 'center) (valign #f)
-		   (colspan 1) (bg #f))
+		   (colspan 1) (rowspan 1) (bg #f))
    (apply tc 'th opts))
 
 ;*---------------------------------------------------------------------*/
@@ -746,7 +746,7 @@
 		   #!key
 		   (ident #f) (class #f)
 		   (width #f) (align 'center) (valign #f)
-		   (colspan 1) (bg #f))
+		   (colspan 1) (rowspan 1) (bg #f))
    (apply tc 'td opts))
 
 ;*---------------------------------------------------------------------*/
@@ -818,19 +818,20 @@
 ;*---------------------------------------------------------------------*/
 ;*    symbol ...                                                       */
 ;*---------------------------------------------------------------------*/
-(define-markup (symbol symbol)
-   (let ((v (cond
-	       ((symbol? symbol)
-		(symbol->string symbol))
-	       ((string? symbol)
-		symbol)
-	       (else
-		(skribe-error 'symbol
-			      "Illegal argument (symbol expected)"
-			      symbol)))))
-      (new markup
-	 (markup 'symbol)
-	 (body v))))
+(set! symbol
+      (lambda (symbol)
+	(let ((v (cond
+		  ((symbol? symbol)
+		   (symbol->string symbol))
+		  ((string? symbol)
+		   symbol)
+		  (else
+		   (skribe-error 'symbol
+				 "Illegal argument (symbol expected)"
+				 symbol)))))
+	  (new markup
+	       (markup 'symbol)
+	       (body v)))))
 
 ;*---------------------------------------------------------------------*/
 ;*    ! ...                                                            */
@@ -972,7 +973,7 @@
 		    (skribe #f)
 		    (page #f))
    (define (unref ast text kind)
-      (let ((msg (format "Can't find `~a': " kind)))
+      (let ((msg (format #f "can't find `~a': " kind)))
 	 (if (ast? ast)
 	     (begin
 		(skribe-warning/ast 1 ast 'ref msg text)
@@ -1259,3 +1260,73 @@
 					 char-offset
 					 header-limit
 					 column))))))))
+
+
+;;; This part comes from the file `skribe.skr' in the original Skribe
+;;; distribution.
+
+;*---------------------------------------------------------------------*/
+;*    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-public (fg c . body)
+   (color :fg c body))
+
+;*---------------------------------------------------------------------*/
+;*    bg ...                                                           */
+;*---------------------------------------------------------------------*/
+(define-public (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/src/guile/skribilo/skribe/bib.scm b/src/guile/skribilo/skribe/bib.scm
index 2ec5c0b..0a80ec9 100644
--- a/src/guile/skribilo/skribe/bib.scm
+++ b/src/guile/skribilo/skribe/bib.scm
@@ -35,7 +35,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    bib-load! ...                                                    */
 ;*---------------------------------------------------------------------*/
-(define (bib-load! table filename command)
+(define-public (bib-load! table filename command)
    (if (not (bib-table? table))
        (skribe-error 'bib-load "Illegal bibliography table" table)
        ;; read the file
@@ -49,7 +49,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    resolve-bib ...                                                  */
 ;*---------------------------------------------------------------------*/
-(define (resolve-bib table ident)
+(define-public (resolve-bib table ident)
    (if (not (bib-table? table))
        (skribe-error 'resolve-bib "Illegal bibliography table" table)
        (let* ((i (cond
@@ -64,7 +64,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    make-bib-entry ...                                               */
 ;*---------------------------------------------------------------------*/
-(define (make-bib-entry kind ident fields from)
+(define-public (make-bib-entry kind ident fields from)
    (let* ((m (new markup
 		(markup '&bib-entry)
 		(ident ident)
@@ -91,7 +91,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    bib-sort/authors ...                                             */
 ;*---------------------------------------------------------------------*/
-(define (bib-sort/authors l)
+(define-public (bib-sort/authors l)
    (define (cmp i1 i2 def)
       (cond
 	 ((and (markup? i1) (markup? i2))
@@ -128,13 +128,13 @@
 ;*---------------------------------------------------------------------*/
 ;*    bib-sort/idents ...                                              */
 ;*---------------------------------------------------------------------*/
-(define (bib-sort/idents l)
+(define-public (bib-sort/idents l)
    (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f)))))
 
 ;*---------------------------------------------------------------------*/
 ;*    bib-sort/dates ...                                               */
 ;*---------------------------------------------------------------------*/
-(define (bib-sort/dates l)
+(define-public (bib-sort/dates l)
    (sort l (lambda (p1 p2)
 	      (define (month-num m)
 		 (let ((body (markup-body m)))
@@ -182,7 +182,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    resolve-the-bib ...                                              */
 ;*---------------------------------------------------------------------*/
-(define (resolve-the-bib table n sort pred count opts)
+(define-public (resolve-the-bib table n sort pred count opts)
    (define (count! entries)
       (let loop ((es entries)
 		 (i 1))
diff --git a/src/guile/skribilo/skribe/utils.scm b/src/guile/skribilo/skribe/utils.scm
index b2a5cfb..9aaa81f 100644
--- a/src/guile/skribilo/skribe/utils.scm
+++ b/src/guile/skribilo/skribe/utils.scm
@@ -19,8 +19,7 @@
 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 ;;; USA.
 
-(define-skribe-module (skribilo skribe utils)
-  #:export (ast-document))
+(define-skribe-module (skribilo skribe utils))
 
 ;;; Author:  Manuel Serrano
 ;;; Commentary:
@@ -36,7 +35,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    engine-custom-add! ...                                           */
 ;*---------------------------------------------------------------------*/
-(define (engine-custom-add! e id val)
+(define-public (engine-custom-add! e id val)
    (let ((old (engine-custom e id)))
       (if (unspecified? old)
 	  (engine-custom-set! e id (list val))
@@ -45,7 +44,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    find-markup-ident ...                                            */
 ;*---------------------------------------------------------------------*/
-(define (find-markup-ident ident)
+(define-public (find-markup-ident ident)
    (let ((r (find-markups ident)))
       (if (or (pair? r) (null? r))
 	  r
@@ -54,7 +53,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    container-search-down ...                                        */
 ;*---------------------------------------------------------------------*/
-(define (container-search-down pred obj)
+(define-public (container-search-down pred obj)
    (with-debug 4 'container-search-down
       (debug-item "obj=" (find-runtime-type obj))
       (let loop ((obj (markup-body obj)))
@@ -74,7 +73,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    search-down ...                                                  */
 ;*---------------------------------------------------------------------*/
-(define (search-down pred obj)
+(define-public (search-down pred obj)
    (with-debug 4 'search-down
       (debug-item "obj=" (find-runtime-type obj))
       (let loop ((obj (markup-body obj)))
@@ -94,7 +93,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    find-down ...                                                    */
 ;*---------------------------------------------------------------------*/
-(define (find-down pred obj)
+(define-public (find-down pred obj)
    (with-debug 4 'find-down
       (debug-item "obj=" (find-runtime-type obj))
       (let loop ((obj obj))
@@ -115,7 +114,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    find1-down ...                                                   */
 ;*---------------------------------------------------------------------*/
-(define (find1-down pred obj)
+(define-public (find1-down pred obj)
    (with-debug 4 'find1-down
       (let loop ((obj obj)
 		 (stack '()))
@@ -143,7 +142,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    find-up ...                                                      */
 ;*---------------------------------------------------------------------*/
-(define (find-up pred obj)
+(define-public (find-up pred obj)
    (let loop ((obj obj)
 	      (res '()))
       (cond
@@ -157,7 +156,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    find1-up ...                                                     */
 ;*---------------------------------------------------------------------*/
-(define (find1-up pred obj)
+(define-public (find1-up pred obj)
    (let loop ((obj obj))
       (cond
 	 ((not (ast? obj))
@@ -170,19 +169,19 @@
 ;*---------------------------------------------------------------------*/
 ;*    ast-document ...                                                 */
 ;*---------------------------------------------------------------------*/
-(define (ast-document m)
+(define-public (ast-document m)
    (find1-up document? m))
 
 ;*---------------------------------------------------------------------*/
 ;*    ast-chapter ...                                                  */
 ;*---------------------------------------------------------------------*/
-(define (ast-chapter m)
+(define-public (ast-chapter m)
    (find1-up (lambda (n) (is-markup? n 'chapter)) m))
 
 ;*---------------------------------------------------------------------*/
 ;*    ast-section ...                                                  */
 ;*---------------------------------------------------------------------*/
-(define (ast-section m)
+(define-public (ast-section m)
    (find1-up (lambda (n) (is-markup? n 'section)) m))
 
 ;*---------------------------------------------------------------------*/
@@ -190,7 +189,7 @@
 ;*    -------------------------------------------------------------    */
 ;*    Filter out the options                                           */
 ;*---------------------------------------------------------------------*/
-(define (the-body opt+)
+(define-public (the-body opt+)
    (let loop ((opt* opt+)
 	      (res '()))
       (cond
@@ -211,7 +210,7 @@
 ;*    Returns an list made of options. The OUT argument contains       */
 ;*    keywords that are filtered out.                                  */
 ;*---------------------------------------------------------------------*/
-(define (the-options opt+ . out)
+(define-public (the-options opt+ . out)
    (let loop ((opt* opt+)
 	      (res '()))
       (cond
@@ -234,7 +233,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    list-split ...                                                   */
 ;*---------------------------------------------------------------------*/
-(define (list-split l num . fill)
+(define-public (list-split l num . fill)
    (let loop ((l l)
 	      (i 0)
 	      (acc '())
diff --git a/src/guile/skribilo/types.scm b/src/guile/skribilo/types.scm
index 0893587..8d51c8c 100644
--- a/src/guile/skribilo/types.scm
+++ b/src/guile/skribilo/types.scm
@@ -34,7 +34,7 @@
 	    <engine> engine? engine-ident engine-format engine-customs
 		     engine-filter engine-symbol-table
 	    <writer> writer? write-object writer-options writer-ident
-	             writer-before writer-action writer-after
+	             writer-before writer-action writer-after writer-class
 	    <processor> processor? processor-combinator processor-engine
 	    <markup> markup? bind-markup! markup-options is-markup?
 		     markup-markup markup-body markup-ident markup-class
diff --git a/src/guile/skribilo/vars.scm b/src/guile/skribilo/vars.scm
index 7e75e0f..4877e78 100644
--- a/src/guile/skribilo/vars.scm
+++ b/src/guile/skribilo/vars.scm
@@ -21,8 +21,7 @@
 ;;; USA.
 
 
-(define-module (skribilo vars)
-  #:use-module (srfi srfi-17))
+(define-module (skribilo vars))
 
 ;;;
 ;;; Switches
@@ -31,10 +30,6 @@
 (define-public *skribe-warning*	5)
 (define-public *load-rc*		#t)
 
-(define-public skribe-debug
-  (let ((level 0))
-    (getter-with-setter (lambda () level)
-			(lambda (val) (set! level val)))))
 
 ;;;
 ;;; PATH variables
diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm
index 1ff0b5b..0f9e053 100644
--- a/src/guile/skribilo/verify.scm
+++ b/src/guile/skribilo/verify.scm
@@ -28,9 +28,9 @@
    :export (verify))
 
 (use-modules (skribilo debug)
-;	     (skribilo engine)
+	     (skribilo engine)
 	     (skribilo writer)
-;	     (skribilo runtime)
+	     (skribilo runtime)
 	     (skribilo types)
 	     (skribilo lib)     ;; `when', `unless'
 	     (oop goops))
@@ -53,7 +53,7 @@
 	  (for-each (lambda (o)
 		      (if (not (memq o options))
 			  (skribe-error (engine-ident engine)
-					(format "Option unsupported: ~a, supported options: ~a" o options)
+					(format #f "option unsupported: ~a, supported options: ~a" o options)
 					markup)))
 		    required-options)
 	  (slot-set! writer 'verified? #t)))))
@@ -79,7 +79,7 @@
 		       3
 		       markup
 		       'verify
-		       (format "Engine ~a does not support markup ~a option `~a' -- ~a"
+		       (format #f "engine ~a does not support markup ~a option `~a' -- ~a"
 			       (engine-ident engine)
 			       (markup-markup markup)
 			       o
@@ -140,7 +140,7 @@
 	       (skribe-warning
 		     1
 		     node
-		     (format "Node `~a' forbidden here by ~a engine"
+		     (format #f "node `~a' forbidden here by ~a engine"
 			     (markup-markup node)
 			     (engine-ident e))))))))
      node))
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
index eeefe8b..abfb10c 100644
--- a/src/guile/skribilo/writer.scm
+++ b/src/guile/skribilo/writer.scm
@@ -139,8 +139,9 @@
   ;;; will consider the value of ENGINE to be the first keyword found.
 
 ;  (let ((e (or engine (default-engine))))
-  (let ((e (or (and (list? engine)
-		    (not (keyword? (car engine))))
+  (let ((e (or (if (and (list? engine) (not (keyword? (car engine))))
+		   (car engine)
+		   #f)
 	       (default-engine))))
 
     (cond