slide: Propagate the `outline?' parameter in `slide-(sub)?topic'.

* src/guile/skribilo/package/slide.scm (slide-topic): Propagate the
  `outline?' parameter as an option.
  (slide-subtopic): Likewise.

git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-1

83 files changed, 26258 insertions, 0 deletions

diff --git a/src/guile/Makefile.am b/src/guile/Makefile.am
new file mode 100644
index 0000000..e410a87
--- /dev/null
+++ b/src/guile/Makefile.am
@@ -0,0 +1,5 @@
+SUBDIRS = skribilo
+
+guilemoduledir = $(GUILE_SITE)
+dist_guilemodule_DATA = skribilo.scm
+EXTRA_DIST = README
diff --git a/src/guile/README b/src/guile/README
new file mode 100644
index 0000000..6c5128f
--- /dev/null
+++ b/src/guile/README
@@ -0,0 +1,63 @@
+Skribilo                                                 -*- Outline -*-
+========
+
+Skribilo is a port of Skribe to GNU Guile.
+
+Here are a few goals.
+
+* Usability
+
+** Integration with Guile's module system
+
+** Better error handling, automatic back-traces, etc.
+
+** Add useful markups
+
+- `document': add `:keywords' and `:language', maybe `:date'
+
+- numbered references
+
+- improved footnotes
+
+** Add an option to continuously watch a file and re-compile it
+
+* Font-ends (readers)
+
+** Implement a new front-end mechanism (see `(skribilo reader)')
+
+** Skribe front-end (read Skribe syntax)
+
+Done.
+
+** Texinfo front-end
+
+Use guile-library's `stexi'.
+
+** Simple markup front-end (à la `txt2tags', Emacs' outline mode, or Wiki)
+
+Almost done (Emacs `outline-mode').
+
+* Back-ends (engines)
+
+** Easier to plug-in new back-ends (no need to modify the source)
+
+** Better HTML (or XHTML?) back-end
+
+** Lout back-end (including automatic `lout' invocation?)
+
+Done, except automatic invocation.
+
+** Info back-end
+
+* Packages
+
+** Pie charts
+
+** Equations
+
+* Toys
+
+** Document browser with guile-gnome
+
+
+;;; arch-tag: 2d0a6235-5c09-4930-998c-56a4de2c0aca
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
new file mode 100644
index 0000000..531b0fb
--- /dev/null
+++ b/src/guile/skribilo.scm
@@ -0,0 +1,480 @@
+#!/bin/sh
+# aside from this initial boilerplate, this is actually -*- scheme -*- code
+main='(module-ref (resolve-module '\''(skribilo)) '\'main')'
+exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+!#
+
+;;;; skribilo.scm
+;;;;
+;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;;; USA.
+
+;;;; Commentary:
+;;;;
+;;;; Usage: skribilo [ARGS]
+;;;;
+;;;; Process a skribilo document.
+;;;;
+;;;; Code:
+
+
+
+(define-module (skribilo)
+  :autoload (skribilo module) (make-run-time-module *skribilo-user-module*)
+  :autoload (skribilo engine) (*current-engine*)
+  :autoload (skribilo reader) (*document-reader*)
+  :use-module (skribilo utils syntax))
+
+(use-modules (skribilo evaluator)
+	     (skribilo debug)
+	     (skribilo parameters)
+	     (skribilo lib)
+
+	     (srfi srfi-39)
+	     (ice-9 optargs)
+	     (ice-9 getopt-long))
+
+
+;; Install the Skribilo module syntax reader.
+(fluid-set! current-reader %skribilo-module-reader)
+
+(if (not (keyword? :kw))
+    (error "guile-reader sucks"))
+
+
+
+
+(define* (process-option-specs longname
+			       :key (alternate #f) (arg #f) (help #f)
+			       :rest thunk)
+  "Process STkLos-like option specifications and return getopt-long option
+specifications."
+  `(,(string->symbol longname)
+    ,@(if alternate
+	  `((single-char ,(string-ref alternate 0)))
+	  '())
+    (value ,(if arg #t #f))))
+
+(define (raw-options->getopt-long options)
+  "Converts @var{options} to a getopt-long-compatible representation."
+  (map (lambda (option-specs)
+	 (apply process-option-specs (car option-specs)))
+       options))
+
+(define-macro (define-options binding . options)
+  `(define ,binding (quote ,(raw-options->getopt-long options))))
+
+(define-options skribilo-options
+  (("reader" :alternate "R" :arg reader
+    (nothing)))
+  (("target" :alternate "t" :arg target
+    :help "sets the output format to <target>")
+   (set! engine (string->symbol target)))
+  (("load-path" :alternate "I" :arg path :help "adds <path> to Skribe path")
+   (set! paths (cons path paths)))
+  (("bib-path" :alternate "B" :arg path :help "adds <path> to bibliography path")
+   (skribe-bib-path-set! (cons path (skribe-bib-path))))
+  (("source-path" :alternate "S" :arg path :help "adds <path> to source path")
+   (skribe-source-path-set! (cons path (skribe-source-path))))
+  (("image-path" :alternate "P" :arg path :help "adds <path> to image path")
+   (skribe-image-path-set! (cons path (skribe-image-path))))
+  (("split-chapters" :alternate "C" :arg chapter
+    :help "emit chapter's sections in separate files")
+   (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*)))
+  (("preload" :arg file :help "preload <file>")
+   (set! *skribe-preload* (cons file *skribe-preload*)))
+  (("use-variant" :alternate "u" :arg variant
+    :help "use <variant> output format")
+   (set! *skribe-variants* (cons variant *skribe-variants*)))
+  (("base" :alternate "b" :arg base
+    :help "base prefix to remove from hyperlinks")
+   (set! *skribe-ref-base* base))
+  (("rc-dir" :arg dir :alternate "d" :help "set the RC directory to <dir>")
+   (set! *skribe-rc-directory* dir))
+
+  ;;"File options:"
+  (("no-init-file" :help "Dont load rc Skribe file")
+   (set! *load-rc* #f))
+  (("output" :alternate "o" :arg file :help "set the output to <file>")
+   (set! *skribe-dest* file)
+   (let* ((s (file-suffix file))
+	  (c (assoc s *skribe-auto-mode-alist*)))
+     (if (and (pair? c) (symbol? (cdr c)))
+	 (set! *skribe-engine* (cdr c)))))
+
+  ;;"Misc:"
+  (("help" :alternate "h" :help "provides help for the command")
+   (arg-usage (current-error-port))
+   (exit 0))
+  (("options" :help "display the skribe options and exit")
+   (arg-usage (current-output-port) #t)
+   (exit 0))
+  (("version" :alternate "V" :help "displays the version of Skribe")
+   (version)
+   (exit 0))
+  (("query" :alternate "q"
+    :help "displays informations about Skribe conf.")
+   (query)
+   (exit 0))
+  (("verbose" :alternate "v" :arg level
+    :help "sets the verbosity to <level>. Use -v0 for crystal silence")
+   (let ((val (string->number level)))
+     (if (integer? val)
+	 (set! *skribe-verbose* val))))
+  (("warning" :alternate "w" :arg level
+    :help "sets the verbosity to <level>. Use -w0 for crystal silence")
+   (let ((val (string->number level)))
+     (if (integer? val)
+	 (set! *skribe-warning* val))))
+  (("debug" :alternate "g" :arg level :help "sets the debug <level>")
+   (let ((val (string->number level)))
+     (if (integer? val)
+	 (set-skribe-debug! val)
+	 (begin
+	   ;; Use the symbol for debug
+	   (set-skribe-debug!	    1)
+	   (add-skribe-debug-symbol (string->symbol level))))))
+  (("no-color" :help "disable coloring for output")
+   (no-debug-color))
+  (("custom" :alternate "c" :arg key=val :help "Preset custom value")
+   (let ((args (string-split key=val "=")))
+     (if (and (list args) (= (length args) 2))
+	 (let ((key (car args))
+	       (val (cadr args)))
+	   (set! *skribe-precustom* (cons (cons (string->symbol key) val)
+					  *skribe-precustom*)))
+	 (error 'parse-arguments "Bad custom ~S" key=val))))
+  (("eval" :alternate "e" :arg expr :help "evaluate expression <expr>")
+   (with-input-from-string expr
+      (lambda () (eval (read))))))
+
+
+; (define skribilo-options
+;   ;; Skribilo options in getopt-long's format, as computed by
+;   ;; `raw-options->getopt-long'.
+;   `((target (single-char #\t) (value #f))
+;     (I (value #f))
+;     (B (value #f))
+;     (S (value #f))
+;     (P (value #f))
+;     (split-chapters (single-char #\C) (value #f))
+;     (preload (value #f))
+;     (use-variant (single-char #\u) (value #f))
+;     (base (single-char #\b) (value #f))
+;     (rc-dir (single-char #\d) (value #f))
+;     (no-init-file (value #f))
+;     (output (single-char #\o) (value #f))
+;     (help (single-char #\h) (value #f))
+;     (options (value #f))
+;     (version (single-char #\V) (value #f))
+;     (query (single-char #\q) (value #f))
+;     (verbose (single-char #\v) (value #f))
+;     (warning (single-char #\w) (value #f))
+;     (debug (single-char #\g) (value #f))
+;     (no-color (value #f))
+;     (custom (single-char #\c) (value #f))
+;     (eval (single-char #\e) (value #f))))
+
+
+(define (skribilo-show-help)
+  (format #t "Usage: skribilo [OPTIONS] [INPUT]
+
+Processes a Skribilo/Skribe source file and produces its output.
+
+  --reader=READER  Use READER to parse the input file (by default,
+                   the `skribe' reader is used)
+  --target=ENGINE  Use ENGINE as the underlying engine
+
+  --help           Give this help list
+  --version        Print program version
+~%"))
+
+(define (skribilo-show-version)
+  (format #t "skribilo ~a~%" (skribilo-release)))
+
+;;;; ======================================================================
+;;;;
+;;;;				P A R S E - A R G S
+;;;;
+;;;; ======================================================================
+(define (parse-args args)
+
+  (define (version)
+    (format #t "skribe v~A\n" (skribe-release)))
+
+  (define (query)
+    (version)
+    (for-each (lambda (x)
+		(let ((s (keyword->string (car x))))
+		  (printf "  ~a: ~a\n" s (cadr x))))
+	      (skribe-configure)))
+
+  ;;
+  ;; parse-args starts here
+  ;;
+  (let ((paths '())
+	(engine #f))
+    (parse-arguments args
+      "Usage: skribe [options] [input]"
+      "General options:"
+	(("target" :alternate "t" :arg target
+		   :help "sets the output format to <target>")
+	   (set! engine (string->symbol target)))
+	(("I" :arg path :help "adds <path> to Skribe path")
+	   (set! paths (cons path paths)))
+	(("B" :arg path :help "adds <path> to bibliography path")
+	   (skribe-bib-path-set! (cons path (skribe-bib-path))))
+	(("S" :arg path :help "adds <path> to source path")
+	   (skribe-source-path-set! (cons path (skribe-source-path))))
+	(("P" :arg path :help "adds <path> to image path")
+	   (skribe-image-path-set! (cons path (skribe-image-path))))
+	(("split-chapters" :alternate "C" :arg chapter
+			   :help "emit chapter's sections in separate files")
+	   (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*)))
+	(("preload" :arg file :help "preload <file>")
+	 (set! *skribe-preload* (cons file *skribe-preload*)))
+	(("use-variant" :alternate "u" :arg variant
+			:help "use <variant> output format")
+	  (set! *skribe-variants* (cons variant *skribe-variants*)))
+	(("base" :alternate "b" :arg base
+		 :help "base prefix to remove from hyperlinks")
+	   (set! *skribe-ref-base* base))
+	(("rc-dir" :arg dir :alternate "d" :help "set the RC directory to <dir>")
+	   (set! *skribe-rc-directory* dir))
+
+      "File options:"
+	(("no-init-file" :help "Dont load rc Skribe file")
+	   (set! *load-rc* #f))
+	(("output" :alternate "o" :arg file :help "set the output to <file>")
+	   (set! *skribe-dest* file)
+	   (let* ((s (file-suffix file))
+		  (c (assoc s *skribe-auto-mode-alist*)))
+	     (if (and (pair? c) (symbol? (cdr c)))
+	       (set! *skribe-engine* (cdr c)))))
+
+      "Misc:"
+	(("help" :alternate "h" :help "provides help for the command")
+	   (arg-usage (current-error-port))
+	   (exit 0))
+	(("options" :help "display the skribe options and exit")
+	   (arg-usage (current-output-port) #t)
+	   (exit 0))
+	(("version" :alternate "V" :help "displays the version of Skribe")
+	   (version)
+	   (exit 0))
+	(("query" :alternate "q"
+		  :help "displays informations about Skribe conf.")
+	   (query)
+	   (exit 0))
+	(("verbose" :alternate "v" :arg level
+	  :help "sets the verbosity to <level>. Use -v0 for crystal silence")
+	   (let ((val (string->number level)))
+	     (if (integer? val)
+	       (set! *skribe-verbose* val))))
+	(("warning" :alternate "w" :arg level
+	  :help "sets the verbosity to <level>. Use -w0 for crystal silence")
+	   (let ((val (string->number level)))
+	     (if (integer? val)
+	       (set! *skribe-warning* val))))
+	(("debug" :alternate "g" :arg level :help "sets the debug <level>")
+	   (let ((val (string->number level)))
+	     (if (integer? val)
+		 (set-skribe-debug! val)
+		 (begin
+		   ;; Use the symbol for debug
+		   (set-skribe-debug!	    1)
+		   (add-skribe-debug-symbol (string->symbol level))))))
+	(("no-color" :help "disable coloring for output")
+	 (no-debug-color))
+	(("custom" :alternate "c" :arg key=val :help "Preset custom value")
+	   (let ((args (string-split key=val "=")))
+	     (if (and (list args) (= (length args) 2))
+		 (let ((key (car args))
+		       (val (cadr args)))
+		   (set! *skribe-precustom* (cons (cons (string->symbol key) val)
+						  *skribe-precustom*)))
+		 (error 'parse-arguments "Bad custom ~S" key=val))))
+	(("eval" :alternate "e" :arg expr :help "evaluate expression <expr>")
+	   (with-input-from-string expr
+	     (lambda () (eval (read)))))
+	(else
+	 (set! *skribe-src* other-arguments)))
+
+    ;; we have to configure Skribe path according to the environment variable
+    (skribe-path-set! (append (let ((path (getenv "SKRIBEPATH")))
+				(if path
+				    (string-split path ":")
+				    '()))
+			      (reverse! paths)
+			      (skribe-default-path)))
+    ;; Final initializations
+    (if engine
+      (set! *skribe-engine* engine))))
+
+;;;; ======================================================================
+;;;;
+;;;;				   L O A D - R C
+;;;;
+;;;; ======================================================================
+(define *load-rc* #f)  ;; FIXME:  This should go somewhere else.
+
+(define (load-rc)
+  (if *load-rc*
+    (let ((file (make-path (*rc-directory*) (*rc-file*))))
+      (if (and file (file-exists? file))
+	(load file)))))
+
+
+;;;; ======================================================================
+;;;;
+;;;;				      S K R I B E
+;;;;
+;;;; ======================================================================
+; (define (doskribe)
+;    (let ((e (find-engine *skribe-engine*)))
+;      (if (and (engine? e) (pair? *skribe-precustom*))
+; 	 (for-each (lambda (cv)
+; 		     (engine-custom-set! e (car cv) (cdr cv)))
+; 		   *skribe-precustom*))
+;      (if (pair? *skribe-src*)
+; 	 (for-each (lambda (f) (skribe-load f :engine *skribe-engine*))
+; 		   *skribe-src*)
+; 	 (skribe-eval-port (current-input-port) *skribe-engine*))))
+
+(define *skribilo-output-port* (make-parameter (current-output-port)))
+
+(define (doskribe)
+  (let ((output-port (current-output-port))
+	(user-module (current-module)))
+    (dynamic-wind
+	(lambda ()
+	  ;; FIXME: Using this technique, anything written to `stderr' will
+	  ;; also end up in the output file (e.g. Guile warnings).
+	  (set-current-output-port (*skribilo-output-port*))
+          (let ((user (make-run-time-module)))
+            (set-current-module user)
+            (*skribilo-user-module* user)))
+	(lambda ()
+	  ;;(format #t "engine is ~a~%" (*current-engine*))
+	  (evaluate-document-from-port (current-input-port)
+				       (*current-engine*)))
+	(lambda ()
+	  (set-current-output-port output-port)
+	  (set-current-module user-module)
+          (*skribilo-user-module* #f)))))
+
+
+
+;;;; ======================================================================
+;;;;
+;;;;				      M A I N
+;;;;
+;;;; ======================================================================
+(define-public (skribilo . args)
+  (let* ((options           (getopt-long (cons "skribilo" args)
+					 skribilo-options))
+	 (reader-name       (string->symbol
+			     (option-ref options 'reader "skribe")))
+	 (engine            (string->symbol
+			     (option-ref options 'target "html")))
+	 (output-file       (option-ref options 'output #f))
+	 (debugging-level   (option-ref options 'debug "0"))
+	 (warning-level     (option-ref options 'warning "2"))
+	 (load-path         (option-ref options 'load-path "."))
+	 (bib-path          (option-ref options 'bib-path "."))
+	 (source-path       (option-ref options 'source-path "."))
+	 (image-path        (option-ref options 'image-path "."))
+	 (preload           '())
+	 (variants          '())
+
+	 (help-wanted       (option-ref options 'help #f))
+	 (version-wanted    (option-ref options 'version #f)))
+
+    ;; Set up the debugging infrastructure.
+    (debug-enable 'debug)
+    (debug-enable 'backtrace)
+    (debug-enable 'procnames)
+
+    (cond (help-wanted    (begin (skribilo-show-help) (exit 1)))
+	  (version-wanted (begin (skribilo-show-version) (exit 1))))
+
+    ;; Parse the most important options.
+
+    (if (> (*debug*) 4)
+	(set! %load-hook
+	      (lambda (file)
+		(format #t "~~ loading `~a'...~%" file))))
+
+    (parameterize ((*document-reader* (make-reader reader-name))
+		   (*current-engine* engine)
+		   (*document-path*  (cons load-path (*document-path*)))
+		   (*bib-path*       (cons bib-path (*bib-path*)))
+		   (*source-path*    (cons source-path
+					   (append %load-path
+						   (*source-path*))))
+		   (*image-path*     (cons image-path (*image-path*)))
+		   (*debug*          (string->number debugging-level))
+		   (*warning*        (string->number warning-level))
+		   (*verbose*        (let ((v (option-ref options
+							  'verbose 0)))
+				       (if (number? v) v
+					   (if v 1 0)))))
+
+      ;; Load the user rc file
+      ;;(load-rc)
+
+      (for-each (lambda (f)
+		  (skribe-load f :engine (*current-engine*)))
+		preload)
+
+      ;; Load the specified variants.
+      (for-each (lambda (x)
+		  (skribe-load (format #f "~a.skr" x)
+			       :engine (*current-engine*)))
+		(reverse! variants))
+
+      (let ((files (option-ref options '() '())))
+
+	(if (> (length files) 2)
+	    (error "you can specify at most one input file and one output file"
+		   files))
+
+	(let* ((source-file (if (null? files) #f (car files))))
+
+	  (if (and output-file (file-exists? output-file))
+	      (delete-file output-file))
+
+	  (parameterize ((*destination-file* output-file)
+			 (*source-file*      source-file)
+			 (*skribilo-output-port*
+			  (if (string? output-file)
+			      (open-output-file output-file)
+			      (current-output-port))))
+
+	    (setvbuf (*skribilo-output-port*) _IOFBF 16384)
+
+	    ;;	(start-stack 7
+	    (if source-file
+		(with-input-from-file source-file doskribe)
+		(doskribe))))))))
+
+
+(define main skribilo)
+
+;;; skribilo ends here.
diff --git a/src/guile/skribilo/.arch-inventory b/src/guile/skribilo/.arch-inventory
new file mode 100644
index 0000000..d9ada5e
--- /dev/null
+++ b/src/guile/skribilo/.arch-inventory
@@ -0,0 +1,5 @@
+# Object files generated by Guile-VM's compiler + configuration file
+# generated at `configure'-time.
+precious ^(.*\.go|config.scm)$
+
+# arch-tag: c25ac71e-94bc-4246-8486-49e4179987b8
diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am
new file mode 100644
index 0000000..48fa5ca
--- /dev/null
+++ b/src/guile/skribilo/Makefile.am
@@ -0,0 +1,10 @@
+guilemoduledir = $(GUILE_SITE)/skribilo
+dist_guilemodule_DATA = biblio.scm color.scm config.scm		\
+                        debug.scm engine.scm evaluator.scm	\
+		        lib.scm module.scm output.scm prog.scm	\
+		        reader.scm resolve.scm			\
+			source.scm parameters.scm verify.scm	\
+			writer.scm ast.scm location.scm		\
+			condition.scm
+
+SUBDIRS = utils reader engine package coloring biblio
diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm
new file mode 100644
index 0000000..542f629
--- /dev/null
+++ b/src/guile/skribilo/ast.scm
@@ -0,0 +1,602 @@
+;;; ast.scm  --  Skribilo abstract syntax trees.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo ast)
+  :use-module (oop goops)
+
+  :use-module (srfi srfi-34)
+  :use-module (srfi srfi-35)
+  :use-module (skribilo condition)
+  :use-module (skribilo utils syntax)
+
+  :autoload (skribilo location) (location?)
+  :autoload (srfi srfi-1)  (fold)
+  :export (<ast> ast? ast-loc ast-loc-set!
+		 ast-parent ast->string ast->file-location
+		 ast-resolved?
+
+	   <command> command? command-fmt command-body
+	   <unresolved> unresolved? unresolved-proc
+	   <handle> handle? handle-ast handle-body
+	   <node> node? node-options node-loc node-body
+	   <processor> processor? processor-combinator processor-engine
+
+	   <markup> markup? markup-options is-markup?
+		    markup-markup markup-body markup-body-set!
+                    markup-ident markup-class
+		    markup-option markup-option-set!
+		    markup-option-add! markup-output
+		    markup-parent markup-document markup-chapter
+
+	   <container> container? container-options
+		       container-ident container-body
+		       container-env-get
+
+	   <document> document? document-ident document-body
+		      document-options document-end
+		      document-lookup-node document-bind-node!
+		      document-bind-nodes!
+
+           ;; traversal
+	   ast-fold
+           container-search-down search-down find-down find1-down
+           find-up find1-up
+           ast-document ast-chapter ast-section
+
+	   ;; error conditions
+	   &ast-error &ast-orphan-error &ast-cycle-error
+	   &markup-unknown-option-error &markup-already-bound-error
+	   ast-orphan-error? ast-orphan-error:ast
+	   ast-cycle-error? ast-cycle-error:object
+	   markup-unknown-option-error?
+	   markup-unknown-option-error:markup
+	   markup-unknown-option-error:option
+	   markup-already-bound-error?
+	   markup-already-bound-error:markup
+	   markup-already-bound-error:ident))
+
+;;; Author:  Erick Gallesio, Manuel Serrano, Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; The abstract syntax tree (AST) and its sub-types.  These class form the
+;;; core of a document: each part of a document is an instance of `<ast>' or
+;;; one of its sub-classes.
+;;;
+;;; Code:
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Error conditions.
+;;;
+
+(define-condition-type &ast-error &skribilo-error
+  ast-error?)
+
+(define-condition-type &ast-orphan-error &ast-error
+  ast-orphan-error?
+  (ast ast-orphan-error:ast))
+
+(define-condition-type &ast-cycle-error &ast-error
+  ast-cycle-error?
+  (object ast-cycle-error:object))
+
+(define-condition-type &markup-unknown-option-error &ast-error
+  markup-unknown-option-error?
+  (markup markup-unknown-option-error:markup)
+  (option markup-unknown-option-error:option))
+
+(define-condition-type &markup-already-bound-error &ast-error
+  markup-already-bound-error?
+  (markup markup-already-bound-error:markup)
+  (ident  markup-already-bound-error:ident))
+
+
+(define (handle-ast-error c)
+  ;; Issue a user-friendly error message for error condition C.
+  (cond ((ast-orphan-error? c)
+	 (let* ((node (ast-orphan-error:ast c))
+		(location (and (ast? node) (ast-loc node))))
+	   (format (current-error-port) "orphan node: ~a~a~%"
+		   node
+		   (if (location? location)
+		       (string-append " "
+				      (location-file location) ":"
+				      (location-line location))
+		       ""))))
+
+	((ast-cycle-error? c)
+	 (let ((object (ast-cycle-error:object c)))
+	   (format (current-error-port)
+		   "cycle found in AST: ~a~%" object)))
+
+	((markup-unknown-option-error? c)
+	 (let ((markup (markup-unknown-option-error:markup c))
+	       (option (markup-unknown-option-error:option c)))
+	   (format (current-error-port)
+		   "~a: unknown markup option for `~a'~%"
+		   option markup)))
+
+	((markup-already-bound-error? c)
+	 (let ((markup (markup-already-bound-error:markup c))
+	       (ident  (markup-already-bound-error:ident  c)))
+	   (format (current-error-port)
+		   "`~a' (~a): markup identifier already bound~%"
+		   ident
+		   (if (markup? markup)
+		       (markup-markup markup)
+		       markup))))
+
+	(else
+	 (format (current-error-port) "undefined resolution error: ~a~%"
+		 c))))
+
+(register-error-condition-handler! ast-error? handle-ast-error)
+
+
+
+;;;
+;;; Abstract syntax tree (AST).
+;;;
+
+;;FIXME: set! location in <ast>
+(define-class <ast> ()
+  ;; Parent of this guy.
+  (parent  :accessor ast-parent :init-keyword :parent :init-value 'unspecified)
+
+  ;; Its source location.
+  (loc     :init-value #f)
+
+  ;; This slot is used as an optimization when resolving an AST: sub-parts of
+  ;; the tree are marked as resolved as soon as they are and don't need to be
+  ;; traversed again.
+  (resolved? :accessor ast-resolved? :init-value #f))
+
+
+(define (ast? obj)		(is-a? obj <ast>))
+(define (ast-loc obj)		(slot-ref obj 'loc))
+(define (ast-loc-set! obj v)	(slot-set! obj 'loc v))
+(define (ast-parent n)
+  (slot-ref n 'parent))
+
+
+(define (ast->file-location ast)
+   (let ((l (ast-loc ast)))
+     (if (location? l)
+	 (format #f "~a:~a:" (location-file l) (location-line l))
+	 "")))
+
+(define-generic ast->string)
+
+(define-method (ast->string (ast <top>))     "")
+(define-method (ast->string (ast <string>))  ast)
+(define-method (ast->string (ast <number>))  (number->string ast))
+
+(define-method (ast->string (ast <pair>))
+  (let ((out (open-output-string)))
+    (let Loop ((lst ast))
+      (cond
+	((null? lst)
+	   (get-output-string out))
+	(else
+	   (display (ast->string (car lst)) out)
+	   (unless (null? (cdr lst))
+	     (display #\space out))
+	   (Loop (cdr lst)))))))
+
+
+
+;;; ======================================================================
+;;;
+;;;				<COMMAND>
+;;;
+;;; ======================================================================
+(define-class <command> (<ast>)
+  (fmt    :init-keyword :fmt)
+  (body   :init-keyword :body))
+
+(define (command? obj)     (is-a? obj <command>))
+(define (command-fmt obj)  (slot-ref obj 'fmt))
+(define (command-body obj) (slot-ref obj 'body))
+
+;;; ======================================================================
+;;;
+;;;				<UNRESOLVED>
+;;;
+;;; ======================================================================
+(define-class <unresolved> (<ast>)
+  (proc :init-keyword :proc))
+
+(define (unresolved? obj)     (is-a? obj <unresolved>))
+(define (unresolved-proc obj) (slot-ref obj 'proc))
+
+;;; ======================================================================
+;;;
+;;;				<HANDLE>
+;;;
+;;; ======================================================================
+(define-class <handle> (<ast>)
+  (ast :init-keyword :ast :init-value #f :getter handle-ast))
+
+(define (handle? obj)     (is-a? obj <handle>))
+(define (handle-ast obj)  (slot-ref obj 'ast))
+(define (handle-body h)   (slot-ref h 'body))
+
+;;; ======================================================================
+;;;
+;;;				<NODE>
+;;;
+;;; ======================================================================
+(define-class <node> (<ast>)
+  (required-options :init-keyword :required-options :init-value '())
+  (options	     :init-keyword :options	     :init-value '())
+  (body	     :init-keyword :body	     :init-value #f
+	     :getter	   node-body))
+
+(define (node? obj)        (is-a? obj <node>))
+(define (node-options obj) (slot-ref obj 'options))
+(define node-loc	   ast-loc)
+
+(define-method (ast->string (ast <node>))
+  (ast->string (slot-ref ast 'body)))
+
+
+;;; ======================================================================
+;;;
+;;;				<PROCESSOR>
+;;;
+;;; ======================================================================
+(define-class <processor> (<node>)
+  (combinator :init-keyword :combinator :init-value (lambda (e1 e2) e1))
+  (engine     :init-keyword :engine	 :init-value 'unspecified)
+  (procedure  :init-keyword :procedure	 :init-value (lambda (n e) n)))
+
+(define (processor? obj)           (is-a? obj <processor>))
+(define (processor-combinator obj) (slot-ref obj 'combinator))
+(define (processor-engine obj)     (slot-ref obj 'engine))
+
+
+
+;;;
+;;; Markup.
+;;;
+
+(define-class <markup> (<node>)
+  (ident  :init-keyword :ident  :getter markup-ident :init-value #f)
+  (class  :init-keyword :class  :getter markup-class :init-value #f)
+  (markup :init-keyword :markup :getter markup-markup))
+
+
+(define (markup? obj)		(is-a? obj <markup>))
+(define (markup-options obj)	(slot-ref obj 'options))
+(define markup-body    node-body)
+(define (markup-body-set! m body)
+  (slot-set! m 'resolved? #f)
+  (slot-set! m 'body      body))
+
+(define (markup-option m opt)
+  (if (markup? m)
+      (let ((c (assq opt (slot-ref m 'options))))
+	(and (pair? c) (pair? (cdr c))
+	     (cadr c)))
+      (raise (condition (&invalid-argument-error
+			 (proc-name "markup-option")
+			 (argument  m))))))
+
+(define (markup-option-set! m opt val)
+  (if (markup? m)
+      (let ((c (assq opt (slot-ref m 'options))))
+	(if (and (pair? c) (pair? (cdr c)))
+	    (set-cdr! c (list val))
+	    (raise (condition (&markup-unknown-option-error
+			       (markup m)
+			       (option opt))))))
+      (raise (condition (&invalid-argument-error
+			 (proc-name "markup-option-set!")
+			 (argument  m))))))
+
+(define (markup-option-add! m opt val)
+  (if (markup? m)
+      (slot-set! m 'options (cons (list opt val)
+				  (slot-ref m 'options)))
+      (raise (condition (&invalid-argument-error
+			 (proc-name "markup-option-add!")
+			 (argument  m))))))
+
+
+(define (is-markup? obj markup)
+  (and (is-a? obj <markup>)
+       (eq? (slot-ref obj 'markup) markup)))
+
+
+(define (markup-parent m)
+  (let ((p (slot-ref m 'parent)))
+    (if (eq? p 'unspecified)
+	(raise (condition (&ast-orphan-error (ast m))))
+	p)))
+
+(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)))))
+
+(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)))))
+
+
+
+
+(define-method (write (obj <markup>) port)
+  (format port "#<~A (~A/~A) ~A>"
+	  (class-name (class-of obj))
+	  (slot-ref obj 'markup)
+	  (slot-ref obj 'ident)
+	  (object-address obj)))
+
+(define-method (write (node <unresolved>) port)
+  (let ((proc (slot-ref node 'proc)))
+    (format port "#<<unresolved> (~A~A) ~A>"
+	    proc
+	    (let* ((name (or (procedure-name proc) ""))
+		   (source (procedure-source proc))
+		   (file (and source (source-property source 'filename)))
+		   (line (and source (source-property source 'line))))
+	      ;;(format (current-error-port) "src=~a~%" source)
+	      (string-append name
+			     (if file
+				 (string-append " " file
+						(if line
+						    (number->string line)
+						    ""))
+				 "")))
+	    (object-address node))))
+
+
+
+;;; XXX: This was already commented out in the original Skribe source.
+;;;
+;; (define (markup-output markup
+;;		       :optional (engine    #f)
+;;		       :key	 (predicate #f)
+;;				 (options  '())
+;;				 (before    #f)
+;;				 (action    #f)
+;;				 (after     #f))
+;;   (let ((e (or engine (use-engine))))
+;;     (cond
+;;       ((not (is-a? e <engine>))
+;;           (skribe-error 'markup-writer "illegal engine" e))
+;;       ((and (not before)
+;;	    (not action)
+;;	    (not after))
+;;           (%find-markup-output e markup))
+;;       (else
+;;	  (let ((mp (if (procedure? predicate)
+;;			(lambda (n e) (and (is-markup? n markup) (predicate n e)))
+;;			(lambda (n e) (is-markup? n markup)))))
+;;	    (engine-output e markup mp options
+;;			   (or before (slot-ref e 'default-before))
+;;			   (or action (slot-ref e 'default-action))
+;;			   (or after  (slot-ref e 'default-after))))))))
+
+
+
+;;; ======================================================================
+;;;
+;;;				<CONTAINER>
+;;;
+;;; ======================================================================
+(define-class <container> (<markup>)
+  (env :init-keyword :env :init-value '()))
+
+(define (container? obj)    (is-a? obj <container>))
+(define (container-env obj) (slot-ref obj 'env))
+(define container-options   markup-options)
+(define container-ident     markup-ident)
+(define container-body      node-body)
+
+(define (container-env-get m key)
+  (let ((c (assq key (slot-ref m 'env))))
+    (and (pair? c) (cadr c))))
+
+
+
+;;;
+;;; Document.
+;;;
+
+(define-class <document> (<container>)
+  (node-table   :init-thunk make-hash-table :getter document-node-table)
+  (nodes-bound? :init-value #f :getter document-nodes-bound?))
+
+
+(define (document? obj)      (is-a? obj <document>))
+(define (document-ident obj) (slot-ref obj 'ident))
+(define (document-body obj)  (slot-ref obj 'body))
+(define document-options     markup-options)
+(define document-env         container-env)
+
+(define (document-lookup-node doc ident)
+  ;; Lookup the node with identifier IDENT (a string) in document DOC.
+  (hash-ref (document-node-table doc) ident))
+
+(define (document-bind-node! doc node . ident)
+  ;; Bind NODE (a markup object) to DOC (a document object).
+  (let ((ident (if (null? ident) (markup-ident node) (car ident))))
+    (if ident
+	(let ((handle (hash-get-handle (document-node-table doc) ident)))
+	  ;;(format (current-error-port) "binding `~a' in `~a'~%" ident node)
+	  (if (and (pair? handle) (not (eq? (cdr handle) node)))
+	      (raise (condition (&markup-already-bound-error
+				 (ident  ident)
+				 (markup node))))
+	      (hash-set! (document-node-table doc) ident node))))))
+
+(define (document-bind-nodes! doc)
+  ;; Bind all the nodes contained in DOC if they are not already bound.
+  ;; Once, this is done, `document-lookup-node' can be used to search a node
+  ;; by its identifier.
+
+  ;; We assume that unresolved nodes do not introduce any new identifier,
+  ;; hence this optimization.
+  (if (document-nodes-bound? doc)
+      #t
+      (begin
+	(ast-fold (lambda (node result)
+		    (if (markup? node) (document-bind-node! doc node))
+		    #t)
+		  #t ;; unused
+		  doc)
+	(slot-set! doc 'nodes-bound? #t))))
+
+
+;;;
+;;; AST traversal utilities.
+;;;
+
+(define (ast-fold proc init ast)
+  ;; Apply PROC to each node in AST (per `node?'), in a way similar to `fold'
+  ;; (in SRFI-1).
+  (let loop ((ast ast)
+	     (result init))
+    (cond ((pair? ast)
+	   (fold loop result ast))
+	  ((node? ast)
+	   (loop (node-body ast) (proc ast result)))
+	  (else result))))
+
+
+;; The procedures below are almost unchanged compared to Skribe 1.2d's
+;; `lib.scm' file found in the `common' directory, written by Manuel Serrano
+;; (I removed uses of `with-debug' et al., though).
+
+
+(define (container-search-down pred obj)
+  (let loop ((obj (markup-body obj)))
+    (cond
+     ((pair? obj)
+      (apply append (map (lambda (o) (loop o)) obj)))
+     ((container? obj)
+      (let ((rest (loop (markup-body obj))))
+        (if (pred obj)
+            (cons obj rest)
+            rest)))
+     ((pred obj)
+      (list obj))
+     (else
+      '()))))
+
+(define (search-down pred obj)
+  (let loop ((obj (markup-body obj)))
+    (cond
+     ((pair? obj)
+      (apply append (map (lambda (o) (loop o)) obj)))
+     ((markup? obj)
+      (let ((rest (loop (markup-body obj))))
+        (if (pred obj)
+            (cons obj rest)
+            rest)))
+     ((pred obj)
+      (list obj))
+     (else
+      '()))))
+
+(define (find-down pred obj)
+  (let loop ((obj obj))
+    (cond
+     ((pair? obj)
+      (apply append (map (lambda (o) (loop o)) obj)))
+     ((markup? obj)
+      (if (pred obj)
+          (list (cons obj (loop (markup-body obj))))
+          '()))
+     (else
+      (if (pred obj)
+          (list obj)
+          '())))))
+
+(define (find1-down pred obj)
+  (let loop ((obj obj)
+             (stack '()))
+    (cond
+     ((memq obj stack)
+      (raise (condition (&ast-cycle-error (object obj)))))
+     ((pair? obj)
+      (let liip ((obj obj))
+        (cond
+         ((null? obj)
+          #f)
+         (else
+          (or (loop (car obj) (cons obj stack))
+              (liip (cdr obj)))))))
+     ((pred obj)
+      obj)
+     ((markup? obj)
+      (loop (markup-body obj) (cons obj stack)))
+     (else
+      #f))))
+
+(define (find-up pred obj)
+  (let loop ((obj obj)
+             (res '()))
+    (cond
+     ((not (ast? obj))
+      res)
+     ((pred obj)
+      (loop (ast-parent obj) (cons obj res)))
+     (else
+      (loop (ast-parent obj) (cons obj res))))))
+
+(define (find1-up pred obj)
+  (let loop ((obj obj))
+    (cond
+     ((not (ast? obj))
+      #f)
+     ((pred obj)
+      obj)
+     (else
+      (loop (ast-parent obj))))))
+
+(define (ast-document m)
+  (find1-up document? m))
+
+(define (ast-chapter m)
+  (find1-up (lambda (n) (is-markup? n 'chapter)) m))
+
+(define (ast-section m)
+  (find1-up (lambda (n) (is-markup? n 'section)) m))
+
+
+;;; arch-tag: e2489bd6-1b6d-4b03-bdfb-83cffd2f7ce7
+
+;;; ast.scm ends here
diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm
new file mode 100644
index 0000000..1fb4b78
--- /dev/null
+++ b/src/guile/skribilo/biblio.scm
@@ -0,0 +1,382 @@
+;;; biblio.scm  --  Bibliography functions.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.main.st
+
+
+
+(define-module (skribilo biblio)
+  :use-module (skribilo utils strings)
+  :use-module (skribilo utils syntax) ;; `when', `unless'
+
+  :autoload   (srfi srfi-34)         (raise)
+  :use-module (srfi srfi-35)
+  :use-module (srfi srfi-1)
+  :autoload   (skribilo condition)   (&file-search-error)
+
+  :autoload   (skribilo reader)      (%default-reader)
+  :autoload   (skribilo parameters)  (*bib-path*)
+  :autoload   (skribilo ast)         (<markup> <handle> is-markup?)
+
+  :use-module (ice-9 optargs)
+  :use-module (oop goops)
+
+  :export (bib-table? make-bib-table default-bib-table
+	   bib-add! bib-duplicate bib-for-each bib-map
+	   skribe-open-bib-file parse-bib
+
+           bib-load! resolve-bib resolve-the-bib make-bib-entry
+
+           ;; sorting entries
+           bib-sort/authors bib-sort/idents bib-sort/dates))
+
+;;; Author: Erick Gallesio, Manuel Serrano, Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; Provides the bibliography data type and basic bibliography handling,
+;;; including simple procedures to sort bibliography entries.
+;;;
+;;; FIXME: This module need cleanup!
+;;;
+;;; Code:
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;; FIXME: Should be a fluid?
+(define *bib-table*	     #f)
+
+;; Forward declarations
+(define skribe-open-bib-file #f)
+(define parse-bib	     #f)
+
+
+
+;;; ======================================================================
+;;;
+;;;				Utilities
+;;;
+;;; ======================================================================
+
+(define (make-bib-table ident)
+   (make-hash-table))
+
+(define (bib-table? obj)
+  (hash-table? obj))
+
+(define (default-bib-table)
+  (unless *bib-table*
+    (set! *bib-table* (make-bib-table "default-bib-table")))
+  *bib-table*)
+
+(define (%bib-error who entry)
+  (let ((msg "bibliography syntax error on entry"))
+    (if (%epair? entry)
+	(skribe-line-error (%epair-file entry) (%epair-line entry) who msg entry)
+	(skribe-error who msg entry))))
+
+(define* (bib-for-each proc :optional (table (default-bib-table)))
+  (hash-for-each (lambda (ident entry)
+		   (proc ident entry))
+		 table))
+
+(define* (bib-map proc :optional (table (default-bib-table)))
+  (hash-map->list (lambda (ident entry)
+		    (proc ident entry))
+		  table))
+
+
+;;; ======================================================================
+;;;
+;;;				BIB-DUPLICATE
+;;;
+;;; ======================================================================
+(define (bib-duplicate ident from old)
+  (let ((ofrom (markup-option old 'from)))
+    (skribe-warning 2
+		    'bib
+		    (format #f "duplicated bibliographic entry ~a'.\n" ident)
+		    (if ofrom
+			(format #f " using version of `~a'.\n" ofrom)
+			"")
+		    (if from
+			(format #f " ignoring version of `~a'." from)
+			" ignoring redefinition."))))
+
+
+;;; ======================================================================
+;;;
+;;;				PARSE-BIB
+;;;
+;;; ======================================================================
+(define (parse-bib table port)
+  (let ((read %default-reader)) ;; FIXME: We should use a fluid
+    (if (not (bib-table? table))
+	(skribe-error 'parse-bib "Illegal bibliography table" table)
+	(let ((from (port-filename port)))
+	  (let Loop ((entry (read port)))
+	    (unless (eof-object? entry)
+	      (cond
+	       ((and (list? entry) (> (length entry) 2))
+		(let* ((kind   (car entry))
+		       (key    (format #f "~A" (cadr entry)))
+		       (fields (cddr entry))
+		       (old    (hash-ref table key)))
+		  (if old
+		      (bib-duplicate ident from old)
+		      (hash-set! table key
+				 (make-bib-entry kind key fields from)))
+		  (Loop (read port))))
+	       (else
+		(%bib-error 'bib-parse entry)))))))))
+
+
+;;; ======================================================================
+;;;
+;;;				   BIB-ADD!
+;;;
+;;; ======================================================================
+(define (bib-add! table . entries)
+  (if (not (bib-table? table))
+      (skribe-error 'bib-add! "Illegal bibliography table" table)
+      (for-each (lambda (entry)
+		  (cond
+		    ((and (list? entry) (> (length entry) 2))
+		     (let* ((kind   (car entry))
+			    (key    (format #f "~A" (cadr entry)))
+			    (fields (cddr entry))
+			    (old    (hash-ref table key)))
+		       (if old
+			   (bib-duplicate key #f old)
+			   (hash-set! table key
+				      (make-bib-entry kind key fields #f)))))
+		    (else
+		     (%bib-error 'bib-add! entry))))
+		entries)))
+
+
+;;; ======================================================================
+;;;
+;;;				SKRIBE-OPEN-BIB-FILE
+;;;
+;;; ======================================================================
+;; FIXME: Factoriser
+(define (skribe-open-bib-file file command)
+ (let ((path (search-path (*bib-path*) file)))
+   (if (string? path)
+       (begin
+	 (when (> (*verbose*) 0)
+	   (format (current-error-port) "  [loading bibliography: ~S]\n" path))
+	 (open-input-file (if (string? command)
+			      (string-append "| "
+					     (format #f command path))
+			      path)))
+       (raise (condition (&file-search-error (file-name file)
+					     (path (*bib-path*))))))))
+
+
+;;;
+;;; High-level API.
+;;;
+;;; The contents of the file below are unchanged compared to Skribe 1.2d's
+;;; `bib.scm' file found in the `common' directory.  The copyright notice for
+;;; this file was:
+;;;
+;;;  Copyright 2001, 2002, 2003, 2004  Manuel Serrano
+;;;
+
+
+;*---------------------------------------------------------------------*/
+;*    bib-load! ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (bib-load! table filename command)
+   (if (not (bib-table? table))
+       (skribe-error 'bib-load "Illegal bibliography table" table)
+       ;; read the file
+       (let ((p (skribe-open-bib-file filename command)))
+	  (if (not (input-port? p))
+	      (skribe-error 'bib-load "Can't open data base" filename)
+	      (unwind-protect
+		 (parse-bib table p)
+		 (close-input-port p))))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-bib ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (resolve-bib table ident)
+   (if (not (bib-table? table))
+       (skribe-error 'resolve-bib "Illegal bibliography table" table)
+       (let* ((i (cond
+		    ((string? ident) ident)
+		    ((symbol? ident) (symbol->string ident))
+		    (else (skribe-error 'resolve-bib "Illegal ident" ident))))
+	      (en (hash-ref table i)))
+	  (if (is-markup? en '&bib-entry)
+	      en
+	      #f))))
+
+;*---------------------------------------------------------------------*/
+;*    make-bib-entry ...                                               */
+;*---------------------------------------------------------------------*/
+(define (make-bib-entry kind ident fields from)
+   (let* ((m (make <markup>
+		:markup '&bib-entry
+		:ident ident
+		:options `((kind ,kind) (from ,from))))
+	  (h (make <handle> :ast m)))
+      (for-each (lambda (f)
+		   (if (and (pair? f)
+			    (pair? (cdr f))
+			    (null? (cddr f))
+			    (symbol? (car f)))
+		       (markup-option-add! m 
+					   (car f)
+					   (make <markup>
+					      :markup (symbol-append
+						       '&bib-entry-
+						       (car f))
+					      :parent h
+					      :body (cadr f)))
+		       (bib-parse-error f)))
+		fields)
+      m))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/authors ...                                             */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/authors l)
+   (define (cmp i1 i2 def)
+      (cond
+	 ((and (markup? i1) (markup? i2))
+	  (cmp (markup-body i1) (markup-body i2) def))
+	 ((markup? i1)
+	  (cmp (markup-body i1) i2 def))
+	 ((markup? i2)
+	  (cmp i1 (markup-body i2) def))
+	 ((and (string? i1) (string? i2))
+	  (if (string=? i1 i2)
+	      (def)
+	      (string<? i1 i2)))
+	 ((string? i1)
+	  #f)
+	 ((string? i2)
+	  #t)
+	 (else
+	  (def))))
+   (sort l (lambda (e1 e2)
+	      (cmp (markup-option e1 'author)
+		   (markup-option e2 'author)
+		   (lambda ()
+		      (cmp (markup-option e1 'year)
+			   (markup-option e2 'year)
+			   (lambda ()
+			      (cmp (markup-option e1 'title)
+				   (markup-option e2 'title)
+				   (lambda ()
+				      (cmp (markup-ident e1)
+					   (markup-ident e2)
+					   (lambda ()
+					      #t)))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/idents ...                                              */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/idents l)
+   (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f)))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/dates ...                                               */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/dates l)
+   (sort l (lambda (p1 p2)
+	      (define (month-num m)
+		 (let ((body (markup-body m)))
+		    (if (not (string? body))
+			13
+			(let* ((s (if (> (string-length body) 3)
+				      (substring body 0 3)
+				      body))
+			       (sy (string->symbol (string-downcase body)))
+			       (c (assq sy '((jan . 1)
+					     (feb . 2)
+					     (mar . 3)
+					     (apr . 4)
+					     (may . 5)
+					     (jun . 6)
+					     (jul . 7)
+					     (aug . 8)
+					     (sep . 9)
+					     (oct . 10)
+					     (nov . 11)
+					     (dec . 12)))))
+			   (if (pair? c) (cdr c) 13)))))
+	      (let ((d1 (markup-option p1 'year))
+		    (d2 (markup-option p2 'year)))
+		 (cond
+		    ((not (markup? d1)) #f)
+		    ((not (markup? d2)) #t)
+		    (else
+		     (let ((y1 (markup-body d1))
+			   (y2 (markup-body d2)))
+			(cond
+			   ((string>? y1 y2) #t)
+			   ((string<? y1 y2) #f)
+			   (else
+			    (let ((d1 (markup-option p1 'month))
+				  (d2 (markup-option p2 'month)))
+			       (cond
+				  ((not (markup? d1)) #f)
+				  ((not (markup? d2)) #t)
+				  (else
+				   (let ((m1 (month-num d1))
+					 (m2 (month-num d2)))
+				      (> m1 m2))))))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-the-bib ...                                              */
+;*---------------------------------------------------------------------*/
+(define (resolve-the-bib table n sort pred count opts)
+   (define (count! entries)
+      (let loop ((es entries)
+		 (i 1))
+	 (if (pair? es)
+	     (begin
+		(markup-option-add! (car es)
+				    :title
+				    (make <markup>
+				       :markup '&bib-entry-ident
+				       :parent (car es)
+				       :options `((number ,i))
+				       :body (make <handle> :ast (car es))))
+		(loop (cdr es) (+ i 1))))))
+   (if (not (bib-table? table))
+       (skribe-error 'resolve-the-bib "Illegal bibliography table" table)
+       (let* ((es (sort (hash-map->list (lambda (key val) val) table)))
+	      (fes (filter (if (procedure? pred)
+			       (lambda (m) (pred m n))
+			       (lambda (m) (pair? (markup-option m 'used))))
+			   es)))
+	  (count! (if (eq? count 'full) es fes))
+	  (make <markup>
+	     :markup '&the-bibliography
+	     :options opts
+	     :body fes))))
+
+
+;;; biblio.scm ends here
diff --git a/src/guile/skribilo/biblio/Makefile.am b/src/guile/skribilo/biblio/Makefile.am
new file mode 100644
index 0000000..9442562
--- /dev/null
+++ b/src/guile/skribilo/biblio/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/biblio
+dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm
+
+## arch-tag: aeffaead-c3f0-47f3-a0b3-bb3e22da2657
diff --git a/src/guile/skribilo/biblio/abbrev.scm b/src/guile/skribilo/biblio/abbrev.scm
new file mode 100644
index 0000000..9c88b6a
--- /dev/null
+++ b/src/guile/skribilo/biblio/abbrev.scm
@@ -0,0 +1,170 @@
+;;; abbrev.scm  --  Determining abbreviations.
+;;;
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo biblio abbrev)
+  :use-module (srfi srfi-13)
+  :autoload   (skribilo ast)           (markup? markup-body-set!)
+  :autoload   (skribilo utils strings) (make-string-replace)
+  :autoload   (ice-9 regex)      (regexp-substitute/global)
+  :export (is-abbreviation? is-acronym? abbreviate-word
+           abbreviate-string abbreviate-markup
+
+           %cs-conference-abbreviations
+           %ordinal-number-abbreviations
+           %common-booktitle-abbreviations))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; Heuristics to identify or generate abbreviations.  This module
+;;; particularly targets booktitle abbreviations (in bibliography entries).
+;;;
+;;; Code:
+
+(define (is-abbreviation? str)
+  ;; Return #t if STR denotes an abbreviation or name initial.
+  (and (>= (string-length str) 2)
+       (char=? (string-ref str 1) #\.)))
+
+(define (is-acronym? str)
+  (string=? str (string-upcase str)))
+
+(define (abbreviate-word word)
+   (if (or (string=? "" word)
+	   (and (>= (string-length word) 3)
+		(string=? "and" (substring word 0 3)))
+	   (is-acronym? word))
+       word
+       (let ((dash (string-index word #\-))
+	     (abbr (string (string-ref word 0) #\.)))
+	  (if (not dash)
+	      abbr
+	      (string-append (string (string-ref word 0)) "-"
+			     (abbreviate-word
+			      (substring word (+ 1 dash)
+					 (string-length word))))))))
+
+(define (abbreviate-string subst title)
+  ;; Abbreviate common conference names within TITLE based on the SUBST list
+  ;; of regexp-substitution pairs (see examples below).  This function also
+  ;; removes the abbreviation if it appears in parentheses right after the
+  ;; substitution regexp.  Example:
+  ;;
+  ;;   "Symposium on Operating Systems Principles (SOSP 2004)"
+  ;;
+  ;; yields
+  ;;
+  ;;   "SOSP"
+  ;;
+  (let loop ((title title)
+	     (subst subst))
+    (if (null? subst)
+	title
+	(let* ((abbr (cdar subst))
+	       (abbr-rexp (string-append "( \\(" abbr "[^\\)]*\\))?"))
+	       (to-replace (string-append (caar subst) abbr-rexp)))
+	  (loop (regexp-substitute/global #f to-replace title
+					  'pre abbr 'post)
+		(cdr subst))))))
+
+(define (abbreviate-markup subst markup)
+  ;; A version of `abbreviate-string' generalized to arbitrary markup
+  ;; objects.
+  (let loop ((markup markup))
+    (cond ((string? markup)
+           (let ((purify (make-string-replace '((#\newline " ")
+                                                (#\tab     " ")))))
+             (abbreviate-string subst (purify markup))))
+          ((list? markup)
+           (map loop markup))
+          ((markup? markup)
+           (markup-body-set! markup (loop (markup-body title)))
+           markup)
+          (else markup))))
+
+
+;;;
+;;; Common English abbreviations.
+;;;
+
+;; The following abbreviation alists may be passed to `abbreviate-string'
+;; and `abbreviate-markup'.
+
+(define %cs-conference-abbreviations
+  ;; Common computer science conferences and their acronym.
+  '(("(Symposium [oO]n )?Operating Systems? Design and [iI]mplementation"
+     . "OSDI")
+    ("(Symposium [oO]n )?Operating Systems? Principles"
+     . "SOSP")
+    ("([wW]orkshop [oO]n )?Hot Topics [iI]n Operating Systems"
+     . "HotOS")
+    ("([cC]onference [oO]n )?[fF]ile [aA]nd [sS]torage [tT]echnologies"
+     . "FAST")
+    ("([tT]he )?([iI]nternational )?[cC]onference [oO]n [aA]rchitectural Support [fF]or Programming Languages [aA]nd Operating Systems"
+     . "ASPLOS")
+    ("([tT]he )?([iI]nternational )?[cC]onference [oO]n Peer-[tT]o-[pP]eer Computing"
+     . "P2P")
+    ("([iI]nternational )?[cC]onference [oO]n [dD]ata [eE]ngineering"
+     . "ICDE")
+    ("([cC]onference [oO]n )?[mM]ass [sS]torage [sS]ystems( [aA]nd [tT]echnologies)?"
+     . "MSS")
+    ("([sS]ymposium [oO]n )?[nN]etworked [sS]ystems [dD]esign [aA]nd [Ii]mplementation"
+     . "NSDI")))
+
+
+(define %ordinal-number-abbreviations
+  ;; The poor man's abbreviation system.
+
+  ;; FIXME: Given the current `abbreviate-string', there is no clean way to
+  ;; make it ignore things like "twenty-first" (instead of yielding an awful
+  ;; "twenty-1st").
+  '(("[Ff]irst"       . "1st")
+    ("[sS]econd"      . "2nd")
+    ("[Tt]hird"       . "3rd")
+    ("[Ff]ourth"      . "4th")
+    ("[Ff]ifth"       . "5th")
+    ("[Ss]ixth"       . "6th")
+    ("[Ss]eventh"     . "7th")
+    ("[eE]ighth"      . "8th")
+    ("[Nn]inth"       . "9th")
+    ("[Tt]enth"       . "10th")
+    ("[Ee]leventh"    . "11th")
+    ("[Tt]welfth"     . "12th")
+    ("[Tt]hirteenth"  . "13th")
+    ("[Ff]ourteenth"  . "14th")
+    ("[Ff]ifteenth"   . "15th")
+    ("[Ss]ixteenth"   . "16th")
+    ("[Ss]eventeenth" . "17th")
+    ("[Ee]ighteenth"  . "18th")
+    ("[Nn]ineteenth"  . "19th")))
+
+(define %common-booktitle-abbreviations
+  ;; Common book title abbreviations.  This is used by
+  ;; `abbreviate-booktitle'.
+  '(("[pP]roceedings?"  . "Proc.")
+    ("[iI]nternational" . "Int.")
+    ("[sS]ymposium"     . "Symp.")
+    ("[cC]onference"    . "Conf.")))
+
+
+;;; arch-tag: 34e0c5bb-592f-467b-b59a-d6f7d130ae4e
+
+;;; abbrev.scm ends here
diff --git a/src/guile/skribilo/biblio/author.scm b/src/guile/skribilo/biblio/author.scm
new file mode 100644
index 0000000..ea15f4c
--- /dev/null
+++ b/src/guile/skribilo/biblio/author.scm
@@ -0,0 +1,136 @@
+;;; author.scm  --  Handling author names.
+;;;
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo biblio author)
+  :use-module (srfi srfi-13)
+  :use-module (srfi srfi-14)
+  :use-module (skribilo biblio abbrev)
+  :autoload   (skribilo ast)     (markup-option markup-body markup-ident)
+  :autoload   (skribilo lib)     (skribe-error)
+  :autoload   (skribilo utils strings) (make-string-replace)
+  :export (comma-separated->author-list
+	   comma-separated->and-separated-authors
+
+	   extract-first-author-name
+	   abbreviate-author-first-names
+	   abbreviate-first-names
+	   first-author-last-name
+
+	   bib-sort/first-author-last-name))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; Heuristics to manipulate author names as strings.
+;;;
+;;; Code:
+
+(define (comma-separated->author-list authors)
+  ;; Return a list of strings where each individual string is an author
+  ;; name.  AUTHORS is a string representing a list of author names separated
+  ;; by a comma.
+
+  ;; XXX: I should use SRFI-13 instead.
+  (string-split authors #\,))
+
+(define (comma-separated->and-separated-authors authors)
+  ;; Take AUTHORS, a string containing comma-separated author names, and
+  ;; return a string where author names are separated by " and " (suitable
+  ;; for BibTeX).
+  (string-join (comma-separated->author-list authors)
+	       " and " 'infix))
+
+
+(define (extract-first-author-name names)
+   ;; Extract the name of the first author from string
+   ;; NAMES that is a comma-separated list of authors.
+   (let ((author-name-end (or (string-index names #\,)
+			      (string-length names))))
+      (substring names 0 author-name-end)))
+
+(define (abbreviate-author-first-names name)
+   ;; Abbreviate author first names
+   (let* ((components (string-split name #\space))
+	  (component-number (length components)))
+      (apply string-append
+	     (append
+	      (map (lambda (c)
+		      (string-append (abbreviate-word c) " "))
+		   (list-head components
+			      (- component-number 1)))
+	      (list-tail components (- component-number 1))))))
+
+(define (abbreviate-first-names names)
+   ;; Abbreviate first names in NAMES.  NAMES is supposed to be
+   ;; something like "Ludovic Courtès, Marc-Olivier Killijian".
+   (let loop ((names ((make-string-replace '((#\newline " ")
+					     (#\tab     " ")))
+		      names))
+	      (result ""))
+      (if (string=? names "")
+	  result
+	  (let* ((len (string-length names))
+		 (first-author-names-end (or (string-index names #\,)
+					     len))
+		 (first-author-names (substring names 0
+						first-author-names-end))
+		 (next (substring names
+				  (min (+ 1 first-author-names-end) len)
+				  len)))
+	     (loop next
+		   (string-append result
+				  (if (string=? "" result) "" ", ")
+				  (abbreviate-author-first-names
+				   first-author-names)))))))
+
+
+(define (first-author-last-name authors)
+  ;; Return a string containing exactly the last name of the first author.
+  ;; Author names in AUTHORS are assumed to be comma separated.
+  (let loop ((first-author (extract-first-author-name authors)))
+    (let ((space (string-index first-author #\space)))
+      (if (not space)
+	  first-author
+	  (loop (substring first-author (+ space 1)
+			   (string-length first-author)))))))
+
+(define (bib-sort/first-author-last-name entries)
+   ;; May be passed as the `:sort' argument of `the-bibliography'.
+   (let ((check-author (lambda (e)
+			  (if (not (markup-option e 'author))
+			      (skribe-error 'web
+					    "No author for this bib entry"
+					    (markup-ident e))
+			      #t))))
+      (sort entries
+	    (lambda (e1 e2)
+	    (let* ((x1 (check-author e1))
+		   (x2 (check-author e2))
+		   (a1 (first-author-last-name
+			(markup-body (markup-option e1 'author))))
+		   (a2 (first-author-last-name
+			(markup-body (markup-option e2 'author)))))
+	       (string-ci<=? a1 a2))))))
+
+
+;;; arch-tag: c9a1ef10-a2cd-4a06-bd35-fbdee1abf09a
+
+;;; author.scm ends here
diff --git a/src/guile/skribilo/biblio/bibtex.scm b/src/guile/skribilo/biblio/bibtex.scm
new file mode 100644
index 0000000..319df1d
--- /dev/null
+++ b/src/guile/skribilo/biblio/bibtex.scm
@@ -0,0 +1,83 @@
+;;; bibtex.scm  --  Handling BibTeX references.
+;;;
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+(define-module (skribilo biblio bibtex)
+  :autoload   (skribilo utils strings) (make-string-replace)
+  :autoload   (skribilo ast)           (markup-option ast->string)
+  :autoload   (skribilo engine)        (engine-filter find-engine)
+  :use-module (skribilo biblio author)
+  :use-module (srfi srfi-39)
+  :export     (print-as-bibtex-entry))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; A set of BibTeX tools, e.g., issuing a BibTeX entry from a `&bib-entry'
+;;; markup object.
+;;;
+;;; Code:
+
+(define *bibtex-author-filter*
+  ;; Defines how the `author' field is to be filtered.
+  (make-parameter comma-separated->and-separated-authors))
+
+(define (print-as-bibtex-entry entry)
+  "Display @code{&bib-entry} object @var{entry} as a BibTeX entry."
+  (let ((show-option (lambda (opt)
+		       (let* ((o (markup-option entry opt))
+			      (f (make-string-replace '((#\newline " "))))
+			      (g (if (eq? opt 'author)
+				     (lambda (a)
+				       ((*bibtex-author-filter*) (f a)))
+				     f)))
+			 (if (not o)
+			     #f
+			     `(,(symbol->string opt)
+			       " = \""
+			       ,(g (ast->string (markup-body o)))
+			       "\","))))))
+    (format #t "@~a{~a,~%"
+	    (markup-option entry 'kind)
+	    (markup-ident entry))
+    (for-each (lambda (opt)
+		(let* ((o (show-option opt))
+		       (tex-filter (engine-filter
+				    (find-engine 'latex)))
+		       (filter (lambda (n)
+				 (tex-filter (ast->string n))))
+		       (id (lambda (a) a)))
+		  (if o
+		      (display
+		       (apply string-append
+			      `(,@(map (if (eq? 'url opt)
+					   id filter)
+				       (cons "  " o))
+				"\n"))))))
+	      '(author institution title
+                booktitle journal number
+		year month url pages address publisher))
+    (display "}\n")))
+
+
+;;; arch-tag: 8b5913cc-9077-4e92-839e-c4c633b7bd46
+
+;;; bibtex.scm ends here
diff --git a/src/guile/skribilo/color.scm b/src/guile/skribilo/color.scm
new file mode 100644
index 0000000..8b6205f
--- /dev/null
+++ b/src/guile/skribilo/color.scm
@@ -0,0 +1,621 @@
+;;; color.scm -- Color management.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+(define-module (skribilo color)
+  :autoload (srfi srfi-60) (bitwise-and arithmetic-shift)
+  :export (skribe-color->rgb skribe-get-used-colors skribe-use-color!))
+
+;; FIXME: This module should be generalized and the `skribe-' procedures
+;; moved to `compat.scm'.
+
+;; FIXME: Use a fluid?  Or remove it?
+(define *used-colors* '())
+
+(define *skribe-rgb-alist* '(
+   ("snow"			. "255 250 250")
+   ("ghostwhite"		. "248 248 255")
+   ("whitesmoke"		. "245 245 245")
+   ("gainsboro"			. "220 220 220")
+   ("floralwhite"		. "255 250 240")
+   ("oldlace"			. "253 245 230")
+   ("linen"			. "250 240 230")
+   ("antiquewhite"		. "250 235 215")
+   ("papayawhip"		. "255 239 213")
+   ("blanchedalmond"		. "255 235 205")
+   ("bisque"			. "255 228 196")
+   ("peachpuff"			. "255 218 185")
+   ("navajowhite"		. "255 222 173")
+   ("moccasin"			. "255 228 181")
+   ("cornsilk"			. "255 248 220")
+   ("ivory"			. "255 255 240")
+   ("lemonchiffon"		. "255 250 205")
+   ("seashell"			. "255 245 238")
+   ("honeydew"			. "240 255 240")
+   ("mintcream"			. "245 255 250")
+   ("azure"			. "240 255 255")
+   ("aliceblue"			. "240 248 255")
+   ("lavender"			. "230 230 250")
+   ("lavenderblush"		. "255 240 245")
+   ("mistyrose"			. "255 228 225")
+   ("white"			. "255 255 255")
+   ("black"			. "0 0 0")
+   ("darkslategrey"		. "47 79 79")
+   ("dimgrey"			. "105 105 105")
+   ("slategrey"			. "112 128 144")
+   ("lightslategrey"		. "119 136 153")
+   ("grey"			. "190 190 190")
+   ("lightgrey"			. "211 211 211")
+   ("midnightblue"		. "25 25 112")
+   ("navy"			. "0 0 128")
+   ("navyblue"			. "0 0 128")
+   ("cornflowerblue"		. "100 149 237")
+   ("darkslateblue"		. "72 61 139")
+   ("slateblue"			. "106 90 205")
+   ("mediumslateblue"		. "123 104 238")
+   ("lightslateblue"		. "132 112 255")
+   ("mediumblue"		. "0 0 205")
+   ("royalblue"			. "65 105 225")
+   ("blue"			. "0 0 255")
+   ("dodgerblue"		. "30 144 255")
+   ("deepskyblue"		. "0 191 255")
+   ("skyblue"			. "135 206 235")
+   ("lightskyblue"		. "135 206 250")
+   ("steelblue"			. "70 130 180")
+   ("lightsteelblue"		. "176 196 222")
+   ("lightblue"			. "173 216 230")
+   ("powderblue"		. "176 224 230")
+   ("paleturquoise"		. "175 238 238")
+   ("darkturquoise"		. "0 206 209")
+   ("mediumturquoise"		. "72 209 204")
+   ("turquoise"			. "64 224 208")
+   ("cyan"			. "0 255 255")
+   ("lightcyan"			. "224 255 255")
+   ("cadetblue"			. "95 158 160")
+   ("mediumaquamarine"		. "102 205 170")
+   ("aquamarine"		. "127 255 212")
+   ("darkgreen"			. "0 100 0")
+   ("darkolivegreen"		. "85 107 47")
+   ("darkseagreen"		. "143 188 143")
+   ("seagreen"			. "46 139 87")
+   ("mediumseagreen"		. "60 179 113")
+   ("lightseagreen"		. "32 178 170")
+   ("palegreen"			. "152 251 152")
+   ("springgreen"		. "0 255 127")
+   ("lawngreen"			. "124 252 0")
+   ("green"			. "0 255 0")
+   ("chartreuse"		. "127 255 0")
+   ("mediumspringgreen"		. "0 250 154")
+   ("greenyellow"		. "173 255 47")
+   ("limegreen"			. "50 205 50")
+   ("yellowgreen"		. "154 205 50")
+   ("forestgreen"		. "34 139 34")
+   ("olivedrab"			. "107 142 35")
+   ("darkkhaki"			. "189 183 107")
+   ("khaki"			. "240 230 140")
+   ("palegoldenrod"		. "238 232 170")
+   ("lightgoldenrodyellow"	. "250 250 210")
+   ("lightyellow"		. "255 255 224")
+   ("yellow"			. "255 255 0")
+   ("gold"			. "255 215 0")
+   ("lightgoldenrod"		. "238 221 130")
+   ("goldenrod"			. "218 165 32")
+   ("darkgoldenrod"		. "184 134 11")
+   ("rosybrown"			. "188 143 143")
+   ("indianred"			. "205 92 92")
+   ("saddlebrown"		. "139 69 19")
+   ("sienna"			. "160 82 45")
+   ("peru"			. "205 133 63")
+   ("burlywood"			. "222 184 135")
+   ("beige"			. "245 245 220")
+   ("wheat"			. "245 222 179")
+   ("sandybrown"		. "244 164 96")
+   ("tan"			. "210 180 140")
+   ("chocolate"			. "210 105 30")
+   ("firebrick"			. "178 34 34")
+   ("brown"			. "165 42 42")
+   ("darksalmon"		. "233 150 122")
+   ("salmon"			. "250 128 114")
+   ("lightsalmon"		. "255 160 122")
+   ("orange"			. "255 165 0")
+   ("darkorange"		. "255 140 0")
+   ("coral"			. "255 127 80")
+   ("lightcoral"		. "240 128 128")
+   ("tomato"			. "255 99 71")
+   ("orangered"			. "255 69 0")
+   ("red"			. "255 0 0")
+   ("hotpink"			. "255 105 180")
+   ("deeppink"			. "255 20 147")
+   ("pink"			. "255 192 203")
+   ("lightpink"			. "255 182 193")
+   ("palevioletred"		. "219 112 147")
+   ("maroon"			. "176 48 96")
+   ("mediumvioletred"		. "199 21 133")
+   ("violetred"			. "208 32 144")
+   ("magenta"			. "255 0 255")
+   ("violet"			. "238 130 238")
+   ("plum"			. "221 160 221")
+   ("orchid"			. "218 112 214")
+   ("mediumorchid"		. "186 85 211")
+   ("darkorchid"		. "153 50 204")
+   ("darkviolet"		. "148 0 211")
+   ("blueviolet"		. "138 43 226")
+   ("purple"			. "160 32 240")
+   ("mediumpurple"		. "147 112 219")
+   ("thistle"			. "216 191 216")
+   ("snow1"			. "255 250 250")
+   ("snow2"			. "238 233 233")
+   ("snow3"			. "205 201 201")
+   ("snow4"			. "139 137 137")
+   ("seashell1"			. "255 245 238")
+   ("seashell2"			. "238 229 222")
+   ("seashell3"			. "205 197 191")
+   ("seashell4"			. "139 134 130")
+   ("antiquewhite1"		. "255 239 219")
+   ("antiquewhite2"		. "238 223 204")
+   ("antiquewhite3"		. "205 192 176")
+   ("antiquewhite4"		. "139 131 120")
+   ("bisque1"			. "255 228 196")
+   ("bisque2"			. "238 213 183")
+   ("bisque3"			. "205 183 158")
+   ("bisque4"			. "139 125 107")
+   ("peachpuff1"		. "255 218 185")
+   ("peachpuff2"		. "238 203 173")
+   ("peachpuff3"		. "205 175 149")
+   ("peachpuff4"		. "139 119 101")
+   ("navajowhite1"		. "255 222 173")
+   ("navajowhite2"		. "238 207 161")
+   ("navajowhite3"		. "205 179 139")
+   ("navajowhite4"		. "139 121 94")
+   ("lemonchiffon1"		. "255 250 205")
+   ("lemonchiffon2"		. "238 233 191")
+   ("lemonchiffon3"		. "205 201 165")
+   ("lemonchiffon4"		. "139 137 112")
+   ("cornsilk1"			. "255 248 220")
+   ("cornsilk2"			. "238 232 205")
+   ("cornsilk3"			. "205 200 177")
+   ("cornsilk4"			. "139 136 120")
+   ("ivory1"			. "255 255 240")
+   ("ivory2"			. "238 238 224")
+   ("ivory3"			. "205 205 193")
+   ("ivory4"			. "139 139 131")
+   ("honeydew1"			. "240 255 240")
+   ("honeydew2"			. "224 238 224")
+   ("honeydew3"			. "193 205 193")
+   ("honeydew4"			. "131 139 131")
+   ("lavenderblush1"		. "255 240 245")
+   ("lavenderblush2"		. "238 224 229")
+   ("lavenderblush3"		. "205 193 197")
+   ("lavenderblush4"		. "139 131 134")
+   ("mistyrose1"		. "255 228 225")
+   ("mistyrose2"		. "238 213 210")
+   ("mistyrose3"		. "205 183 181")
+   ("mistyrose4"		. "139 125 123")
+   ("azure1"			. "240 255 255")
+   ("azure2"			. "224 238 238")
+   ("azure3"			. "193 205 205")
+   ("azure4"			. "131 139 139")
+   ("slateblue1"		. "131 111 255")
+   ("slateblue2"		. "122 103 238")
+   ("slateblue3"		. "105 89 205")
+   ("slateblue4"		. "71 60 139")
+   ("royalblue1"		. "72 118 255")
+   ("royalblue2"		. "67 110 238")
+   ("royalblue3"		. "58 95 205")
+   ("royalblue4"		. "39 64 139")
+   ("blue1"			. "0 0 255")
+   ("blue2"			. "0 0 238")
+   ("blue3"			. "0 0 205")
+   ("blue4"			. "0 0 139")
+   ("dodgerblue1"		. "30 144 255")
+   ("dodgerblue2"		. "28 134 238")
+   ("dodgerblue3"		. "24 116 205")
+   ("dodgerblue4"		. "16 78 139")
+   ("steelblue1"		. "99 184 255")
+   ("steelblue2"		. "92 172 238")
+   ("steelblue3"		. "79 148 205")
+   ("steelblue4"		. "54 100 139")
+   ("deepskyblue1"		. "0 191 255")
+   ("deepskyblue2"		. "0 178 238")
+   ("deepskyblue3"		. "0 154 205")
+   ("deepskyblue4"		. "0 104 139")
+   ("skyblue1"			. "135 206 255")
+   ("skyblue2"			. "126 192 238")
+   ("skyblue3"			. "108 166 205")
+   ("skyblue4"			. "74 112 139")
+   ("lightskyblue1"		. "176 226 255")
+   ("lightskyblue2"		. "164 211 238")
+   ("lightskyblue3"		. "141 182 205")
+   ("lightskyblue4"		. "96 123 139")
+   ("lightsteelblue1"		. "202 225 255")
+   ("lightsteelblue2"		. "188 210 238")
+   ("lightsteelblue3"		. "162 181 205")
+   ("lightsteelblue4"		. "110 123 139")
+   ("lightblue1"		. "191 239 255")
+   ("lightblue2"		. "178 223 238")
+   ("lightblue3"		. "154 192 205")
+   ("lightblue4"		. "104 131 139")
+   ("lightcyan1"		. "224 255 255")
+   ("lightcyan2"		. "209 238 238")
+   ("lightcyan3"		. "180 205 205")
+   ("lightcyan4"		. "122 139 139")
+   ("paleturquoise1"		. "187 255 255")
+   ("paleturquoise2"		. "174 238 238")
+   ("paleturquoise3"		. "150 205 205")
+   ("paleturquoise4"		. "102 139 139")
+   ("cadetblue1"		. "152 245 255")
+   ("cadetblue2"		. "142 229 238")
+   ("cadetblue3"		. "122 197 205")
+   ("cadetblue4"		. "83 134 139")
+   ("turquoise1"		. "0 245 255")
+   ("turquoise2"		. "0 229 238")
+   ("turquoise3"		. "0 197 205")
+   ("turquoise4"		. "0 134 139")
+   ("cyan1"			. "0 255 255")
+   ("cyan2"			. "0 238 238")
+   ("cyan3"			. "0 205 205")
+   ("cyan4"			. "0 139 139")
+   ("aquamarine1"		. "127 255 212")
+   ("aquamarine2"		. "118 238 198")
+   ("aquamarine3"		. "102 205 170")
+   ("aquamarine4"		. "69 139 116")
+   ("darkseagreen1"		. "193 255 193")
+   ("darkseagreen2"		. "180 238 180")
+   ("darkseagreen3"		. "155 205 155")
+   ("darkseagreen4"		. "105 139 105")
+   ("seagreen1"			. "84 255 159")
+   ("seagreen2"			. "78 238 148")
+   ("seagreen3"			. "67 205 128")
+   ("seagreen4"			. "46 139 87")
+   ("palegreen1"		. "154 255 154")
+   ("palegreen2"		. "144 238 144")
+   ("palegreen3"		. "124 205 124")
+   ("palegreen4"		. "84 139 84")
+   ("springgreen1"		. "0 255 127")
+   ("springgreen2"		. "0 238 118")
+   ("springgreen3"		. "0 205 102")
+   ("springgreen4"		. "0 139 69")
+   ("green1"			. "0 255 0")
+   ("green2"			. "0 238 0")
+   ("green3"			. "0 205 0")
+   ("green4"			. "0 139 0")
+   ("chartreuse1"		. "127 255 0")
+   ("chartreuse2"		. "118 238 0")
+   ("chartreuse3"		. "102 205 0")
+   ("chartreuse4"		. "69 139 0")
+   ("olivedrab1"		. "192 255 62")
+   ("olivedrab2"		. "179 238 58")
+   ("olivedrab3"		. "154 205 50")
+   ("olivedrab4"		. "105 139 34")
+   ("darkolivegreen1"		. "202 255 112")
+   ("darkolivegreen2"		. "188 238 104")
+   ("darkolivegreen3"		. "162 205 90")
+   ("darkolivegreen4"		. "110 139 61")
+   ("khaki1"			. "255 246 143")
+   ("khaki2"			. "238 230 133")
+   ("khaki3"			. "205 198 115")
+   ("khaki4"			. "139 134 78")
+   ("lightgoldenrod1"		. "255 236 139")
+   ("lightgoldenrod2"		. "238 220 130")
+   ("lightgoldenrod3"		. "205 190 112")
+   ("lightgoldenrod4"		. "139 129 76")
+   ("lightyellow1"		. "255 255 224")
+   ("lightyellow2"		. "238 238 209")
+   ("lightyellow3"		. "205 205 180")
+   ("lightyellow4"		. "139 139 122")
+   ("yellow1"			. "255 255 0")
+   ("yellow2"			. "238 238 0")
+   ("yellow3"			. "205 205 0")
+   ("yellow4"			. "139 139 0")
+   ("gold1"			. "255 215 0")
+   ("gold2"			. "238 201 0")
+   ("gold3"			. "205 173 0")
+   ("gold4"			. "139 117 0")
+   ("goldenrod1"		. "255 193 37")
+   ("goldenrod2"		. "238 180 34")
+   ("goldenrod3"		. "205 155 29")
+   ("goldenrod4"		. "139 105 20")
+   ("darkgoldenrod1"		. "255 185 15")
+   ("darkgoldenrod2"		. "238 173 14")
+   ("darkgoldenrod3"		. "205 149 12")
+   ("darkgoldenrod4"		. "139 101 8")
+   ("rosybrown1"		. "255 193 193")
+   ("rosybrown2"		. "238 180 180")
+   ("rosybrown3"		. "205 155 155")
+   ("rosybrown4"		. "139 105 105")
+   ("indianred1"		. "255 106 106")
+   ("indianred2"		. "238 99 99")
+   ("indianred3"		. "205 85 85")
+   ("indianred4"		. "139 58 58")
+   ("sienna1"			. "255 130 71")
+   ("sienna2"			. "238 121 66")
+   ("sienna3"			. "205 104 57")
+   ("sienna4"			. "139 71 38")
+   ("burlywood1"		. "255 211 155")
+   ("burlywood2"		. "238 197 145")
+   ("burlywood3"		. "205 170 125")
+   ("burlywood4"		. "139 115 85")
+   ("wheat1"			. "255 231 186")
+   ("wheat2"			. "238 216 174")
+   ("wheat3"			. "205 186 150")
+   ("wheat4"			. "139 126 102")
+   ("tan1"			. "255 165 79")
+   ("tan2"			. "238 154 73")
+   ("tan3"			. "205 133 63")
+   ("tan4"			. "139 90 43")
+   ("chocolate1"		. "255 127 36")
+   ("chocolate2"		. "238 118 33")
+   ("chocolate3"		. "205 102 29")
+   ("chocolate4"		. "139 69 19")
+   ("firebrick1"		. "255 48 48")
+   ("firebrick2"		. "238 44 44")
+   ("firebrick3"		. "205 38 38")
+   ("firebrick4"		. "139 26 26")
+   ("brown1"			. "255 64 64")
+   ("brown2"			. "238 59 59")
+   ("brown3"			. "205 51 51")
+   ("brown4"			. "139 35 35")
+   ("salmon1"			. "255 140 105")
+   ("salmon2"			. "238 130 98")
+   ("salmon3"			. "205 112 84")
+   ("salmon4"			. "139 76 57")
+   ("lightsalmon1"		. "255 160 122")
+   ("lightsalmon2"		. "238 149 114")
+   ("lightsalmon3"		. "205 129 98")
+   ("lightsalmon4"		. "139 87 66")
+   ("orange1"			. "255 165 0")
+   ("orange2"			. "238 154 0")
+   ("orange3"			. "205 133 0")
+   ("orange4"			. "139 90 0")
+   ("darkorange1"		. "255 127 0")
+   ("darkorange2"		. "238 118 0")
+   ("darkorange3"		. "205 102 0")
+   ("darkorange4"		. "139 69 0")
+   ("coral1"			. "255 114 86")
+   ("coral2"			. "238 106 80")
+   ("coral3"			. "205 91 69")
+   ("coral4"			. "139 62 47")
+   ("tomato1"			. "255 99 71")
+   ("tomato2"			. "238 92 66")
+   ("tomato3"			. "205 79 57")
+   ("tomato4"			. "139 54 38")
+   ("orangered1"		. "255 69 0")
+   ("orangered2"		. "238 64 0")
+   ("orangered3"		. "205 55 0")
+   ("orangered4"		. "139 37 0")
+   ("red1"			. "255 0 0")
+   ("red2"			. "238 0 0")
+   ("red3"			. "205 0 0")
+   ("red4"			. "139 0 0")
+   ("deeppink1"			. "255 20 147")
+   ("deeppink2"			. "238 18 137")
+   ("deeppink3"			. "205 16 118")
+   ("deeppink4"			. "139 10 80")
+   ("hotpink1"			. "255 110 180")
+   ("hotpink2"			. "238 106 167")
+   ("hotpink3"			. "205 96 144")
+   ("hotpink4"			. "139 58 98")
+   ("pink1"			. "255 181 197")
+   ("pink2"			. "238 169 184")
+   ("pink3"			. "205 145 158")
+   ("pink4"			. "139 99 108")
+   ("lightpink1"		. "255 174 185")
+   ("lightpink2"		. "238 162 173")
+   ("lightpink3"		. "205 140 149")
+   ("lightpink4"		. "139 95 101")
+   ("palevioletred1"		. "255 130 171")
+   ("palevioletred2"		. "238 121 159")
+   ("palevioletred3"		. "205 104 137")
+   ("palevioletred4"		. "139 71 93")
+   ("maroon1"			. "255 52 179")
+   ("maroon2"			. "238 48 167")
+   ("maroon3"			. "205 41 144")
+   ("maroon4"			. "139 28 98")
+   ("violetred1"		. "255 62 150")
+   ("violetred2"		. "238 58 140")
+   ("violetred3"		. "205 50 120")
+   ("violetred4"		. "139 34 82")
+   ("magenta1"			. "255 0 255")
+   ("magenta2"			. "238 0 238")
+   ("magenta3"			. "205 0 205")
+   ("magenta4"			. "139 0 139")
+   ("orchid1"			. "255 131 250")
+   ("orchid2"			. "238 122 233")
+   ("orchid3"			. "205 105 201")
+   ("orchid4"			. "139 71 137")
+   ("plum1"			. "255 187 255")
+   ("plum2"			. "238 174 238")
+   ("plum3"			. "205 150 205")
+   ("plum4"			. "139 102 139")
+   ("mediumorchid1"		. "224 102 255")
+   ("mediumorchid2"		. "209 95 238")
+   ("mediumorchid3"		. "180 82 205")
+   ("mediumorchid4"		. "122 55 139")
+   ("darkorchid1"		. "191 62 255")
+   ("darkorchid2"		. "178 58 238")
+   ("darkorchid3"		. "154 50 205")
+   ("darkorchid4"		. "104 34 139")
+   ("purple1"			. "155 48 255")
+   ("purple2"			. "145 44 238")
+   ("purple3"			. "125 38 205")
+   ("purple4"			. "85 26 139")
+   ("mediumpurple1"		. "171 130 255")
+   ("mediumpurple2"		. "159 121 238")
+   ("mediumpurple3"		. "137 104 205")
+   ("mediumpurple4"		. "93 71 139")
+   ("thistle1"			. "255 225 255")
+   ("thistle2"			. "238 210 238")
+   ("thistle3"			. "205 181 205")
+   ("thistle4"			. "139 123 139")
+   ("grey0"			. "0 0 0")
+   ("grey1"			. "3 3 3")
+   ("grey2"			. "5 5 5")
+   ("grey3"			. "8 8 8")
+   ("grey4"			. "10 10 10")
+   ("grey5"			. "13 13 13")
+   ("grey6"			. "15 15 15")
+   ("grey7"			. "18 18 18")
+   ("grey8"			. "20 20 20")
+   ("grey9"			. "23 23 23")
+   ("grey10"			. "26 26 26")
+   ("grey11"			. "28 28 28")
+   ("grey12"			. "31 31 31")
+   ("grey13"			. "33 33 33")
+   ("grey14"			. "36 36 36")
+   ("grey15"			. "38 38 38")
+   ("grey16"			. "41 41 41")
+   ("grey17"			. "43 43 43")
+   ("grey18"			. "46 46 46")
+   ("grey19"			. "48 48 48")
+   ("grey20"			. "51 51 51")
+   ("grey21"			. "54 54 54")
+   ("grey22"			. "56 56 56")
+   ("grey23"			. "59 59 59")
+   ("grey24"			. "61 61 61")
+   ("grey25"			. "64 64 64")
+   ("grey26"			. "66 66 66")
+   ("grey27"			. "69 69 69")
+   ("grey28"			. "71 71 71")
+   ("grey29"			. "74 74 74")
+   ("grey30"			. "77 77 77")
+   ("grey31"			. "79 79 79")
+   ("grey32"			. "82 82 82")
+   ("grey33"			. "84 84 84")
+   ("grey34"			. "87 87 87")
+   ("grey35"			. "89 89 89")
+   ("grey36"			. "92 92 92")
+   ("grey37"			. "94 94 94")
+   ("grey38"			. "97 97 97")
+   ("grey39"			. "99 99 99")
+   ("grey40"			. "102 102 102")
+   ("grey41"			. "105 105 105")
+   ("grey42"			. "107 107 107")
+   ("grey43"			. "110 110 110")
+   ("grey44"			. "112 112 112")
+   ("grey45"			. "115 115 115")
+   ("grey46"			. "117 117 117")
+   ("grey47"			. "120 120 120")
+   ("grey48"			. "122 122 122")
+   ("grey49"			. "125 125 125")
+   ("grey50"			. "127 127 127")
+   ("grey51"			. "130 130 130")
+   ("grey52"			. "133 133 133")
+   ("grey53"			. "135 135 135")
+   ("grey54"			. "138 138 138")
+   ("grey55"			. "140 140 140")
+   ("grey56"			. "143 143 143")
+   ("grey57"			. "145 145 145")
+   ("grey58"			. "148 148 148")
+   ("grey59"			. "150 150 150")
+   ("grey60"			. "153 153 153")
+   ("grey61"			. "156 156 156")
+   ("grey62"			. "158 158 158")
+   ("grey63"			. "161 161 161")
+   ("grey64"			. "163 163 163")
+   ("grey65"			. "166 166 166")
+   ("grey66"			. "168 168 168")
+   ("grey67"			. "171 171 171")
+   ("grey68"			. "173 173 173")
+   ("grey69"			. "176 176 176")
+   ("grey70"			. "179 179 179")
+   ("grey71"			. "181 181 181")
+   ("grey72"			. "184 184 184")
+   ("grey73"			. "186 186 186")
+   ("grey74"			. "189 189 189")
+   ("grey75"			. "191 191 191")
+   ("grey76"			. "194 194 194")
+   ("grey77"			. "196 196 196")
+   ("grey78"			. "199 199 199")
+   ("grey79"			. "201 201 201")
+   ("grey80"			. "204 204 204")
+   ("grey81"			. "207 207 207")
+   ("grey82"			. "209 209 209")
+   ("grey83"			. "212 212 212")
+   ("grey84"			. "214 214 214")
+   ("grey85"			. "217 217 217")
+   ("grey86"			. "219 219 219")
+   ("grey87"			. "222 222 222")
+   ("grey88"			. "224 224 224")
+   ("grey89"			. "227 227 227")
+   ("grey90"			. "229 229 229")
+   ("grey91"			. "232 232 232")
+   ("grey92"			. "235 235 235")
+   ("grey93"			. "237 237 237")
+   ("grey94"			. "240 240 240")
+   ("grey95"			. "242 242 242")
+   ("grey96"			. "245 245 245")
+   ("grey97"			. "247 247 247")
+   ("grey98"			. "250 250 250")
+   ("grey99"			. "252 252 252")
+   ("grey100"			. "255 255 255")
+   ("darkgrey"			. "169 169 169")
+   ("darkblue"			. "0 0 139")
+   ("darkcyan"			. "0 139 139")
+   ("darkmagenta"		. "139 0 139")
+   ("darkred"			. "139 0 0")
+   ("lightgreen"		. "144 238 144")))
+
+
+(define (%convert-color str)
+  (let ((col (assoc str *skribe-rgb-alist*)))
+    (cond
+      (col
+       (let* ((p (open-input-string (cdr col)))
+	      (r (read p))
+	      (g (read p))
+	      (b (read p)))
+	 (values r g b)))
+      ((and (string? str) (eq? (string-ref str 0) #\#) (= (string-length str) 7))
+       (values (string->number (substring str 1 3) 16)
+	       (string->number (substring str 3 5) 16)
+	       (string->number (substring str 5 7) 16)))
+      ((and (string? str) (eq? (string-ref str 0) #\#) (= (string-length str) 13))
+       (values (string->number (substring str 1 5) 16)
+	       (string->number (substring str 5 9) 16)
+	       (string->number (substring str 9 13) 16)))
+      (else
+       (values 0 0 0)))))
+
+;;;
+;;; SKRIBE-COLOR->RGB
+;;;
+(define (skribe-color->rgb spec)
+  (cond
+    ((string? spec) (%convert-color spec))
+    ((integer? spec)
+       (values (bitwise-and #xff (arithmetic-shift spec -16))
+	       (bitwise-and #xff (arithmetic-shift spec -8))
+	       (bitwise-and #xff spec)))
+    (else
+     (values 0 0 0))))
+
+;;;
+;;; SKRIBE-GET-USED-COLORS
+;;;
+(define (skribe-get-used-colors)
+   *used-colors*)
+
+;;;
+;;; SKRIBE-USE-COLOR!
+;;;
+(define (skribe-use-color! color)
+  (set! *used-colors* (cons color *used-colors*))
+  color)
diff --git a/src/guile/skribilo/coloring/Makefile.am b/src/guile/skribilo/coloring/Makefile.am
new file mode 100644
index 0000000..b952237
--- /dev/null
+++ b/src/guile/skribilo/coloring/Makefile.am
@@ -0,0 +1,16 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/coloring
+dist_guilemodule_DATA = c.scm lisp.scm xml.scm				\
+			lisp-lex.l.scm xml-lex.l.scm c-lex.l.scm
+
+
+EXTRA_DIST = lisp-lex.l xml-lex.l c-lex.l
+
+# Building the lexers with SILex.  You must previously run
+# `tla build-config ./arch-config' for this to run.
+#
+# Note: Those files should normally be part of the distribution, making
+# this rule useless to the user.
+%.l.scm: %.l
+	$(GUILE) -L $(top_srcdir)/src/guile/silex			\
+	         -c '(load-from-path "lex.scm") (lex "$^" "$@")'
+
diff --git a/src/guile/skribilo/coloring/c-lex.l b/src/guile/skribilo/coloring/c-lex.l
new file mode 100644
index 0000000..7d7b1ce
--- /dev/null
+++ b/src/guile/skribilo/coloring/c-lex.l
@@ -0,0 +1,67 @@
+;;;;
+;;;; c-lex.l			-- C fontifier for Skribe
+;;;; 
+;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;; 
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 
+;;;; USA.
+;;;; 
+;;;;           Author: Erick Gallesio [eg@essi.fr]
+;;;;    Creation date:  6-Mar-2004 15:35 (eg)
+;;;; Last file update:  7-Mar-2004 00:10 (eg)
+;;;;
+
+space	 [ \n\9]
+letter   [_a-zA-Z]
+alphanum [_a-zA-Z0-9]
+
+%%
+
+;; Strings
+\"[^\"]*\"		(new markup
+			     (markup '&source-string)
+			     (body yytext))
+;;Comments
+/\*.*\*/		(new markup
+			     (markup '&source-line-comment)
+			     (body   yytext))
+//.*			(new markup
+			     (markup '&source-line-comment)
+			     (body   yytext))
+
+;; Identifiers (only letters since we are interested in keywords only)
+[_a-zA-Z]+		(let* ((ident (string->symbol yytext))
+			       (tmp   (memq  ident *the-keys*)))
+			  (if tmp
+			      (new markup
+				   (markup '&source-module)
+				   (body yytext))
+			      yytext))
+
+;; Regular text
+[^\"a-zA-Z]+		(begin yytext)
+
+
+
+<<EOF>>			'eof
+<<ERROR>>		(skribe-error 'lisp-fontifier "Parse error" yytext)
+
+				   
+			    
+			      
+			      
+
+			  
\ No newline at end of file
diff --git a/src/guile/skribilo/coloring/c-lex.l.scm b/src/guile/skribilo/coloring/c-lex.l.scm
new file mode 100644
index 0000000..d78e09e
--- /dev/null
+++ b/src/guile/skribilo/coloring/c-lex.l.scm
@@ -0,0 +1,1225 @@
+; *** This file starts with a copy of the file multilex.scm ***
+; SILex - Scheme Implementation of Lex
+; Copyright (C) 2001  Danny Dube'
+; 
+; This program is free software; you can redistribute it and/or
+; modify it under the terms of the GNU General Public License
+; as published by the Free Software Foundation; either version 2
+; of the License, or (at your option) any later version.
+; 
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+; GNU General Public License for more details.
+; 
+; You should have received a copy of the GNU General Public License
+; along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+;
+; Gestion des Input Systems
+; Fonctions a utiliser par l'usager:
+;   lexer-make-IS, lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+;
+
+; Taille initiale par defaut du buffer d'entree
+(define lexer-init-buffer-len 1024)
+
+; Numero du caractere newline
+(define lexer-integer-newline (char->integer #\newline))
+
+; Constructeur d'IS brut
+(define lexer-raw-IS-maker
+  (lambda (buffer read-ptr input-f counters)
+    (let ((input-f          input-f)                ; Entree reelle
+	  (buffer           buffer)                 ; Buffer
+	  (buflen           (string-length buffer))
+	  (read-ptr         read-ptr)
+	  (start-ptr        1)                      ; Marque de debut de lexeme
+	  (start-line       1)
+	  (start-column     1)
+	  (start-offset     0)
+	  (end-ptr          1)                      ; Marque de fin de lexeme
+	  (point-ptr        1)                      ; Le point
+	  (user-ptr         1)                      ; Marque de l'usager
+	  (user-line        1)
+	  (user-column      1)
+	  (user-offset      0)
+	  (user-up-to-date? #t))                    ; Concerne la colonne seul.
+      (letrec
+	  ((start-go-to-end-none         ; Fonctions de depl. des marques
+	    (lambda ()
+	      (set! start-ptr end-ptr)))
+	   (start-go-to-end-line
+	    (lambda ()
+	      (let loop ((ptr start-ptr) (line start-line))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1))
+			(loop (+ ptr 1) line))))))
+	   (start-go-to-end-all
+	    (lambda ()
+	      (set! start-offset (+ start-offset (- end-ptr start-ptr)))
+	      (let loop ((ptr start-ptr)
+			 (line start-line)
+			 (column start-column))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line)
+		      (set! start-column column))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1) 1)
+			(loop (+ ptr 1) line (+ column 1)))))))
+	   (start-go-to-user-none
+	    (lambda ()
+	      (set! start-ptr user-ptr)))
+	   (start-go-to-user-line
+	    (lambda ()
+	      (set! start-ptr user-ptr)
+	      (set! start-line user-line)))
+	   (start-go-to-user-all
+	    (lambda ()
+	      (set! start-line user-line)
+	      (set! start-offset user-offset)
+	      (if user-up-to-date?
+		  (begin
+		    (set! start-ptr user-ptr)
+		    (set! start-column user-column))
+		  (let loop ((ptr start-ptr) (column start-column))
+		    (if (= ptr user-ptr)
+			(begin
+			  (set! start-ptr ptr)
+			  (set! start-column column))
+			(if (char=? (string-ref buffer ptr) #\newline)
+			    (loop (+ ptr 1) 1)
+			    (loop (+ ptr 1) (+ column 1))))))))
+	   (end-go-to-point
+	    (lambda ()
+	      (set! end-ptr point-ptr)))
+	   (point-go-to-start
+	    (lambda ()
+	      (set! point-ptr start-ptr)))
+	   (user-go-to-start-none
+	    (lambda ()
+	      (set! user-ptr start-ptr)))
+	   (user-go-to-start-line
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)))
+	   (user-go-to-start-all
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)
+	      (set! user-column start-column)
+	      (set! user-offset start-offset)
+	      (set! user-up-to-date? #t)))
+	   (init-lexeme-none             ; Debute un nouveau lexeme
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-none))
+	      (point-go-to-start)))
+	   (init-lexeme-line
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-line))
+	      (point-go-to-start)))
+	   (init-lexeme-all
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-all))
+	      (point-go-to-start)))
+	   (get-start-line               ; Obtention des stats du debut du lxm
+	    (lambda ()
+	      start-line))
+	   (get-start-column
+	    (lambda ()
+	      start-column))
+	   (get-start-offset
+	    (lambda ()
+	      start-offset))
+	   (peek-left-context            ; Obtention de caracteres (#f si EOF)
+	    (lambda ()
+	      (char->integer (string-ref buffer (- start-ptr 1)))))
+	   (peek-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (char->integer (string-ref buffer point-ptr))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (read-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (let ((c (string-ref buffer point-ptr)))
+		    (set! point-ptr (+ point-ptr 1))
+		    (char->integer c))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (set! point-ptr read-ptr)
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (get-start-end-text           ; Obtention du lexeme
+	    (lambda ()
+	      (substring buffer start-ptr end-ptr)))
+	   (get-user-line-line           ; Fonctions pour l'usager
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      user-line))
+	   (get-user-line-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-line))
+	   (get-user-column-all
+	    (lambda ()
+	      (cond ((< user-ptr start-ptr)
+		     (user-go-to-start-all)
+		     user-column)
+		    (user-up-to-date?
+		     user-column)
+		    (else
+		     (let loop ((ptr start-ptr) (column start-column))
+		       (if (= ptr user-ptr)
+			   (begin
+			     (set! user-column column)
+			     (set! user-up-to-date? #t)
+			     column)
+			   (if (char=? (string-ref buffer ptr) #\newline)
+			       (loop (+ ptr 1) 1)
+			       (loop (+ ptr 1) (+ column 1)))))))))
+	   (get-user-offset-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-offset))
+	   (user-getc-none
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-none))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-line
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(set! user-line (+ user-line 1)))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (set! user-line (+ user-line 1)))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(begin
+			  (set! user-line (+ user-line 1))
+			  (set! user-column 1))
+			(set! user-column (+ user-column 1)))
+		    (set! user-offset (+ user-offset 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (begin
+				(set! user-line (+ user-line 1))
+				(set! user-column 1))
+			      (set! user-column (+ user-column 1)))
+			  (set! user-offset (+ user-offset 1))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-ungetc-none
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (set! user-ptr (- user-ptr 1)))))
+	   (user-ungetc-line
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (set! user-line (- user-line 1))))))))
+	   (user-ungetc-all
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (begin
+			    (set! user-line (- user-line 1))
+			    (set! user-up-to-date? #f))
+			  (set! user-column (- user-column 1)))
+		      (set! user-offset (- user-offset 1)))))))
+	   (reorganize-buffer            ; Decaler ou agrandir le buffer
+	    (lambda ()
+	      (if (< (* 2 start-ptr) buflen)
+		  (let* ((newlen (* 2 buflen))
+			 (newbuf (make-string newlen))
+			 (delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! newbuf
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! buffer    newbuf)
+		    (set! buflen    newlen)
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))
+		  (let ((delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! buffer
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))))))
+	(list (cons 'start-go-to-end
+		    (cond ((eq? counters 'none) start-go-to-end-none)
+			  ((eq? counters 'line) start-go-to-end-line)
+			  ((eq? counters 'all ) start-go-to-end-all)))
+	      (cons 'end-go-to-point
+		    end-go-to-point)
+	      (cons 'init-lexeme
+		    (cond ((eq? counters 'none) init-lexeme-none)
+			  ((eq? counters 'line) init-lexeme-line)
+			  ((eq? counters 'all ) init-lexeme-all)))
+	      (cons 'get-start-line
+		    get-start-line)
+	      (cons 'get-start-column
+		    get-start-column)
+	      (cons 'get-start-offset
+		    get-start-offset)
+	      (cons 'peek-left-context
+		    peek-left-context)
+	      (cons 'peek-char
+		    peek-char)
+	      (cons 'read-char
+		    read-char)
+	      (cons 'get-start-end-text
+		    get-start-end-text)
+	      (cons 'get-user-line
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) get-user-line-line)
+			  ((eq? counters 'all ) get-user-line-all)))
+	      (cons 'get-user-column
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-column-all)))
+	      (cons 'get-user-offset
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-offset-all)))
+	      (cons 'user-getc
+		    (cond ((eq? counters 'none) user-getc-none)
+			  ((eq? counters 'line) user-getc-line)
+			  ((eq? counters 'all ) user-getc-all)))
+	      (cons 'user-ungetc
+		    (cond ((eq? counters 'none) user-ungetc-none)
+			  ((eq? counters 'line) user-ungetc-line)
+			  ((eq? counters 'all ) user-ungetc-all))))))))
+
+; Construit un Input System
+; Le premier parametre doit etre parmi "port", "procedure" ou "string"
+; Prend un parametre facultatif qui doit etre parmi
+; "none", "line" ou "all"
+(define lexer-make-IS
+  (lambda (input-type input . largs)
+    (let ((counters-type (cond ((null? largs)
+				'line)
+			       ((memq (car largs) '(none line all))
+				(car largs))
+			       (else
+				'line))))
+      (cond ((and (eq? input-type 'port) (input-port? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () (read-char input))))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'procedure) (procedure? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  input))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'string) (string? input))
+	     (let* ((buffer   (string-append (string #\newline) input))
+		    (read-ptr (string-length buffer))
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    (else
+	     (let* ((buffer   (string #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))))))
+
+; Les fonctions:
+;   lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+(define lexer-get-func-getc
+  (lambda (IS) (cdr (assq 'user-getc IS))))
+(define lexer-get-func-ungetc
+  (lambda (IS) (cdr (assq 'user-ungetc IS))))
+(define lexer-get-func-line
+  (lambda (IS) (cdr (assq 'get-user-line IS))))
+(define lexer-get-func-column
+  (lambda (IS) (cdr (assq 'get-user-column IS))))
+(define lexer-get-func-offset
+  (lambda (IS) (cdr (assq 'get-user-offset IS))))
+
+;
+; Gestion des lexers
+;
+
+; Fabrication de lexer a partir d'arbres de decision
+(define lexer-make-tree-lexer
+  (lambda (tables IS)
+    (letrec
+	(; Contenu de la table
+	 (counters-type        (vector-ref tables 0))
+	 (<<EOF>>-pre-action   (vector-ref tables 1))
+	 (<<ERROR>>-pre-action (vector-ref tables 2))
+	 (rules-pre-actions    (vector-ref tables 3))
+	 (table-nl-start       (vector-ref tables 5))
+	 (table-no-nl-start    (vector-ref tables 6))
+	 (trees-v              (vector-ref tables 7))
+	 (acc-v                (vector-ref tables 8))
+
+	 ; Contenu du IS
+	 (IS-start-go-to-end    (cdr (assq 'start-go-to-end IS)))
+	 (IS-end-go-to-point    (cdr (assq 'end-go-to-point IS)))
+	 (IS-init-lexeme        (cdr (assq 'init-lexeme IS)))
+	 (IS-get-start-line     (cdr (assq 'get-start-line IS)))
+	 (IS-get-start-column   (cdr (assq 'get-start-column IS)))
+	 (IS-get-start-offset   (cdr (assq 'get-start-offset IS)))
+	 (IS-peek-left-context  (cdr (assq 'peek-left-context IS)))
+	 (IS-peek-char          (cdr (assq 'peek-char IS)))
+	 (IS-read-char          (cdr (assq 'read-char IS)))
+	 (IS-get-start-end-text (cdr (assq 'get-start-end-text IS)))
+	 (IS-get-user-line      (cdr (assq 'get-user-line IS)))
+	 (IS-get-user-column    (cdr (assq 'get-user-column IS)))
+	 (IS-get-user-offset    (cdr (assq 'get-user-offset IS)))
+	 (IS-user-getc          (cdr (assq 'user-getc IS)))
+	 (IS-user-ungetc        (cdr (assq 'user-ungetc IS)))
+
+	 ; Resultats
+	 (<<EOF>>-action   #f)
+	 (<<ERROR>>-action #f)
+	 (rules-actions    #f)
+	 (states           #f)
+	 (final-lexer      #f)
+
+	 ; Gestion des hooks
+	 (hook-list '())
+	 (add-hook
+	  (lambda (thunk)
+	    (set! hook-list (cons thunk hook-list))))
+	 (apply-hooks
+	  (lambda ()
+	    (let loop ((l hook-list))
+	      (if (pair? l)
+		  (begin
+		    ((car l))
+		    (loop (cdr l)))))))
+
+	 ; Preparation des actions
+	 (set-action-statics
+	  (lambda (pre-action)
+	    (pre-action final-lexer IS-user-getc IS-user-ungetc)))
+	 (prepare-special-action-none
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda ()
+		       (action "")))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-line
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (action "" yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-all
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (action "" yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-special-action-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-special-action-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-special-action-all  pre-action)))))
+	 (prepare-action-yytext-none
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-line
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-all
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline yycolumn yyoffset))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-yytext-all  pre-action)))))
+	 (prepare-action-no-yytext-none
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (start-go-to-end)
+		       (action)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-line
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (start-go-to-end)
+		       (action yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-all
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (start-go-to-end)
+		       (action yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-no-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-no-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-no-yytext-all  pre-action)))))
+
+	 ; Fabrique les fonctions de dispatch
+	 (prepare-dispatch-err
+	  (lambda (leaf)
+	    (lambda (c)
+	      #f)))
+	 (prepare-dispatch-number
+	  (lambda (leaf)
+	    (let ((state-function #f))
+	      (let ((result
+		     (lambda (c)
+		       state-function))
+		    (hook
+		     (lambda ()
+		       (set! state-function (vector-ref states leaf)))))
+		(add-hook hook)
+		result))))
+	 (prepare-dispatch-leaf
+	  (lambda (leaf)
+	    (if (eq? leaf 'err)
+		(prepare-dispatch-err leaf)
+		(prepare-dispatch-number leaf))))
+	 (prepare-dispatch-<
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 1))
+		  (right-tree (list-ref tree 2)))
+	      (let ((bound      (list-ref tree 0))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (< c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-=
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 2))
+		  (right-tree (list-ref tree 3)))
+	      (let ((bound      (list-ref tree 1))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (= c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-tree
+	  (lambda (tree)
+	    (cond ((not (pair? tree))
+		   (prepare-dispatch-leaf tree))
+		  ((eq? (car tree) '=)
+		   (prepare-dispatch-= tree))
+		  (else
+		   (prepare-dispatch-< tree)))))
+	 (prepare-dispatch
+	  (lambda (tree)
+	    (let ((dicho-func (prepare-dispatch-tree tree)))
+	      (lambda (c)
+		(and c (dicho-func c))))))
+
+	 ; Fabrique les fonctions de transition (read & go) et (abort)
+	 (prepare-read-n-go
+	  (lambda (tree)
+	    (let ((dispatch-func (prepare-dispatch tree))
+		  (read-char     IS-read-char))
+	      (lambda ()
+		(dispatch-func (read-char))))))
+	 (prepare-abort
+	  (lambda (tree)
+	    (lambda ()
+	      #f)))
+	 (prepare-transition
+	  (lambda (tree)
+	    (if (eq? tree 'err)
+		(prepare-abort     tree)
+		(prepare-read-n-go tree))))
+
+	 ; Fabrique les fonctions d'etats ([set-end] & trans)
+	 (prepare-state-no-acc
+	   (lambda (s r1 r2)
+	     (let ((trans-func (prepare-transition (vector-ref trees-v s))))
+	       (lambda (action)
+		 (let ((next-state (trans-func)))
+		   (if next-state
+		       (next-state action)
+		       action))))))
+	 (prepare-state-yes-no
+	  (lambda (s r1 r2)
+	    (let ((peek-char       IS-peek-char)
+		  (end-go-to-point IS-end-go-to-point)
+		  (new-action1     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   (begin
+				     (end-go-to-point)
+				     new-action1)
+				   action))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-diff-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (peek-char       IS-peek-char)
+		  (new-action1     #f)
+		  (new-action2     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   new-action1
+				   new-action2))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1))
+		       (set! new-action2 (vector-ref rules-actions r2)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-same-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (trans-func (prepare-transition (vector-ref trees-v s)))
+		  (new-action #f))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let ((next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state
+	  (lambda (s)
+	    (let* ((acc (vector-ref acc-v s))
+		   (r1 (car acc))
+		   (r2 (cdr acc)))
+	      (cond ((not r1)  (prepare-state-no-acc   s r1 r2))
+		    ((not r2)  (prepare-state-yes-no   s r1 r2))
+		    ((< r1 r2) (prepare-state-diff-acc s r1 r2))
+		    (else      (prepare-state-same-acc s r1 r2))))))
+
+	 ; Fabrique la fonction de lancement du lexage a l'etat de depart
+	 (prepare-start-same
+	  (lambda (s1 s2)
+	    (let ((peek-char    IS-peek-char)
+		  (eof-action   #f)
+		  (start-state  #f)
+		  (error-action #f))
+	      (let ((result
+		     (lambda ()
+		       (if (not (peek-char))
+			   eof-action
+			   (start-state error-action))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action   <<EOF>>-action)
+		       (set! start-state  (vector-ref states s1))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start-diff
+	  (lambda (s1 s2)
+	    (let ((peek-char         IS-peek-char)
+		  (eof-action        #f)
+		  (peek-left-context IS-peek-left-context)
+		  (start-state1      #f)
+		  (start-state2      #f)
+		  (error-action      #f))
+	      (let ((result
+		     (lambda ()
+		       (cond ((not (peek-char))
+			      eof-action)
+			     ((= (peek-left-context) lexer-integer-newline)
+			      (start-state1 error-action))
+			     (else
+			      (start-state2 error-action)))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action <<EOF>>-action)
+		       (set! start-state1 (vector-ref states s1))
+		       (set! start-state2 (vector-ref states s2))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start
+	  (lambda ()
+	    (let ((s1 table-nl-start)
+		  (s2 table-no-nl-start))
+	      (if (= s1 s2)
+		  (prepare-start-same s1 s2)
+		  (prepare-start-diff s1 s2)))))
+
+	 ; Fabrique la fonction principale
+	 (prepare-lexer-none
+	  (lambda ()
+	    (let ((init-lexeme IS-init-lexeme)
+		  (start-func  (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		((start-func))))))
+	 (prepare-lexer-line
+	  (lambda ()
+	    (let ((init-lexeme    IS-init-lexeme)
+		  (get-start-line IS-get-start-line)
+		  (start-func     (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline (get-start-line)))
+		  ((start-func) yyline))))))
+	 (prepare-lexer-all
+	  (lambda ()
+	    (let ((init-lexeme      IS-init-lexeme)
+		  (get-start-line   IS-get-start-line)
+		  (get-start-column IS-get-start-column)
+		  (get-start-offset IS-get-start-offset)
+		  (start-func       (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline   (get-start-line))
+		      (yycolumn (get-start-column))
+		      (yyoffset (get-start-offset)))
+		  ((start-func) yyline yycolumn yyoffset))))))
+	 (prepare-lexer
+	  (lambda ()
+	    (cond ((eq? counters-type 'none) (prepare-lexer-none))
+		  ((eq? counters-type 'line) (prepare-lexer-line))
+		  ((eq? counters-type 'all)  (prepare-lexer-all))))))
+
+      ; Calculer la valeur de <<EOF>>-action et de <<ERROR>>-action
+      (set! <<EOF>>-action   (prepare-special-action <<EOF>>-pre-action))
+      (set! <<ERROR>>-action (prepare-special-action <<ERROR>>-pre-action))
+
+      ; Calculer la valeur de rules-actions
+      (let* ((len (quotient (vector-length rules-pre-actions) 2))
+	     (v (make-vector len)))
+	(let loop ((r (- len 1)))
+	  (if (< r 0)
+	      (set! rules-actions v)
+	      (let* ((yytext? (vector-ref rules-pre-actions (* 2 r)))
+		     (pre-action (vector-ref rules-pre-actions (+ (* 2 r) 1)))
+		     (action (if yytext?
+				 (prepare-action-yytext    pre-action)
+				 (prepare-action-no-yytext pre-action))))
+		(vector-set! v r action)
+		(loop (- r 1))))))
+
+      ; Calculer la valeur de states
+      (let* ((len (vector-length trees-v))
+	     (v (make-vector len)))
+	(let loop ((s (- len 1)))
+	  (if (< s 0)
+	      (set! states v)
+	      (begin
+		(vector-set! v s (prepare-state s))
+		(loop (- s 1))))))
+
+      ; Calculer la valeur de final-lexer
+      (set! final-lexer (prepare-lexer))
+
+      ; Executer les hooks
+      (apply-hooks)
+
+      ; Resultat
+      final-lexer)))
+
+; Fabrication de lexer a partir de listes de caracteres taggees
+(define lexer-make-char-lexer
+  (let* ((char->class
+	  (lambda (c)
+	    (let ((n (char->integer c)))
+	      (list (cons n n)))))
+	 (merge-sort
+	  (lambda (l combine zero-elt)
+	    (if (null? l)
+		zero-elt
+		(let loop1 ((l l))
+		  (if (null? (cdr l))
+		      (car l)
+		      (loop1
+		       (let loop2 ((l l))
+			 (cond ((null? l)
+				l)
+			       ((null? (cdr l))
+				l)
+			       (else
+				(cons (combine (car l) (cadr l))
+				      (loop2 (cddr l))))))))))))
+	 (finite-class-union
+	  (lambda (c1 c2)
+	    (let loop ((c1 c1) (c2 c2) (u '()))
+	      (if (null? c1)
+		  (if (null? c2)
+		      (reverse u)
+		      (loop c1 (cdr c2) (cons (car c2) u)))
+		  (if (null? c2)
+		      (loop (cdr c1) c2 (cons (car c1) u))
+		      (let* ((r1 (car c1))
+			     (r2 (car c2))
+			     (r1start (car r1))
+			     (r1end (cdr r1))
+			     (r2start (car r2))
+			     (r2end (cdr r2)))
+			(if (<= r1start r2start)
+			    (cond ((< (+ r1end 1) r2start)
+				   (loop (cdr c1) c2 (cons r1 u)))
+				  ((<= r1end r2end)
+				   (loop (cdr c1)
+					 (cons (cons r1start r2end) (cdr c2))
+					 u))
+				  (else
+				   (loop c1 (cdr c2) u)))
+			    (cond ((> r1start (+ r2end 1))
+				   (loop c1 (cdr c2) (cons r2 u)))
+				  ((>= r1end r2end)
+				   (loop (cons (cons r2start r1end) (cdr c1))
+					 (cdr c2)
+					 u))
+				  (else
+				   (loop (cdr c1) c2 u))))))))))
+	 (char-list->class
+	  (lambda (cl)
+	    (let ((classes (map char->class cl)))
+	      (merge-sort classes finite-class-union '()))))
+	 (class-<
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  (else (< b1 b2)))))
+	 (finite-class-compl
+	  (lambda (c)
+	    (let loop ((c c) (start 'inf-))
+	      (if (null? c)
+		  (list (cons start 'inf+))
+		  (let* ((r (car c))
+			 (rstart (car r))
+			 (rend (cdr r)))
+		    (if (class-< start rstart)
+			(cons (cons start (- rstart 1))
+			      (loop c rstart))
+			(loop (cdr c) (+ rend 1))))))))
+	 (tagged-chars->class
+	  (lambda (tcl)
+	    (let* ((inverse? (car tcl))
+		   (cl (cdr tcl))
+		   (class-tmp (char-list->class cl)))
+	      (if inverse? (finite-class-compl class-tmp) class-tmp))))
+	 (charc->arc
+	  (lambda (charc)
+	    (let* ((tcl (car charc))
+		   (dest (cdr charc))
+		   (class (tagged-chars->class tcl)))
+	      (cons class dest))))
+	 (arc->sharcs
+	  (lambda (arc)
+	    (let* ((range-l (car arc))
+		   (dest (cdr arc))
+		   (op (lambda (range) (cons range dest))))
+	      (map op range-l))))
+	 (class-<=
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  (else (<= b1 b2)))))
+	 (sharc-<=
+	  (lambda (sharc1 sharc2)
+	    (class-<= (caar sharc1) (caar sharc2))))
+	 (merge-sharcs
+	  (lambda (l1 l2)
+	    (let loop ((l1 l1) (l2 l2))
+	      (cond ((null? l1)
+		     l2)
+		    ((null? l2)
+		     l1)
+		    (else
+		     (let ((sharc1 (car l1))
+			   (sharc2 (car l2)))
+		       (if (sharc-<= sharc1 sharc2)
+			   (cons sharc1 (loop (cdr l1) l2))
+			   (cons sharc2 (loop l1 (cdr l2))))))))))
+	 (class-= eqv?)
+	 (fill-error
+	  (lambda (sharcs)
+	    (let loop ((sharcs sharcs) (start 'inf-))
+	      (cond ((class-= start 'inf+)
+		     '())
+		    ((null? sharcs)
+		     (cons (cons (cons start 'inf+) 'err)
+			   (loop sharcs 'inf+)))
+		    (else
+		     (let* ((sharc (car sharcs))
+			    (h (caar sharc))
+			    (t (cdar sharc)))
+		       (if (class-< start h)
+			   (cons (cons (cons start (- h 1)) 'err)
+				 (loop sharcs h))
+			   (cons sharc (loop (cdr sharcs)
+					     (if (class-= t 'inf+)
+						 'inf+
+						 (+ t 1)))))))))))
+	 (charcs->tree
+	  (lambda (charcs)
+	    (let* ((op (lambda (charc) (arc->sharcs (charc->arc charc))))
+		   (sharcs-l (map op charcs))
+		   (sorted-sharcs (merge-sort sharcs-l merge-sharcs '()))
+		   (full-sharcs (fill-error sorted-sharcs))
+		   (op (lambda (sharc) (cons (caar sharc) (cdr sharc))))
+		   (table (list->vector (map op full-sharcs))))
+	      (let loop ((left 0) (right (- (vector-length table) 1)))
+		(if (= left right)
+		    (cdr (vector-ref table left))
+		    (let ((mid (quotient (+ left right 1) 2)))
+		      (if (and (= (+ left 2) right)
+			       (= (+ (car (vector-ref table mid)) 1)
+				  (car (vector-ref table right)))
+			       (eqv? (cdr (vector-ref table left))
+				     (cdr (vector-ref table right))))
+			  (list '=
+				(car (vector-ref table mid))
+				(cdr (vector-ref table mid))
+				(cdr (vector-ref table left)))
+			  (list (car (vector-ref table mid))
+				(loop left (- mid 1))
+				(loop mid right))))))))))
+    (lambda (tables IS)
+      (let ((counters         (vector-ref tables 0))
+	    (<<EOF>>-action   (vector-ref tables 1))
+	    (<<ERROR>>-action (vector-ref tables 2))
+	    (rules-actions    (vector-ref tables 3))
+	    (nl-start         (vector-ref tables 5))
+	    (no-nl-start      (vector-ref tables 6))
+	    (charcs-v         (vector-ref tables 7))
+	    (acc-v            (vector-ref tables 8)))
+	(let* ((len (vector-length charcs-v))
+	       (v (make-vector len)))
+	  (let loop ((i (- len 1)))
+	    (if (>= i 0)
+		(begin
+		  (vector-set! v i (charcs->tree (vector-ref charcs-v i)))
+		  (loop (- i 1)))
+		(lexer-make-tree-lexer
+		 (vector counters
+			 <<EOF>>-action
+			 <<ERROR>>-action
+			 rules-actions
+			 'decision-trees
+			 nl-start
+			 no-nl-start
+			 v
+			 acc-v)
+		 IS))))))))
+
+; Fabrication d'un lexer a partir de code pre-genere
+(define lexer-make-code-lexer
+  (lambda (tables IS)
+    (let ((<<EOF>>-pre-action   (vector-ref tables 1))
+	  (<<ERROR>>-pre-action (vector-ref tables 2))
+	  (rules-pre-action     (vector-ref tables 3))
+	  (code                 (vector-ref tables 5)))
+      (code <<EOF>>-pre-action <<ERROR>>-pre-action rules-pre-action IS))))
+
+(define lexer-make-lexer
+  (lambda (tables IS)
+    (let ((automaton-type (vector-ref tables 4)))
+      (cond ((eq? automaton-type 'decision-trees)
+	     (lexer-make-tree-lexer tables IS))
+	    ((eq? automaton-type 'tagged-chars-lists)
+	     (lexer-make-char-lexer tables IS))
+	    ((eq? automaton-type 'code)
+	     (lexer-make-code-lexer tables IS))))))
+
+;
+; Table generated from the file c-lex.l by SILex 1.0
+;
+
+(define lexer-default-table
+  (vector
+   'line
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+       			'eof
+       ))
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+         		(skribe-error 'lisp-fontifier "Parse error" yytext)
+       ))
+   (vector
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+          		(new markup
+			     (markup '&source-string)
+			     (body yytext))
+;;Comments
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+        		(new markup
+			     (markup '&source-line-comment)
+			     (body   yytext))
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+    			(new markup
+			     (markup '&source-line-comment)
+			     (body   yytext))
+
+;; Identifiers (only letters since we are interested in keywords only)
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+          		(let* ((ident (string->symbol yytext))
+			       (tmp   (memq  ident *the-keys*)))
+			  (if tmp
+			      (new markup
+				   (markup '&source-module)
+				   (body yytext))
+			      yytext))
+
+;; Regular text
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+            		(begin yytext)
+        )))
+   'decision-trees
+   0
+   0
+   '#((65 (35 (34 1 5) (= 47 4 1)) (96 (91 3 (95 1 2)) (97 1 (123 3 1))))
+    (65 (= 34 err 1) (97 (91 err 1) (123 err 1))) (91 (35 (34 1 err) (65 1
+    3)) (96 (95 1 2) (97 1 (123 3 1)))) (95 (65 err (91 3 err)) (97 (96 3
+    err) (123 3 err))) (47 (35 (34 1 err) (= 42 7 1)) (91 (48 6 (65 1 err))
+    (97 1 (123 err 1)))) (= 34 8 5) (35 (11 (10 6 1) (34 6 9)) (91 (65 6 9)
+    (97 6 (123 9 6)))) (42 (11 (10 7 1) (= 34 10 7)) (91 (43 11 (65 7 10))
+    (97 7 (123 10 7)))) err (= 10 err 9) (11 (10 10 err) (= 42 12 10)) (43
+    (34 (= 10 1 7) (35 10 (42 7 11))) (65 (= 47 13 7) (97 (91 10 7) (123 10
+    7)))) (42 (= 10 err 10) (47 (43 12 10) (48 14 10))) (42 (11 (10 7 1) (=
+    34 10 7)) (91 (43 11 (65 7 10)) (97 7 (123 10 7)))) (11 (10 10 err) (=
+    42 12 10)))
+   '#((#f . #f) (4 . 4) (3 . 3) (3 . 3) (4 . 4) (#f . #f) (2 . 2) (4 . 4)
+    (0 . 0) (2 . 2) (#f . #f) (4 . 4) (#f . #f) (1 . 1) (1 . 1))))
+
+;
+; User functions
+;
+
+(define lexer #f)
+
+(define lexer-get-line   #f)
+(define lexer-getc       #f)
+(define lexer-ungetc     #f)
+
+(define lexer-init
+  (lambda (input-type input)
+    (let ((IS (lexer-make-IS input-type input 'line)))
+      (set! lexer (lexer-make-lexer lexer-default-table IS))
+      (set! lexer-get-line   (lexer-get-func-line IS))
+      (set! lexer-getc       (lexer-get-func-getc IS))
+      (set! lexer-ungetc     (lexer-get-func-ungetc IS)))))
diff --git a/src/guile/skribilo/coloring/c.scm b/src/guile/skribilo/coloring/c.scm
new file mode 100644
index 0000000..d2a2b9f
--- /dev/null
+++ b/src/guile/skribilo/coloring/c.scm
@@ -0,0 +1,93 @@
+;;;;
+;;;; c.stk	-- C fontifier for Skribe
+;;;; 
+;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;; 
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 
+;;;; USA.
+;;;; 
+;;;;           Author: Erick Gallesio [eg@essi.fr]
+;;;;    Creation date:  6-Mar-2004 15:35 (eg)
+;;;; Last file update:  7-Mar-2004 00:12 (eg)
+;;;;
+
+(require "lex-rt")		;; to avoid module problems
+
+(define-module (skribilo c)
+   :export (c java)
+   :import (skribe runtime))
+
+(include "c-lex.stk")		;; SILex generated
+
+
+(define *the-keys*	    #f)
+
+(define *c-keys*	    #f)
+(define *java-keys*	    #f)
+
+
+(define (fontifier s)
+  (let ((lex (c-lex (open-input-string s))))
+    (let Loop ((token (lexer-next-token lex))
+	       (res   '()))
+      (if (eq? token 'eof)
+	  (reverse! res)
+	  (Loop (lexer-next-token lex)
+		(cons token res))))))
+  
+;;;; ======================================================================
+;;;;
+;;;; 				C
+;;;;
+;;;; ======================================================================
+(define (init-c-keys)
+  (unless *c-keys*
+    (set! *c-keys* '(for while return break continue void
+		     do if else typedef struct union goto switch case
+		     static extern default)))
+  *c-keys*)
+
+(define (c-fontifier s)
+  (fluid-let ((*the-keys* (init-c-keys)))
+    (fontifier s)))
+
+(define c
+  (new language
+       (name "C")
+       (fontifier c-fontifier)
+       (extractor #f)))
+
+;;;; ======================================================================
+;;;;
+;;;; 				JAVA
+;;;;
+;;;; ======================================================================
+(define (init-java-keys)
+  (unless *java-keys*
+    (set! *java-keys* (append (init-c-keys)
+			      '(public final class throw catch))))
+  *java-keys*)
+
+(define (java-fontifier s)
+  (fluid-let ((*the-keys* (init-java-keys)))
+    (fontifier s)))
+
+(define java
+  (new language
+       (name "java")
+       (fontifier java-fontifier)
+       (extractor #f)))
+
diff --git a/src/guile/skribilo/coloring/lisp-lex.l b/src/guile/skribilo/coloring/lisp-lex.l
new file mode 100644
index 0000000..30b6a44
--- /dev/null
+++ b/src/guile/skribilo/coloring/lisp-lex.l
@@ -0,0 +1,86 @@
+;;; lisp-lex.l -- SILex input for the Lisp Languages
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+space	[ \n\9]
+letter  [#?!_:a-zA-Z\-]
+digit   [0-9]
+
+
+%%
+;; Strings
+\"[^\"]*\"		(new markup
+			     (markup '&source-string)
+			     (body yytext))
+
+;;Comment
+\;.*			(new markup
+			     (markup '&source-line-comment)
+			     (body   yytext))
+
+;; Skribe text (i.e. [....])
+\[|\]		        (if (*bracket-highlight*)
+			    (new markup
+				 (markup '&source-bracket)
+				 (body   yytext))
+			    yytext)
+;; Spaces & parenthesis
+[ \n\9\(\)]+		(begin
+			  yytext)
+
+;; Identifier (real syntax is slightly more complicated but we are
+;; interested here in the identifiers that we will fontify)
+[^\;\"\[\] \n\9\(\)]+	(let ((c (string-ref yytext 0)))
+			  (cond
+			    ((or (char=? c #\:)
+				 (char=? (string-ref yytext
+						     (- (string-length yytext) 1))
+					 #\:))
+			     ;; Scheme keyword
+			     (new markup
+				  (markup '&source-type)
+				  (body yytext)))
+			    ((char=? c #\<)
+			       ;; STklos class
+			       (let* ((len (string-length yytext))
+				      (c   (string-ref yytext (- len 1))))
+				 (if (char=? c #\>)
+				     (if (*class-highlight*)
+					 (new markup
+					      (markup '&source-module)
+					      (body yytext))
+					 yytext)		; no
+				     yytext)))			; no
+			    (else
+			       (let ((tmp (assoc (string->symbol yytext)
+						 (*the-keys*))))
+				 (if tmp
+				     (new markup
+					  (markup (cdr tmp))
+					  (body yytext))
+				     yytext)))))
+
+
+<<EOF>>			'eof
+<<ERROR>>		(skribe-error 'lisp-fontifier "Parse error" yytext)
+
+
+; LocalWords:  fontify
diff --git a/src/guile/skribilo/coloring/lisp-lex.l.scm b/src/guile/skribilo/coloring/lisp-lex.l.scm
new file mode 100644
index 0000000..6ae7fe6
--- /dev/null
+++ b/src/guile/skribilo/coloring/lisp-lex.l.scm
@@ -0,0 +1,1249 @@
+; *** This file starts with a copy of the file multilex.scm ***
+; SILex - Scheme Implementation of Lex
+; Copyright (C) 2001  Danny Dube'
+; 
+; This program is free software; you can redistribute it and/or
+; modify it under the terms of the GNU General Public License
+; as published by the Free Software Foundation; either version 2
+; of the License, or (at your option) any later version.
+; 
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+; GNU General Public License for more details.
+; 
+; You should have received a copy of the GNU General Public License
+; along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+;
+; Gestion des Input Systems
+; Fonctions a utiliser par l'usager:
+;   lexer-make-IS, lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+;
+
+; Taille initiale par defaut du buffer d'entree
+(define lexer-init-buffer-len 1024)
+
+; Numero du caractere newline
+(define lexer-integer-newline (char->integer #\newline))
+
+; Constructeur d'IS brut
+(define lexer-raw-IS-maker
+  (lambda (buffer read-ptr input-f counters)
+    (let ((input-f          input-f)                ; Entree reelle
+	  (buffer           buffer)                 ; Buffer
+	  (buflen           (string-length buffer))
+	  (read-ptr         read-ptr)
+	  (start-ptr        1)                      ; Marque de debut de lexeme
+	  (start-line       1)
+	  (start-column     1)
+	  (start-offset     0)
+	  (end-ptr          1)                      ; Marque de fin de lexeme
+	  (point-ptr        1)                      ; Le point
+	  (user-ptr         1)                      ; Marque de l'usager
+	  (user-line        1)
+	  (user-column      1)
+	  (user-offset      0)
+	  (user-up-to-date? #t))                    ; Concerne la colonne seul.
+      (letrec
+	  ((start-go-to-end-none         ; Fonctions de depl. des marques
+	    (lambda ()
+	      (set! start-ptr end-ptr)))
+	   (start-go-to-end-line
+	    (lambda ()
+	      (let loop ((ptr start-ptr) (line start-line))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1))
+			(loop (+ ptr 1) line))))))
+	   (start-go-to-end-all
+	    (lambda ()
+	      (set! start-offset (+ start-offset (- end-ptr start-ptr)))
+	      (let loop ((ptr start-ptr)
+			 (line start-line)
+			 (column start-column))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line)
+		      (set! start-column column))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1) 1)
+			(loop (+ ptr 1) line (+ column 1)))))))
+	   (start-go-to-user-none
+	    (lambda ()
+	      (set! start-ptr user-ptr)))
+	   (start-go-to-user-line
+	    (lambda ()
+	      (set! start-ptr user-ptr)
+	      (set! start-line user-line)))
+	   (start-go-to-user-all
+	    (lambda ()
+	      (set! start-line user-line)
+	      (set! start-offset user-offset)
+	      (if user-up-to-date?
+		  (begin
+		    (set! start-ptr user-ptr)
+		    (set! start-column user-column))
+		  (let loop ((ptr start-ptr) (column start-column))
+		    (if (= ptr user-ptr)
+			(begin
+			  (set! start-ptr ptr)
+			  (set! start-column column))
+			(if (char=? (string-ref buffer ptr) #\newline)
+			    (loop (+ ptr 1) 1)
+			    (loop (+ ptr 1) (+ column 1))))))))
+	   (end-go-to-point
+	    (lambda ()
+	      (set! end-ptr point-ptr)))
+	   (point-go-to-start
+	    (lambda ()
+	      (set! point-ptr start-ptr)))
+	   (user-go-to-start-none
+	    (lambda ()
+	      (set! user-ptr start-ptr)))
+	   (user-go-to-start-line
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)))
+	   (user-go-to-start-all
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)
+	      (set! user-column start-column)
+	      (set! user-offset start-offset)
+	      (set! user-up-to-date? #t)))
+	   (init-lexeme-none             ; Debute un nouveau lexeme
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-none))
+	      (point-go-to-start)))
+	   (init-lexeme-line
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-line))
+	      (point-go-to-start)))
+	   (init-lexeme-all
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-all))
+	      (point-go-to-start)))
+	   (get-start-line               ; Obtention des stats du debut du lxm
+	    (lambda ()
+	      start-line))
+	   (get-start-column
+	    (lambda ()
+	      start-column))
+	   (get-start-offset
+	    (lambda ()
+	      start-offset))
+	   (peek-left-context            ; Obtention de caracteres (#f si EOF)
+	    (lambda ()
+	      (char->integer (string-ref buffer (- start-ptr 1)))))
+	   (peek-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (char->integer (string-ref buffer point-ptr))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (read-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (let ((c (string-ref buffer point-ptr)))
+		    (set! point-ptr (+ point-ptr 1))
+		    (char->integer c))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (set! point-ptr read-ptr)
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (get-start-end-text           ; Obtention du lexeme
+	    (lambda ()
+	      (substring buffer start-ptr end-ptr)))
+	   (get-user-line-line           ; Fonctions pour l'usager
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      user-line))
+	   (get-user-line-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-line))
+	   (get-user-column-all
+	    (lambda ()
+	      (cond ((< user-ptr start-ptr)
+		     (user-go-to-start-all)
+		     user-column)
+		    (user-up-to-date?
+		     user-column)
+		    (else
+		     (let loop ((ptr start-ptr) (column start-column))
+		       (if (= ptr user-ptr)
+			   (begin
+			     (set! user-column column)
+			     (set! user-up-to-date? #t)
+			     column)
+			   (if (char=? (string-ref buffer ptr) #\newline)
+			       (loop (+ ptr 1) 1)
+			       (loop (+ ptr 1) (+ column 1)))))))))
+	   (get-user-offset-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-offset))
+	   (user-getc-none
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-none))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-line
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(set! user-line (+ user-line 1)))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (set! user-line (+ user-line 1)))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(begin
+			  (set! user-line (+ user-line 1))
+			  (set! user-column 1))
+			(set! user-column (+ user-column 1)))
+		    (set! user-offset (+ user-offset 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (begin
+				(set! user-line (+ user-line 1))
+				(set! user-column 1))
+			      (set! user-column (+ user-column 1)))
+			  (set! user-offset (+ user-offset 1))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-ungetc-none
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (set! user-ptr (- user-ptr 1)))))
+	   (user-ungetc-line
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (set! user-line (- user-line 1))))))))
+	   (user-ungetc-all
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (begin
+			    (set! user-line (- user-line 1))
+			    (set! user-up-to-date? #f))
+			  (set! user-column (- user-column 1)))
+		      (set! user-offset (- user-offset 1)))))))
+	   (reorganize-buffer            ; Decaler ou agrandir le buffer
+	    (lambda ()
+	      (if (< (* 2 start-ptr) buflen)
+		  (let* ((newlen (* 2 buflen))
+			 (newbuf (make-string newlen))
+			 (delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! newbuf
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! buffer    newbuf)
+		    (set! buflen    newlen)
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))
+		  (let ((delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! buffer
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))))))
+	(list (cons 'start-go-to-end
+		    (cond ((eq? counters 'none) start-go-to-end-none)
+			  ((eq? counters 'line) start-go-to-end-line)
+			  ((eq? counters 'all ) start-go-to-end-all)))
+	      (cons 'end-go-to-point
+		    end-go-to-point)
+	      (cons 'init-lexeme
+		    (cond ((eq? counters 'none) init-lexeme-none)
+			  ((eq? counters 'line) init-lexeme-line)
+			  ((eq? counters 'all ) init-lexeme-all)))
+	      (cons 'get-start-line
+		    get-start-line)
+	      (cons 'get-start-column
+		    get-start-column)
+	      (cons 'get-start-offset
+		    get-start-offset)
+	      (cons 'peek-left-context
+		    peek-left-context)
+	      (cons 'peek-char
+		    peek-char)
+	      (cons 'read-char
+		    read-char)
+	      (cons 'get-start-end-text
+		    get-start-end-text)
+	      (cons 'get-user-line
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) get-user-line-line)
+			  ((eq? counters 'all ) get-user-line-all)))
+	      (cons 'get-user-column
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-column-all)))
+	      (cons 'get-user-offset
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-offset-all)))
+	      (cons 'user-getc
+		    (cond ((eq? counters 'none) user-getc-none)
+			  ((eq? counters 'line) user-getc-line)
+			  ((eq? counters 'all ) user-getc-all)))
+	      (cons 'user-ungetc
+		    (cond ((eq? counters 'none) user-ungetc-none)
+			  ((eq? counters 'line) user-ungetc-line)
+			  ((eq? counters 'all ) user-ungetc-all))))))))
+
+; Construit un Input System
+; Le premier parametre doit etre parmi "port", "procedure" ou "string"
+; Prend un parametre facultatif qui doit etre parmi
+; "none", "line" ou "all"
+(define lexer-make-IS
+  (lambda (input-type input . largs)
+    (let ((counters-type (cond ((null? largs)
+				'line)
+			       ((memq (car largs) '(none line all))
+				(car largs))
+			       (else
+				'line))))
+      (cond ((and (eq? input-type 'port) (input-port? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () (read-char input))))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'procedure) (procedure? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  input))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'string) (string? input))
+	     (let* ((buffer   (string-append (string #\newline) input))
+		    (read-ptr (string-length buffer))
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    (else
+	     (let* ((buffer   (string #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))))))
+
+; Les fonctions:
+;   lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+(define lexer-get-func-getc
+  (lambda (IS) (cdr (assq 'user-getc IS))))
+(define lexer-get-func-ungetc
+  (lambda (IS) (cdr (assq 'user-ungetc IS))))
+(define lexer-get-func-line
+  (lambda (IS) (cdr (assq 'get-user-line IS))))
+(define lexer-get-func-column
+  (lambda (IS) (cdr (assq 'get-user-column IS))))
+(define lexer-get-func-offset
+  (lambda (IS) (cdr (assq 'get-user-offset IS))))
+
+;
+; Gestion des lexers
+;
+
+; Fabrication de lexer a partir d'arbres de decision
+(define lexer-make-tree-lexer
+  (lambda (tables IS)
+    (letrec
+	(; Contenu de la table
+	 (counters-type        (vector-ref tables 0))
+	 (<<EOF>>-pre-action   (vector-ref tables 1))
+	 (<<ERROR>>-pre-action (vector-ref tables 2))
+	 (rules-pre-actions    (vector-ref tables 3))
+	 (table-nl-start       (vector-ref tables 5))
+	 (table-no-nl-start    (vector-ref tables 6))
+	 (trees-v              (vector-ref tables 7))
+	 (acc-v                (vector-ref tables 8))
+
+	 ; Contenu du IS
+	 (IS-start-go-to-end    (cdr (assq 'start-go-to-end IS)))
+	 (IS-end-go-to-point    (cdr (assq 'end-go-to-point IS)))
+	 (IS-init-lexeme        (cdr (assq 'init-lexeme IS)))
+	 (IS-get-start-line     (cdr (assq 'get-start-line IS)))
+	 (IS-get-start-column   (cdr (assq 'get-start-column IS)))
+	 (IS-get-start-offset   (cdr (assq 'get-start-offset IS)))
+	 (IS-peek-left-context  (cdr (assq 'peek-left-context IS)))
+	 (IS-peek-char          (cdr (assq 'peek-char IS)))
+	 (IS-read-char          (cdr (assq 'read-char IS)))
+	 (IS-get-start-end-text (cdr (assq 'get-start-end-text IS)))
+	 (IS-get-user-line      (cdr (assq 'get-user-line IS)))
+	 (IS-get-user-column    (cdr (assq 'get-user-column IS)))
+	 (IS-get-user-offset    (cdr (assq 'get-user-offset IS)))
+	 (IS-user-getc          (cdr (assq 'user-getc IS)))
+	 (IS-user-ungetc        (cdr (assq 'user-ungetc IS)))
+
+	 ; Resultats
+	 (<<EOF>>-action   #f)
+	 (<<ERROR>>-action #f)
+	 (rules-actions    #f)
+	 (states           #f)
+	 (final-lexer      #f)
+
+	 ; Gestion des hooks
+	 (hook-list '())
+	 (add-hook
+	  (lambda (thunk)
+	    (set! hook-list (cons thunk hook-list))))
+	 (apply-hooks
+	  (lambda ()
+	    (let loop ((l hook-list))
+	      (if (pair? l)
+		  (begin
+		    ((car l))
+		    (loop (cdr l)))))))
+
+	 ; Preparation des actions
+	 (set-action-statics
+	  (lambda (pre-action)
+	    (pre-action final-lexer IS-user-getc IS-user-ungetc)))
+	 (prepare-special-action-none
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda ()
+		       (action "")))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-line
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (action "" yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-all
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (action "" yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-special-action-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-special-action-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-special-action-all  pre-action)))))
+	 (prepare-action-yytext-none
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-line
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-all
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline yycolumn yyoffset))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-yytext-all  pre-action)))))
+	 (prepare-action-no-yytext-none
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (start-go-to-end)
+		       (action)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-line
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (start-go-to-end)
+		       (action yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-all
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (start-go-to-end)
+		       (action yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-no-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-no-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-no-yytext-all  pre-action)))))
+
+	 ; Fabrique les fonctions de dispatch
+	 (prepare-dispatch-err
+	  (lambda (leaf)
+	    (lambda (c)
+	      #f)))
+	 (prepare-dispatch-number
+	  (lambda (leaf)
+	    (let ((state-function #f))
+	      (let ((result
+		     (lambda (c)
+		       state-function))
+		    (hook
+		     (lambda ()
+		       (set! state-function (vector-ref states leaf)))))
+		(add-hook hook)
+		result))))
+	 (prepare-dispatch-leaf
+	  (lambda (leaf)
+	    (if (eq? leaf 'err)
+		(prepare-dispatch-err leaf)
+		(prepare-dispatch-number leaf))))
+	 (prepare-dispatch-<
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 1))
+		  (right-tree (list-ref tree 2)))
+	      (let ((bound      (list-ref tree 0))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (< c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-=
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 2))
+		  (right-tree (list-ref tree 3)))
+	      (let ((bound      (list-ref tree 1))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (= c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-tree
+	  (lambda (tree)
+	    (cond ((not (pair? tree))
+		   (prepare-dispatch-leaf tree))
+		  ((eq? (car tree) '=)
+		   (prepare-dispatch-= tree))
+		  (else
+		   (prepare-dispatch-< tree)))))
+	 (prepare-dispatch
+	  (lambda (tree)
+	    (let ((dicho-func (prepare-dispatch-tree tree)))
+	      (lambda (c)
+		(and c (dicho-func c))))))
+
+	 ; Fabrique les fonctions de transition (read & go) et (abort)
+	 (prepare-read-n-go
+	  (lambda (tree)
+	    (let ((dispatch-func (prepare-dispatch tree))
+		  (read-char     IS-read-char))
+	      (lambda ()
+		(dispatch-func (read-char))))))
+	 (prepare-abort
+	  (lambda (tree)
+	    (lambda ()
+	      #f)))
+	 (prepare-transition
+	  (lambda (tree)
+	    (if (eq? tree 'err)
+		(prepare-abort     tree)
+		(prepare-read-n-go tree))))
+
+	 ; Fabrique les fonctions d'etats ([set-end] & trans)
+	 (prepare-state-no-acc
+	   (lambda (s r1 r2)
+	     (let ((trans-func (prepare-transition (vector-ref trees-v s))))
+	       (lambda (action)
+		 (let ((next-state (trans-func)))
+		   (if next-state
+		       (next-state action)
+		       action))))))
+	 (prepare-state-yes-no
+	  (lambda (s r1 r2)
+	    (let ((peek-char       IS-peek-char)
+		  (end-go-to-point IS-end-go-to-point)
+		  (new-action1     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   (begin
+				     (end-go-to-point)
+				     new-action1)
+				   action))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-diff-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (peek-char       IS-peek-char)
+		  (new-action1     #f)
+		  (new-action2     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   new-action1
+				   new-action2))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1))
+		       (set! new-action2 (vector-ref rules-actions r2)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-same-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (trans-func (prepare-transition (vector-ref trees-v s)))
+		  (new-action #f))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let ((next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state
+	  (lambda (s)
+	    (let* ((acc (vector-ref acc-v s))
+		   (r1 (car acc))
+		   (r2 (cdr acc)))
+	      (cond ((not r1)  (prepare-state-no-acc   s r1 r2))
+		    ((not r2)  (prepare-state-yes-no   s r1 r2))
+		    ((< r1 r2) (prepare-state-diff-acc s r1 r2))
+		    (else      (prepare-state-same-acc s r1 r2))))))
+
+	 ; Fabrique la fonction de lancement du lexage a l'etat de depart
+	 (prepare-start-same
+	  (lambda (s1 s2)
+	    (let ((peek-char    IS-peek-char)
+		  (eof-action   #f)
+		  (start-state  #f)
+		  (error-action #f))
+	      (let ((result
+		     (lambda ()
+		       (if (not (peek-char))
+			   eof-action
+			   (start-state error-action))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action   <<EOF>>-action)
+		       (set! start-state  (vector-ref states s1))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start-diff
+	  (lambda (s1 s2)
+	    (let ((peek-char         IS-peek-char)
+		  (eof-action        #f)
+		  (peek-left-context IS-peek-left-context)
+		  (start-state1      #f)
+		  (start-state2      #f)
+		  (error-action      #f))
+	      (let ((result
+		     (lambda ()
+		       (cond ((not (peek-char))
+			      eof-action)
+			     ((= (peek-left-context) lexer-integer-newline)
+			      (start-state1 error-action))
+			     (else
+			      (start-state2 error-action)))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action <<EOF>>-action)
+		       (set! start-state1 (vector-ref states s1))
+		       (set! start-state2 (vector-ref states s2))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start
+	  (lambda ()
+	    (let ((s1 table-nl-start)
+		  (s2 table-no-nl-start))
+	      (if (= s1 s2)
+		  (prepare-start-same s1 s2)
+		  (prepare-start-diff s1 s2)))))
+
+	 ; Fabrique la fonction principale
+	 (prepare-lexer-none
+	  (lambda ()
+	    (let ((init-lexeme IS-init-lexeme)
+		  (start-func  (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		((start-func))))))
+	 (prepare-lexer-line
+	  (lambda ()
+	    (let ((init-lexeme    IS-init-lexeme)
+		  (get-start-line IS-get-start-line)
+		  (start-func     (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline (get-start-line)))
+		  ((start-func) yyline))))))
+	 (prepare-lexer-all
+	  (lambda ()
+	    (let ((init-lexeme      IS-init-lexeme)
+		  (get-start-line   IS-get-start-line)
+		  (get-start-column IS-get-start-column)
+		  (get-start-offset IS-get-start-offset)
+		  (start-func       (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline   (get-start-line))
+		      (yycolumn (get-start-column))
+		      (yyoffset (get-start-offset)))
+		  ((start-func) yyline yycolumn yyoffset))))))
+	 (prepare-lexer
+	  (lambda ()
+	    (cond ((eq? counters-type 'none) (prepare-lexer-none))
+		  ((eq? counters-type 'line) (prepare-lexer-line))
+		  ((eq? counters-type 'all)  (prepare-lexer-all))))))
+
+      ; Calculer la valeur de <<EOF>>-action et de <<ERROR>>-action
+      (set! <<EOF>>-action   (prepare-special-action <<EOF>>-pre-action))
+      (set! <<ERROR>>-action (prepare-special-action <<ERROR>>-pre-action))
+
+      ; Calculer la valeur de rules-actions
+      (let* ((len (quotient (vector-length rules-pre-actions) 2))
+	     (v (make-vector len)))
+	(let loop ((r (- len 1)))
+	  (if (< r 0)
+	      (set! rules-actions v)
+	      (let* ((yytext? (vector-ref rules-pre-actions (* 2 r)))
+		     (pre-action (vector-ref rules-pre-actions (+ (* 2 r) 1)))
+		     (action (if yytext?
+				 (prepare-action-yytext    pre-action)
+				 (prepare-action-no-yytext pre-action))))
+		(vector-set! v r action)
+		(loop (- r 1))))))
+
+      ; Calculer la valeur de states
+      (let* ((len (vector-length trees-v))
+	     (v (make-vector len)))
+	(let loop ((s (- len 1)))
+	  (if (< s 0)
+	      (set! states v)
+	      (begin
+		(vector-set! v s (prepare-state s))
+		(loop (- s 1))))))
+
+      ; Calculer la valeur de final-lexer
+      (set! final-lexer (prepare-lexer))
+
+      ; Executer les hooks
+      (apply-hooks)
+
+      ; Resultat
+      final-lexer)))
+
+; Fabrication de lexer a partir de listes de caracteres taggees
+(define lexer-make-char-lexer
+  (let* ((char->class
+	  (lambda (c)
+	    (let ((n (char->integer c)))
+	      (list (cons n n)))))
+	 (merge-sort
+	  (lambda (l combine zero-elt)
+	    (if (null? l)
+		zero-elt
+		(let loop1 ((l l))
+		  (if (null? (cdr l))
+		      (car l)
+		      (loop1
+		       (let loop2 ((l l))
+			 (cond ((null? l)
+				l)
+			       ((null? (cdr l))
+				l)
+			       (else
+				(cons (combine (car l) (cadr l))
+				      (loop2 (cddr l))))))))))))
+	 (finite-class-union
+	  (lambda (c1 c2)
+	    (let loop ((c1 c1) (c2 c2) (u '()))
+	      (if (null? c1)
+		  (if (null? c2)
+		      (reverse u)
+		      (loop c1 (cdr c2) (cons (car c2) u)))
+		  (if (null? c2)
+		      (loop (cdr c1) c2 (cons (car c1) u))
+		      (let* ((r1 (car c1))
+			     (r2 (car c2))
+			     (r1start (car r1))
+			     (r1end (cdr r1))
+			     (r2start (car r2))
+			     (r2end (cdr r2)))
+			(if (<= r1start r2start)
+			    (cond ((< (+ r1end 1) r2start)
+				   (loop (cdr c1) c2 (cons r1 u)))
+				  ((<= r1end r2end)
+				   (loop (cdr c1)
+					 (cons (cons r1start r2end) (cdr c2))
+					 u))
+				  (else
+				   (loop c1 (cdr c2) u)))
+			    (cond ((> r1start (+ r2end 1))
+				   (loop c1 (cdr c2) (cons r2 u)))
+				  ((>= r1end r2end)
+				   (loop (cons (cons r2start r1end) (cdr c1))
+					 (cdr c2)
+					 u))
+				  (else
+				   (loop (cdr c1) c2 u))))))))))
+	 (char-list->class
+	  (lambda (cl)
+	    (let ((classes (map char->class cl)))
+	      (merge-sort classes finite-class-union '()))))
+	 (class-<
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  (else (< b1 b2)))))
+	 (finite-class-compl
+	  (lambda (c)
+	    (let loop ((c c) (start 'inf-))
+	      (if (null? c)
+		  (list (cons start 'inf+))
+		  (let* ((r (car c))
+			 (rstart (car r))
+			 (rend (cdr r)))
+		    (if (class-< start rstart)
+			(cons (cons start (- rstart 1))
+			      (loop c rstart))
+			(loop (cdr c) (+ rend 1))))))))
+	 (tagged-chars->class
+	  (lambda (tcl)
+	    (let* ((inverse? (car tcl))
+		   (cl (cdr tcl))
+		   (class-tmp (char-list->class cl)))
+	      (if inverse? (finite-class-compl class-tmp) class-tmp))))
+	 (charc->arc
+	  (lambda (charc)
+	    (let* ((tcl (car charc))
+		   (dest (cdr charc))
+		   (class (tagged-chars->class tcl)))
+	      (cons class dest))))
+	 (arc->sharcs
+	  (lambda (arc)
+	    (let* ((range-l (car arc))
+		   (dest (cdr arc))
+		   (op (lambda (range) (cons range dest))))
+	      (map op range-l))))
+	 (class-<=
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  (else (<= b1 b2)))))
+	 (sharc-<=
+	  (lambda (sharc1 sharc2)
+	    (class-<= (caar sharc1) (caar sharc2))))
+	 (merge-sharcs
+	  (lambda (l1 l2)
+	    (let loop ((l1 l1) (l2 l2))
+	      (cond ((null? l1)
+		     l2)
+		    ((null? l2)
+		     l1)
+		    (else
+		     (let ((sharc1 (car l1))
+			   (sharc2 (car l2)))
+		       (if (sharc-<= sharc1 sharc2)
+			   (cons sharc1 (loop (cdr l1) l2))
+			   (cons sharc2 (loop l1 (cdr l2))))))))))
+	 (class-= eqv?)
+	 (fill-error
+	  (lambda (sharcs)
+	    (let loop ((sharcs sharcs) (start 'inf-))
+	      (cond ((class-= start 'inf+)
+		     '())
+		    ((null? sharcs)
+		     (cons (cons (cons start 'inf+) 'err)
+			   (loop sharcs 'inf+)))
+		    (else
+		     (let* ((sharc (car sharcs))
+			    (h (caar sharc))
+			    (t (cdar sharc)))
+		       (if (class-< start h)
+			   (cons (cons (cons start (- h 1)) 'err)
+				 (loop sharcs h))
+			   (cons sharc (loop (cdr sharcs)
+					     (if (class-= t 'inf+)
+						 'inf+
+						 (+ t 1)))))))))))
+	 (charcs->tree
+	  (lambda (charcs)
+	    (let* ((op (lambda (charc) (arc->sharcs (charc->arc charc))))
+		   (sharcs-l (map op charcs))
+		   (sorted-sharcs (merge-sort sharcs-l merge-sharcs '()))
+		   (full-sharcs (fill-error sorted-sharcs))
+		   (op (lambda (sharc) (cons (caar sharc) (cdr sharc))))
+		   (table (list->vector (map op full-sharcs))))
+	      (let loop ((left 0) (right (- (vector-length table) 1)))
+		(if (= left right)
+		    (cdr (vector-ref table left))
+		    (let ((mid (quotient (+ left right 1) 2)))
+		      (if (and (= (+ left 2) right)
+			       (= (+ (car (vector-ref table mid)) 1)
+				  (car (vector-ref table right)))
+			       (eqv? (cdr (vector-ref table left))
+				     (cdr (vector-ref table right))))
+			  (list '=
+				(car (vector-ref table mid))
+				(cdr (vector-ref table mid))
+				(cdr (vector-ref table left)))
+			  (list (car (vector-ref table mid))
+				(loop left (- mid 1))
+				(loop mid right))))))))))
+    (lambda (tables IS)
+      (let ((counters         (vector-ref tables 0))
+	    (<<EOF>>-action   (vector-ref tables 1))
+	    (<<ERROR>>-action (vector-ref tables 2))
+	    (rules-actions    (vector-ref tables 3))
+	    (nl-start         (vector-ref tables 5))
+	    (no-nl-start      (vector-ref tables 6))
+	    (charcs-v         (vector-ref tables 7))
+	    (acc-v            (vector-ref tables 8)))
+	(let* ((len (vector-length charcs-v))
+	       (v (make-vector len)))
+	  (let loop ((i (- len 1)))
+	    (if (>= i 0)
+		(begin
+		  (vector-set! v i (charcs->tree (vector-ref charcs-v i)))
+		  (loop (- i 1)))
+		(lexer-make-tree-lexer
+		 (vector counters
+			 <<EOF>>-action
+			 <<ERROR>>-action
+			 rules-actions
+			 'decision-trees
+			 nl-start
+			 no-nl-start
+			 v
+			 acc-v)
+		 IS))))))))
+
+; Fabrication d'un lexer a partir de code pre-genere
+(define lexer-make-code-lexer
+  (lambda (tables IS)
+    (let ((<<EOF>>-pre-action   (vector-ref tables 1))
+	  (<<ERROR>>-pre-action (vector-ref tables 2))
+	  (rules-pre-action     (vector-ref tables 3))
+	  (code                 (vector-ref tables 5)))
+      (code <<EOF>>-pre-action <<ERROR>>-pre-action rules-pre-action IS))))
+
+(define lexer-make-lexer
+  (lambda (tables IS)
+    (let ((automaton-type (vector-ref tables 4)))
+      (cond ((eq? automaton-type 'decision-trees)
+	     (lexer-make-tree-lexer tables IS))
+	    ((eq? automaton-type 'tagged-chars-lists)
+	     (lexer-make-char-lexer tables IS))
+	    ((eq? automaton-type 'code)
+	     (lexer-make-code-lexer tables IS))))))
+
+;
+; Table generated from the file lisp-lex.l by SILex 1.0
+;
+
+(define lexer-default-table
+  (vector
+   'line
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+       			'eof
+       ))
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+         		(skribe-error 'lisp-fontifier "Parse error" yytext)
+
+
+; LocalWords:  fontify
+       ))
+   (vector
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+          		(new markup
+			     (markup '&source-string)
+			     (body yytext))
+
+;;Comment
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+    			(new markup
+			     (markup '&source-line-comment)
+			     (body   yytext))
+
+;; Skribe text (i.e. [....])
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+     		        (if (*bracket-highlight*)
+			    (new markup
+				 (markup '&source-bracket)
+				 (body   yytext))
+			    yytext)
+;; Spaces & parenthesis
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+            		(begin
+			  yytext)
+
+;; Identifier (real syntax is slightly more complicated but we are
+;; interested here in the identifiers that we will fontify)
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                     	(let ((c (string-ref yytext 0)))
+			  (cond
+			    ((or (char=? c #\:)
+				 (char=? (string-ref yytext
+						     (- (string-length yytext) 1))
+					 #\:))
+			     ;; Scheme keyword
+			     (new markup
+				  (markup '&source-type)
+				  (body yytext)))
+			    ((char=? c #\<)
+			       ;; STklos class
+			       (let* ((len (string-length yytext))
+				      (c   (string-ref yytext (- len 1))))
+				 (if (char=? c #\>)
+				     (if (*class-highlight*)
+					 (new markup
+					      (markup '&source-module)
+					      (body yytext))
+					 yytext)		; no
+				     yytext)))			; no
+			    (else
+			       (let ((tmp (assoc (string->symbol yytext)
+						 (*the-keys*))))
+				 (if tmp
+				     (new markup
+					  (markup (cdr tmp))
+					  (body yytext))
+				     yytext)))))
+        )))
+   'decision-trees
+   0
+   0
+   '#((40 (32 (9 1 (11 2 1)) (34 (33 2 1) (35 5 1))) (91 (59 (42 2 1) (60 4
+    1)) (93 (92 3 1) (94 3 1)))) (40 (32 (9 1 (11 err 1)) (34 (33 err 1)
+    (35 err 1))) (91 (59 (42 err 1) (60 err 1)) (93 (92 err 1) (94 err
+    1)))) (32 (9 err (11 2 err)) (40 (33 2 err) (42 2 err))) err (= 10 err
+    4) (= 34 6 5) err)
+   '#((#f . #f) (4 . 4) (3 . 3) (2 . 2) (1 . 1) (#f . #f) (0 . 0))))
+
+;
+; User functions
+;
+
+(define lexer #f)
+
+(define lexer-get-line   #f)
+(define lexer-getc       #f)
+(define lexer-ungetc     #f)
+
+(define lexer-init
+  (lambda (input-type input)
+    (let ((IS (lexer-make-IS input-type input 'line)))
+      (set! lexer (lexer-make-lexer lexer-default-table IS))
+      (set! lexer-get-line   (lexer-get-func-line IS))
+      (set! lexer-getc       (lexer-get-func-getc IS))
+      (set! lexer-ungetc     (lexer-get-func-ungetc IS)))))
diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm
new file mode 100644
index 0000000..13bb6db
--- /dev/null
+++ b/src/guile/skribilo/coloring/lisp.scm
@@ -0,0 +1,302 @@
+;;;; lisp.scm	-- Lisp Family Fontification
+;;;;
+;;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;; Copyright 2005, 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;;; USA.
+
+
+(define-module (skribilo coloring lisp)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo source)
+  :use-module (skribilo lib)
+  :use-module (skribilo utils strings)
+  :use-module (srfi srfi-39)
+  :use-module (ice-9 match)
+  :autoload   (ice-9 regex)      (make-regexp)
+  :autoload   (skribilo reader)  (make-reader)
+  :export (skribe scheme stklos bigloo lisp))
+
+
+(define *bracket-highlight* (make-parameter #t))
+(define *class-highlight*   (make-parameter #t))
+(define *the-keys*	    (make-parameter '()))
+
+(define %lisp-keys	    #f)
+(define %scheme-keys        #f)
+(define %skribe-keys	    #f)
+(define %stklos-keys	    #f)
+(define %lisp-keys	    #f)
+
+
+;;;
+;;; DEFINITION-SEARCH
+;;;
+(define (definition-search inp read tab def?)
+  (let Loop ((exp (read inp)))
+    (unless (eof-object? exp)
+      (if (def? exp)
+	  (let ((start (and (pair? exp) (source-property exp 'line)))
+		(stop  (port-line inp)))
+	    (source-read-lines (port-filename inp) start stop tab))
+	  (Loop (read inp))))))
+
+;; Load the SILex-generated lexer.
+(load-from-path "skribilo/coloring/lisp-lex.l.scm")
+
+(define (lisp-family-fontifier s)
+  (lexer-init 'port (open-input-string s))
+  (let loop ((token (lexer))
+	     (res   '()))
+    (if (eq? token 'eof)
+	(reverse! res)
+	(loop (lexer)
+	      (cons token res)))))
+
+
+;;;; ======================================================================
+;;;;
+;;;;				LISP
+;;;;
+;;;; ======================================================================
+(define (lisp-extractor iport def tab)
+  (definition-search
+    iport
+    read
+    tab
+    (lambda (exp)
+      (match exp
+	 (((or 'defun 'defmacro) fun _ . _)
+	  (and (eq? def fun) exp))
+	 (('defvar var . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
+
+(define (init-lisp-keys)
+  (unless %lisp-keys
+    (set! %lisp-keys
+      (append  ;; key
+	       (map (lambda (x) (cons x '&source-keyword))
+		    '(setq if let let* letrec cond case else progn lambda))
+	       ;; define
+	       (map (lambda (x) (cons x '&source-define))
+		    '(defun defclass defmacro)))))
+  %lisp-keys)
+
+(define (lisp-fontifier s)
+  (parameterize ((*the-keys*	   (init-lisp-keys))
+		 (*bracket-highlight* #f)
+		 (*class-highlight*   #f))
+    (lisp-family-fontifier s)))
+
+
+(define lisp
+  (new language
+       (name "lisp")
+       (fontifier lisp-fontifier)
+       (extractor lisp-extractor)))
+
+
+;;;; ======================================================================
+;;;;
+;;;;				SCHEME
+;;;;
+;;;; ======================================================================
+(define (scheme-extractor iport def tab)
+  (definition-search
+    iport
+    %skribilo-module-reader
+    tab
+    (lambda (exp)
+      (match exp
+	 (((or 'define 'define-macro) (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (('define (? symbol? var) . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
+
+
+(define (init-scheme-keys)
+  (unless %scheme-keys
+    (set! %scheme-keys
+      (append ;; key
+	      (map (lambda (x) (cons x '&source-keyword))
+		   '(set! if let let* letrec quote cond case else begin do lambda))
+	      ;; define
+	      (map (lambda (x) (cons x '&source-define))
+		 '(define define-syntax)))))
+  %scheme-keys)
+
+
+(define (scheme-fontifier s)
+  (parameterize ((*the-keys*	   (init-scheme-keys))
+		 (*bracket-highlight* #f)
+		 (*class-highlight*   #f))
+    (lisp-family-fontifier s)))
+
+
+(define scheme
+  (new language
+       (name "scheme")
+       (fontifier scheme-fontifier)
+       (extractor scheme-extractor)))
+
+
+;;;; ======================================================================
+;;;;
+;;;;				STKLOS
+;;;;
+;;;; ======================================================================
+(define (stklos-extractor iport def tab)
+  (definition-search
+    iport
+    %skribilo-module-reader
+    tab
+    (lambda (exp)
+      (match exp
+	 (((or 'define 'define-generic 'define-method 'define-macro)
+	   (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (((or 'define 'define-module) (? symbol? var) . _)
+	  (and (eq? var def) exp))
+	 (else
+		#f)))))
+
+
+(define (init-stklos-keys)
+  (unless %stklos-keys
+    (init-scheme-keys)
+    (set! %stklos-keys (append %scheme-keys
+				;; Markups
+				(map (lambda (x) (cons x '&source-key))
+				     '(select-module import export))
+				;; Key
+				(map (lambda (x) (cons x '&source-keyword))
+				     '(case-lambda dotimes match-case match-lambda))
+				;; Define
+				(map (lambda (x) (cons x '&source-define))
+				     '(define-generic define-class
+				       define-macro define-method define-module))
+				;; error
+				(map (lambda (x) (cons x '&source-error))
+				     '(error call/cc)))))
+  %stklos-keys)
+
+
+(define (stklos-fontifier s)
+  (parameterize ((*the-keys*	   (init-stklos-keys))
+		 (*bracket-highlight* #t)
+		 (*class-highlight*   #t))
+    (lisp-family-fontifier s)))
+
+
+(define stklos
+  (new language
+       (name "stklos")
+       (fontifier stklos-fontifier)
+       (extractor stklos-extractor)))
+
+
+;;;; ======================================================================
+;;;;
+;;;;				SKRIBE
+;;;;
+;;;; ======================================================================
+(define (skribe-extractor iport def tab)
+  (definition-search
+    iport
+    (make-reader 'skribe)
+    tab
+    (lambda (exp)
+      (match exp
+	(((or 'define 'define-macro 'define-markup 'define-public)
+	  (fun . _) . _)
+	 (and (eq? def fun) exp))
+	(('define (? symbol? var) . _)
+	 (and (eq? var def) exp))
+	(('markup-output (quote mk) . _)
+	 (and (eq? mk def) exp))
+	(else #f)))))
+
+
+(define (init-skribe-keys)
+  (unless %skribe-keys
+    (init-stklos-keys)
+    (set! %skribe-keys (append %stklos-keys
+				;; Markups
+				(map (lambda (x) (cons x '&source-markup))
+				     '(bold it emph tt color ref index underline
+				       roman figure center pre flush hrule
+				       linebreak image kbd code var samp
+				       sc sf sup sub
+				       itemize description enumerate item
+				       table tr td th item prgm author
+				       prgm hook font
+				       document chapter section subsection
+				       subsubsection paragraph p handle resolve
+				       processor abstract margin toc
+				       table-of-contents current-document
+				       current-chapter current-section
+				       document-sections* section-number
+				       footnote print-index include skribe-load
+				       slide))
+				;; Define
+				(map (lambda (x) (cons x '&source-define))
+				     '(define-markup)))))
+  %skribe-keys)
+
+
+(define (skribe-fontifier s)
+  (parameterize ((*the-keys*	   (init-skribe-keys))
+		 (*bracket-highlight* #t)
+		 (*class-highlight*   #t))
+    (lisp-family-fontifier s)))
+
+
+(define skribe
+  (new language
+       (name "skribe")
+       (fontifier skribe-fontifier)
+       (extractor skribe-extractor)))
+
+
+;;;; ======================================================================
+;;;;
+;;;;				BIGLOO
+;;;;
+;;;; ======================================================================
+(define (bigloo-extractor iport def tab)
+  (definition-search
+    iport
+    %skribilo-module-reader
+    tab
+    (lambda (exp)
+      (match exp
+	 (((or 'define 'define-inline 'define-generic
+	       'define-method 'define-macro 'define-expander)
+	   (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (((or 'define 'define-struct 'define-library)
+	   (? symbol? var) . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
+
+(define bigloo
+  (new language
+       (name "bigloo")
+       (fontifier scheme-fontifier)
+       (extractor bigloo-extractor)))
diff --git a/src/guile/skribilo/coloring/xml-lex.l b/src/guile/skribilo/coloring/xml-lex.l
new file mode 100644
index 0000000..aa7d312
--- /dev/null
+++ b/src/guile/skribilo/coloring/xml-lex.l
@@ -0,0 +1,64 @@
+;;;;							-*- Scheme -*-
+;;;;
+;;;; xml-lex.l			-- SILex input for the XML languages
+;;;; 
+;;;; Copyright © 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;; 
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 
+;;;; USA.
+;;;; 
+;;;;           Author: Erick Gallesio [eg@essi.fr]
+;;;;    Creation date: 21-Dec-2003 17:19 (eg)
+;;;; Last file update: 21-Dec-2003 22:38 (eg)
+;;;;
+
+space	[ \n\9]
+
+%%
+
+;; Strings
+\"[^\"]*\"		(new markup
+			     (markup '&source-string)
+			     (body yytext))
+'[^']*'			(new markup
+			     (markup '&source-string)
+			     (body yytext))
+
+;;Comment
+<!--(.|\n)*-->		(new markup
+			     (markup '&source-comment)
+			     (body   yytext))
+
+;; Markup
+<[^>\n ]+|>		(new markup
+			     (markup '&source-module)
+			     (body yytext))
+
+;; Regular text
+[^<>\"']+			(begin yytext)
+
+
+<<EOF>>			'eof
+<<ERROR>>		(skribe-error 'xml-fontifier "Parse error" yytext)
+
+
+
+
+
+
+			    
+				
+					
\ No newline at end of file
diff --git a/src/guile/skribilo/coloring/xml-lex.l.scm b/src/guile/skribilo/coloring/xml-lex.l.scm
new file mode 100644
index 0000000..d58e42b
--- /dev/null
+++ b/src/guile/skribilo/coloring/xml-lex.l.scm
@@ -0,0 +1,1221 @@
+; *** This file starts with a copy of the file multilex.scm ***
+; SILex - Scheme Implementation of Lex
+; Copyright (C) 2001  Danny Dube'
+; 
+; This program is free software; you can redistribute it and/or
+; modify it under the terms of the GNU General Public License
+; as published by the Free Software Foundation; either version 2
+; of the License, or (at your option) any later version.
+; 
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+; GNU General Public License for more details.
+; 
+; You should have received a copy of the GNU General Public License
+; along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+;
+; Gestion des Input Systems
+; Fonctions a utiliser par l'usager:
+;   lexer-make-IS, lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+;
+
+; Taille initiale par defaut du buffer d'entree
+(define lexer-init-buffer-len 1024)
+
+; Numero du caractere newline
+(define lexer-integer-newline (char->integer #\newline))
+
+; Constructeur d'IS brut
+(define lexer-raw-IS-maker
+  (lambda (buffer read-ptr input-f counters)
+    (let ((input-f          input-f)                ; Entree reelle
+	  (buffer           buffer)                 ; Buffer
+	  (buflen           (string-length buffer))
+	  (read-ptr         read-ptr)
+	  (start-ptr        1)                      ; Marque de debut de lexeme
+	  (start-line       1)
+	  (start-column     1)
+	  (start-offset     0)
+	  (end-ptr          1)                      ; Marque de fin de lexeme
+	  (point-ptr        1)                      ; Le point
+	  (user-ptr         1)                      ; Marque de l'usager
+	  (user-line        1)
+	  (user-column      1)
+	  (user-offset      0)
+	  (user-up-to-date? #t))                    ; Concerne la colonne seul.
+      (letrec
+	  ((start-go-to-end-none         ; Fonctions de depl. des marques
+	    (lambda ()
+	      (set! start-ptr end-ptr)))
+	   (start-go-to-end-line
+	    (lambda ()
+	      (let loop ((ptr start-ptr) (line start-line))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1))
+			(loop (+ ptr 1) line))))))
+	   (start-go-to-end-all
+	    (lambda ()
+	      (set! start-offset (+ start-offset (- end-ptr start-ptr)))
+	      (let loop ((ptr start-ptr)
+			 (line start-line)
+			 (column start-column))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line)
+		      (set! start-column column))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1) 1)
+			(loop (+ ptr 1) line (+ column 1)))))))
+	   (start-go-to-user-none
+	    (lambda ()
+	      (set! start-ptr user-ptr)))
+	   (start-go-to-user-line
+	    (lambda ()
+	      (set! start-ptr user-ptr)
+	      (set! start-line user-line)))
+	   (start-go-to-user-all
+	    (lambda ()
+	      (set! start-line user-line)
+	      (set! start-offset user-offset)
+	      (if user-up-to-date?
+		  (begin
+		    (set! start-ptr user-ptr)
+		    (set! start-column user-column))
+		  (let loop ((ptr start-ptr) (column start-column))
+		    (if (= ptr user-ptr)
+			(begin
+			  (set! start-ptr ptr)
+			  (set! start-column column))
+			(if (char=? (string-ref buffer ptr) #\newline)
+			    (loop (+ ptr 1) 1)
+			    (loop (+ ptr 1) (+ column 1))))))))
+	   (end-go-to-point
+	    (lambda ()
+	      (set! end-ptr point-ptr)))
+	   (point-go-to-start
+	    (lambda ()
+	      (set! point-ptr start-ptr)))
+	   (user-go-to-start-none
+	    (lambda ()
+	      (set! user-ptr start-ptr)))
+	   (user-go-to-start-line
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)))
+	   (user-go-to-start-all
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)
+	      (set! user-column start-column)
+	      (set! user-offset start-offset)
+	      (set! user-up-to-date? #t)))
+	   (init-lexeme-none             ; Debute un nouveau lexeme
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-none))
+	      (point-go-to-start)))
+	   (init-lexeme-line
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-line))
+	      (point-go-to-start)))
+	   (init-lexeme-all
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-all))
+	      (point-go-to-start)))
+	   (get-start-line               ; Obtention des stats du debut du lxm
+	    (lambda ()
+	      start-line))
+	   (get-start-column
+	    (lambda ()
+	      start-column))
+	   (get-start-offset
+	    (lambda ()
+	      start-offset))
+	   (peek-left-context            ; Obtention de caracteres (#f si EOF)
+	    (lambda ()
+	      (char->integer (string-ref buffer (- start-ptr 1)))))
+	   (peek-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (char->integer (string-ref buffer point-ptr))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (read-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (let ((c (string-ref buffer point-ptr)))
+		    (set! point-ptr (+ point-ptr 1))
+		    (char->integer c))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (set! point-ptr read-ptr)
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (get-start-end-text           ; Obtention du lexeme
+	    (lambda ()
+	      (substring buffer start-ptr end-ptr)))
+	   (get-user-line-line           ; Fonctions pour l'usager
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      user-line))
+	   (get-user-line-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-line))
+	   (get-user-column-all
+	    (lambda ()
+	      (cond ((< user-ptr start-ptr)
+		     (user-go-to-start-all)
+		     user-column)
+		    (user-up-to-date?
+		     user-column)
+		    (else
+		     (let loop ((ptr start-ptr) (column start-column))
+		       (if (= ptr user-ptr)
+			   (begin
+			     (set! user-column column)
+			     (set! user-up-to-date? #t)
+			     column)
+			   (if (char=? (string-ref buffer ptr) #\newline)
+			       (loop (+ ptr 1) 1)
+			       (loop (+ ptr 1) (+ column 1)))))))))
+	   (get-user-offset-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-offset))
+	   (user-getc-none
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-none))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-line
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(set! user-line (+ user-line 1)))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (set! user-line (+ user-line 1)))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(begin
+			  (set! user-line (+ user-line 1))
+			  (set! user-column 1))
+			(set! user-column (+ user-column 1)))
+		    (set! user-offset (+ user-offset 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (begin
+				(set! user-line (+ user-line 1))
+				(set! user-column 1))
+			      (set! user-column (+ user-column 1)))
+			  (set! user-offset (+ user-offset 1))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-ungetc-none
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (set! user-ptr (- user-ptr 1)))))
+	   (user-ungetc-line
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (set! user-line (- user-line 1))))))))
+	   (user-ungetc-all
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (begin
+			    (set! user-line (- user-line 1))
+			    (set! user-up-to-date? #f))
+			  (set! user-column (- user-column 1)))
+		      (set! user-offset (- user-offset 1)))))))
+	   (reorganize-buffer            ; Decaler ou agrandir le buffer
+	    (lambda ()
+	      (if (< (* 2 start-ptr) buflen)
+		  (let* ((newlen (* 2 buflen))
+			 (newbuf (make-string newlen))
+			 (delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! newbuf
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! buffer    newbuf)
+		    (set! buflen    newlen)
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))
+		  (let ((delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! buffer
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))))))
+	(list (cons 'start-go-to-end
+		    (cond ((eq? counters 'none) start-go-to-end-none)
+			  ((eq? counters 'line) start-go-to-end-line)
+			  ((eq? counters 'all ) start-go-to-end-all)))
+	      (cons 'end-go-to-point
+		    end-go-to-point)
+	      (cons 'init-lexeme
+		    (cond ((eq? counters 'none) init-lexeme-none)
+			  ((eq? counters 'line) init-lexeme-line)
+			  ((eq? counters 'all ) init-lexeme-all)))
+	      (cons 'get-start-line
+		    get-start-line)
+	      (cons 'get-start-column
+		    get-start-column)
+	      (cons 'get-start-offset
+		    get-start-offset)
+	      (cons 'peek-left-context
+		    peek-left-context)
+	      (cons 'peek-char
+		    peek-char)
+	      (cons 'read-char
+		    read-char)
+	      (cons 'get-start-end-text
+		    get-start-end-text)
+	      (cons 'get-user-line
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) get-user-line-line)
+			  ((eq? counters 'all ) get-user-line-all)))
+	      (cons 'get-user-column
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-column-all)))
+	      (cons 'get-user-offset
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-offset-all)))
+	      (cons 'user-getc
+		    (cond ((eq? counters 'none) user-getc-none)
+			  ((eq? counters 'line) user-getc-line)
+			  ((eq? counters 'all ) user-getc-all)))
+	      (cons 'user-ungetc
+		    (cond ((eq? counters 'none) user-ungetc-none)
+			  ((eq? counters 'line) user-ungetc-line)
+			  ((eq? counters 'all ) user-ungetc-all))))))))
+
+; Construit un Input System
+; Le premier parametre doit etre parmi "port", "procedure" ou "string"
+; Prend un parametre facultatif qui doit etre parmi
+; "none", "line" ou "all"
+(define lexer-make-IS
+  (lambda (input-type input . largs)
+    (let ((counters-type (cond ((null? largs)
+				'line)
+			       ((memq (car largs) '(none line all))
+				(car largs))
+			       (else
+				'line))))
+      (cond ((and (eq? input-type 'port) (input-port? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () (read-char input))))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'procedure) (procedure? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  input))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'string) (string? input))
+	     (let* ((buffer   (string-append (string #\newline) input))
+		    (read-ptr (string-length buffer))
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    (else
+	     (let* ((buffer   (string #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))))))
+
+; Les fonctions:
+;   lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+(define lexer-get-func-getc
+  (lambda (IS) (cdr (assq 'user-getc IS))))
+(define lexer-get-func-ungetc
+  (lambda (IS) (cdr (assq 'user-ungetc IS))))
+(define lexer-get-func-line
+  (lambda (IS) (cdr (assq 'get-user-line IS))))
+(define lexer-get-func-column
+  (lambda (IS) (cdr (assq 'get-user-column IS))))
+(define lexer-get-func-offset
+  (lambda (IS) (cdr (assq 'get-user-offset IS))))
+
+;
+; Gestion des lexers
+;
+
+; Fabrication de lexer a partir d'arbres de decision
+(define lexer-make-tree-lexer
+  (lambda (tables IS)
+    (letrec
+	(; Contenu de la table
+	 (counters-type        (vector-ref tables 0))
+	 (<<EOF>>-pre-action   (vector-ref tables 1))
+	 (<<ERROR>>-pre-action (vector-ref tables 2))
+	 (rules-pre-actions    (vector-ref tables 3))
+	 (table-nl-start       (vector-ref tables 5))
+	 (table-no-nl-start    (vector-ref tables 6))
+	 (trees-v              (vector-ref tables 7))
+	 (acc-v                (vector-ref tables 8))
+
+	 ; Contenu du IS
+	 (IS-start-go-to-end    (cdr (assq 'start-go-to-end IS)))
+	 (IS-end-go-to-point    (cdr (assq 'end-go-to-point IS)))
+	 (IS-init-lexeme        (cdr (assq 'init-lexeme IS)))
+	 (IS-get-start-line     (cdr (assq 'get-start-line IS)))
+	 (IS-get-start-column   (cdr (assq 'get-start-column IS)))
+	 (IS-get-start-offset   (cdr (assq 'get-start-offset IS)))
+	 (IS-peek-left-context  (cdr (assq 'peek-left-context IS)))
+	 (IS-peek-char          (cdr (assq 'peek-char IS)))
+	 (IS-read-char          (cdr (assq 'read-char IS)))
+	 (IS-get-start-end-text (cdr (assq 'get-start-end-text IS)))
+	 (IS-get-user-line      (cdr (assq 'get-user-line IS)))
+	 (IS-get-user-column    (cdr (assq 'get-user-column IS)))
+	 (IS-get-user-offset    (cdr (assq 'get-user-offset IS)))
+	 (IS-user-getc          (cdr (assq 'user-getc IS)))
+	 (IS-user-ungetc        (cdr (assq 'user-ungetc IS)))
+
+	 ; Resultats
+	 (<<EOF>>-action   #f)
+	 (<<ERROR>>-action #f)
+	 (rules-actions    #f)
+	 (states           #f)
+	 (final-lexer      #f)
+
+	 ; Gestion des hooks
+	 (hook-list '())
+	 (add-hook
+	  (lambda (thunk)
+	    (set! hook-list (cons thunk hook-list))))
+	 (apply-hooks
+	  (lambda ()
+	    (let loop ((l hook-list))
+	      (if (pair? l)
+		  (begin
+		    ((car l))
+		    (loop (cdr l)))))))
+
+	 ; Preparation des actions
+	 (set-action-statics
+	  (lambda (pre-action)
+	    (pre-action final-lexer IS-user-getc IS-user-ungetc)))
+	 (prepare-special-action-none
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda ()
+		       (action "")))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-line
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (action "" yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-all
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (action "" yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-special-action-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-special-action-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-special-action-all  pre-action)))))
+	 (prepare-action-yytext-none
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-line
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-all
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline yycolumn yyoffset))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-yytext-all  pre-action)))))
+	 (prepare-action-no-yytext-none
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (start-go-to-end)
+		       (action)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-line
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (start-go-to-end)
+		       (action yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-all
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (start-go-to-end)
+		       (action yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-no-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-no-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-no-yytext-all  pre-action)))))
+
+	 ; Fabrique les fonctions de dispatch
+	 (prepare-dispatch-err
+	  (lambda (leaf)
+	    (lambda (c)
+	      #f)))
+	 (prepare-dispatch-number
+	  (lambda (leaf)
+	    (let ((state-function #f))
+	      (let ((result
+		     (lambda (c)
+		       state-function))
+		    (hook
+		     (lambda ()
+		       (set! state-function (vector-ref states leaf)))))
+		(add-hook hook)
+		result))))
+	 (prepare-dispatch-leaf
+	  (lambda (leaf)
+	    (if (eq? leaf 'err)
+		(prepare-dispatch-err leaf)
+		(prepare-dispatch-number leaf))))
+	 (prepare-dispatch-<
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 1))
+		  (right-tree (list-ref tree 2)))
+	      (let ((bound      (list-ref tree 0))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (< c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-=
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 2))
+		  (right-tree (list-ref tree 3)))
+	      (let ((bound      (list-ref tree 1))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (= c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-tree
+	  (lambda (tree)
+	    (cond ((not (pair? tree))
+		   (prepare-dispatch-leaf tree))
+		  ((eq? (car tree) '=)
+		   (prepare-dispatch-= tree))
+		  (else
+		   (prepare-dispatch-< tree)))))
+	 (prepare-dispatch
+	  (lambda (tree)
+	    (let ((dicho-func (prepare-dispatch-tree tree)))
+	      (lambda (c)
+		(and c (dicho-func c))))))
+
+	 ; Fabrique les fonctions de transition (read & go) et (abort)
+	 (prepare-read-n-go
+	  (lambda (tree)
+	    (let ((dispatch-func (prepare-dispatch tree))
+		  (read-char     IS-read-char))
+	      (lambda ()
+		(dispatch-func (read-char))))))
+	 (prepare-abort
+	  (lambda (tree)
+	    (lambda ()
+	      #f)))
+	 (prepare-transition
+	  (lambda (tree)
+	    (if (eq? tree 'err)
+		(prepare-abort     tree)
+		(prepare-read-n-go tree))))
+
+	 ; Fabrique les fonctions d'etats ([set-end] & trans)
+	 (prepare-state-no-acc
+	   (lambda (s r1 r2)
+	     (let ((trans-func (prepare-transition (vector-ref trees-v s))))
+	       (lambda (action)
+		 (let ((next-state (trans-func)))
+		   (if next-state
+		       (next-state action)
+		       action))))))
+	 (prepare-state-yes-no
+	  (lambda (s r1 r2)
+	    (let ((peek-char       IS-peek-char)
+		  (end-go-to-point IS-end-go-to-point)
+		  (new-action1     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   (begin
+				     (end-go-to-point)
+				     new-action1)
+				   action))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-diff-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (peek-char       IS-peek-char)
+		  (new-action1     #f)
+		  (new-action2     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   new-action1
+				   new-action2))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1))
+		       (set! new-action2 (vector-ref rules-actions r2)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-same-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (trans-func (prepare-transition (vector-ref trees-v s)))
+		  (new-action #f))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let ((next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state
+	  (lambda (s)
+	    (let* ((acc (vector-ref acc-v s))
+		   (r1 (car acc))
+		   (r2 (cdr acc)))
+	      (cond ((not r1)  (prepare-state-no-acc   s r1 r2))
+		    ((not r2)  (prepare-state-yes-no   s r1 r2))
+		    ((< r1 r2) (prepare-state-diff-acc s r1 r2))
+		    (else      (prepare-state-same-acc s r1 r2))))))
+
+	 ; Fabrique la fonction de lancement du lexage a l'etat de depart
+	 (prepare-start-same
+	  (lambda (s1 s2)
+	    (let ((peek-char    IS-peek-char)
+		  (eof-action   #f)
+		  (start-state  #f)
+		  (error-action #f))
+	      (let ((result
+		     (lambda ()
+		       (if (not (peek-char))
+			   eof-action
+			   (start-state error-action))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action   <<EOF>>-action)
+		       (set! start-state  (vector-ref states s1))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start-diff
+	  (lambda (s1 s2)
+	    (let ((peek-char         IS-peek-char)
+		  (eof-action        #f)
+		  (peek-left-context IS-peek-left-context)
+		  (start-state1      #f)
+		  (start-state2      #f)
+		  (error-action      #f))
+	      (let ((result
+		     (lambda ()
+		       (cond ((not (peek-char))
+			      eof-action)
+			     ((= (peek-left-context) lexer-integer-newline)
+			      (start-state1 error-action))
+			     (else
+			      (start-state2 error-action)))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action <<EOF>>-action)
+		       (set! start-state1 (vector-ref states s1))
+		       (set! start-state2 (vector-ref states s2))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start
+	  (lambda ()
+	    (let ((s1 table-nl-start)
+		  (s2 table-no-nl-start))
+	      (if (= s1 s2)
+		  (prepare-start-same s1 s2)
+		  (prepare-start-diff s1 s2)))))
+
+	 ; Fabrique la fonction principale
+	 (prepare-lexer-none
+	  (lambda ()
+	    (let ((init-lexeme IS-init-lexeme)
+		  (start-func  (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		((start-func))))))
+	 (prepare-lexer-line
+	  (lambda ()
+	    (let ((init-lexeme    IS-init-lexeme)
+		  (get-start-line IS-get-start-line)
+		  (start-func     (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline (get-start-line)))
+		  ((start-func) yyline))))))
+	 (prepare-lexer-all
+	  (lambda ()
+	    (let ((init-lexeme      IS-init-lexeme)
+		  (get-start-line   IS-get-start-line)
+		  (get-start-column IS-get-start-column)
+		  (get-start-offset IS-get-start-offset)
+		  (start-func       (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline   (get-start-line))
+		      (yycolumn (get-start-column))
+		      (yyoffset (get-start-offset)))
+		  ((start-func) yyline yycolumn yyoffset))))))
+	 (prepare-lexer
+	  (lambda ()
+	    (cond ((eq? counters-type 'none) (prepare-lexer-none))
+		  ((eq? counters-type 'line) (prepare-lexer-line))
+		  ((eq? counters-type 'all)  (prepare-lexer-all))))))
+
+      ; Calculer la valeur de <<EOF>>-action et de <<ERROR>>-action
+      (set! <<EOF>>-action   (prepare-special-action <<EOF>>-pre-action))
+      (set! <<ERROR>>-action (prepare-special-action <<ERROR>>-pre-action))
+
+      ; Calculer la valeur de rules-actions
+      (let* ((len (quotient (vector-length rules-pre-actions) 2))
+	     (v (make-vector len)))
+	(let loop ((r (- len 1)))
+	  (if (< r 0)
+	      (set! rules-actions v)
+	      (let* ((yytext? (vector-ref rules-pre-actions (* 2 r)))
+		     (pre-action (vector-ref rules-pre-actions (+ (* 2 r) 1)))
+		     (action (if yytext?
+				 (prepare-action-yytext    pre-action)
+				 (prepare-action-no-yytext pre-action))))
+		(vector-set! v r action)
+		(loop (- r 1))))))
+
+      ; Calculer la valeur de states
+      (let* ((len (vector-length trees-v))
+	     (v (make-vector len)))
+	(let loop ((s (- len 1)))
+	  (if (< s 0)
+	      (set! states v)
+	      (begin
+		(vector-set! v s (prepare-state s))
+		(loop (- s 1))))))
+
+      ; Calculer la valeur de final-lexer
+      (set! final-lexer (prepare-lexer))
+
+      ; Executer les hooks
+      (apply-hooks)
+
+      ; Resultat
+      final-lexer)))
+
+; Fabrication de lexer a partir de listes de caracteres taggees
+(define lexer-make-char-lexer
+  (let* ((char->class
+	  (lambda (c)
+	    (let ((n (char->integer c)))
+	      (list (cons n n)))))
+	 (merge-sort
+	  (lambda (l combine zero-elt)
+	    (if (null? l)
+		zero-elt
+		(let loop1 ((l l))
+		  (if (null? (cdr l))
+		      (car l)
+		      (loop1
+		       (let loop2 ((l l))
+			 (cond ((null? l)
+				l)
+			       ((null? (cdr l))
+				l)
+			       (else
+				(cons (combine (car l) (cadr l))
+				      (loop2 (cddr l))))))))))))
+	 (finite-class-union
+	  (lambda (c1 c2)
+	    (let loop ((c1 c1) (c2 c2) (u '()))
+	      (if (null? c1)
+		  (if (null? c2)
+		      (reverse u)
+		      (loop c1 (cdr c2) (cons (car c2) u)))
+		  (if (null? c2)
+		      (loop (cdr c1) c2 (cons (car c1) u))
+		      (let* ((r1 (car c1))
+			     (r2 (car c2))
+			     (r1start (car r1))
+			     (r1end (cdr r1))
+			     (r2start (car r2))
+			     (r2end (cdr r2)))
+			(if (<= r1start r2start)
+			    (cond ((< (+ r1end 1) r2start)
+				   (loop (cdr c1) c2 (cons r1 u)))
+				  ((<= r1end r2end)
+				   (loop (cdr c1)
+					 (cons (cons r1start r2end) (cdr c2))
+					 u))
+				  (else
+				   (loop c1 (cdr c2) u)))
+			    (cond ((> r1start (+ r2end 1))
+				   (loop c1 (cdr c2) (cons r2 u)))
+				  ((>= r1end r2end)
+				   (loop (cons (cons r2start r1end) (cdr c1))
+					 (cdr c2)
+					 u))
+				  (else
+				   (loop (cdr c1) c2 u))))))))))
+	 (char-list->class
+	  (lambda (cl)
+	    (let ((classes (map char->class cl)))
+	      (merge-sort classes finite-class-union '()))))
+	 (class-<
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  (else (< b1 b2)))))
+	 (finite-class-compl
+	  (lambda (c)
+	    (let loop ((c c) (start 'inf-))
+	      (if (null? c)
+		  (list (cons start 'inf+))
+		  (let* ((r (car c))
+			 (rstart (car r))
+			 (rend (cdr r)))
+		    (if (class-< start rstart)
+			(cons (cons start (- rstart 1))
+			      (loop c rstart))
+			(loop (cdr c) (+ rend 1))))))))
+	 (tagged-chars->class
+	  (lambda (tcl)
+	    (let* ((inverse? (car tcl))
+		   (cl (cdr tcl))
+		   (class-tmp (char-list->class cl)))
+	      (if inverse? (finite-class-compl class-tmp) class-tmp))))
+	 (charc->arc
+	  (lambda (charc)
+	    (let* ((tcl (car charc))
+		   (dest (cdr charc))
+		   (class (tagged-chars->class tcl)))
+	      (cons class dest))))
+	 (arc->sharcs
+	  (lambda (arc)
+	    (let* ((range-l (car arc))
+		   (dest (cdr arc))
+		   (op (lambda (range) (cons range dest))))
+	      (map op range-l))))
+	 (class-<=
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  (else (<= b1 b2)))))
+	 (sharc-<=
+	  (lambda (sharc1 sharc2)
+	    (class-<= (caar sharc1) (caar sharc2))))
+	 (merge-sharcs
+	  (lambda (l1 l2)
+	    (let loop ((l1 l1) (l2 l2))
+	      (cond ((null? l1)
+		     l2)
+		    ((null? l2)
+		     l1)
+		    (else
+		     (let ((sharc1 (car l1))
+			   (sharc2 (car l2)))
+		       (if (sharc-<= sharc1 sharc2)
+			   (cons sharc1 (loop (cdr l1) l2))
+			   (cons sharc2 (loop l1 (cdr l2))))))))))
+	 (class-= eqv?)
+	 (fill-error
+	  (lambda (sharcs)
+	    (let loop ((sharcs sharcs) (start 'inf-))
+	      (cond ((class-= start 'inf+)
+		     '())
+		    ((null? sharcs)
+		     (cons (cons (cons start 'inf+) 'err)
+			   (loop sharcs 'inf+)))
+		    (else
+		     (let* ((sharc (car sharcs))
+			    (h (caar sharc))
+			    (t (cdar sharc)))
+		       (if (class-< start h)
+			   (cons (cons (cons start (- h 1)) 'err)
+				 (loop sharcs h))
+			   (cons sharc (loop (cdr sharcs)
+					     (if (class-= t 'inf+)
+						 'inf+
+						 (+ t 1)))))))))))
+	 (charcs->tree
+	  (lambda (charcs)
+	    (let* ((op (lambda (charc) (arc->sharcs (charc->arc charc))))
+		   (sharcs-l (map op charcs))
+		   (sorted-sharcs (merge-sort sharcs-l merge-sharcs '()))
+		   (full-sharcs (fill-error sorted-sharcs))
+		   (op (lambda (sharc) (cons (caar sharc) (cdr sharc))))
+		   (table (list->vector (map op full-sharcs))))
+	      (let loop ((left 0) (right (- (vector-length table) 1)))
+		(if (= left right)
+		    (cdr (vector-ref table left))
+		    (let ((mid (quotient (+ left right 1) 2)))
+		      (if (and (= (+ left 2) right)
+			       (= (+ (car (vector-ref table mid)) 1)
+				  (car (vector-ref table right)))
+			       (eqv? (cdr (vector-ref table left))
+				     (cdr (vector-ref table right))))
+			  (list '=
+				(car (vector-ref table mid))
+				(cdr (vector-ref table mid))
+				(cdr (vector-ref table left)))
+			  (list (car (vector-ref table mid))
+				(loop left (- mid 1))
+				(loop mid right))))))))))
+    (lambda (tables IS)
+      (let ((counters         (vector-ref tables 0))
+	    (<<EOF>>-action   (vector-ref tables 1))
+	    (<<ERROR>>-action (vector-ref tables 2))
+	    (rules-actions    (vector-ref tables 3))
+	    (nl-start         (vector-ref tables 5))
+	    (no-nl-start      (vector-ref tables 6))
+	    (charcs-v         (vector-ref tables 7))
+	    (acc-v            (vector-ref tables 8)))
+	(let* ((len (vector-length charcs-v))
+	       (v (make-vector len)))
+	  (let loop ((i (- len 1)))
+	    (if (>= i 0)
+		(begin
+		  (vector-set! v i (charcs->tree (vector-ref charcs-v i)))
+		  (loop (- i 1)))
+		(lexer-make-tree-lexer
+		 (vector counters
+			 <<EOF>>-action
+			 <<ERROR>>-action
+			 rules-actions
+			 'decision-trees
+			 nl-start
+			 no-nl-start
+			 v
+			 acc-v)
+		 IS))))))))
+
+; Fabrication d'un lexer a partir de code pre-genere
+(define lexer-make-code-lexer
+  (lambda (tables IS)
+    (let ((<<EOF>>-pre-action   (vector-ref tables 1))
+	  (<<ERROR>>-pre-action (vector-ref tables 2))
+	  (rules-pre-action     (vector-ref tables 3))
+	  (code                 (vector-ref tables 5)))
+      (code <<EOF>>-pre-action <<ERROR>>-pre-action rules-pre-action IS))))
+
+(define lexer-make-lexer
+  (lambda (tables IS)
+    (let ((automaton-type (vector-ref tables 4)))
+      (cond ((eq? automaton-type 'decision-trees)
+	     (lexer-make-tree-lexer tables IS))
+	    ((eq? automaton-type 'tagged-chars-lists)
+	     (lexer-make-char-lexer tables IS))
+	    ((eq? automaton-type 'code)
+	     (lexer-make-code-lexer tables IS))))))
+
+;
+; Table generated from the file xml-lex.l by SILex 1.0
+;
+
+(define lexer-default-table
+  (vector
+   'line
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+       			'eof
+       ))
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+         		(skribe-error 'xml-fontifier "Parse error" yytext)
+       ))
+   (vector
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+          		(new markup
+			     (markup '&source-string)
+			     (body yytext))
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+       			(new markup
+			     (markup '&source-string)
+			     (body yytext))
+
+;;Comment
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+              		(new markup
+			     (markup '&source-comment)
+			     (body   yytext))
+
+;; Markup
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+           		(new markup
+			     (markup '&source-module)
+			     (body yytext))
+
+;; Regular text
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+         			(begin yytext)
+        )))
+   'decision-trees
+   0
+   0
+   '#((40 (35 (34 1 5) (39 1 4)) (61 (60 1 3) (= 62 2 1))) (40 (35 (34 1
+    err) (39 1 err)) (61 (60 1 err) (= 62 err 1))) err (33 (11 (10 6 err)
+    (32 6 err)) (62 (34 7 6) (63 err 6))) (= 39 8 4) (= 34 9 5) (32 (= 10
+    err 6) (62 (33 err 6) (63 err 6))) (33 (11 (10 6 err) (32 6 err)) (46
+    (45 6 10) (= 62 err 6))) err err (33 (11 (10 6 err) (32 6 err)) (46 (45
+    6 11) (= 62 err 6))) (33 (11 (10 11 12) (32 11 12)) (46 (45 11 13) (=
+    62 12 11))) (= 45 14 12) (33 (11 (10 11 12) (32 11 12)) (46 (45 11 15)
+    (= 62 12 11))) (= 45 16 12) (33 (11 (10 11 12) (32 11 12)) (46 (45 11
+    15) (= 62 17 11))) (46 (45 12 16) (= 62 17 12)) (= 45 14 12))
+   '#((#f . #f) (4 . 4) (3 . 3) (#f . #f) (#f . #f) (#f . #f) (3 . 3) (3 .
+    3) (1 . 1) (0 . 0) (3 . 3) (3 . 3) (#f . #f) (3 . 3) (#f . #f) (3 . 3)
+    (#f . #f) (2 . 2))))
+
+;
+; User functions
+;
+
+(define lexer #f)
+
+(define lexer-get-line   #f)
+(define lexer-getc       #f)
+(define lexer-ungetc     #f)
+
+(define lexer-init
+  (lambda (input-type input)
+    (let ((IS (lexer-make-IS input-type input 'line)))
+      (set! lexer (lexer-make-lexer lexer-default-table IS))
+      (set! lexer-get-line   (lexer-get-func-line IS))
+      (set! lexer-getc       (lexer-get-func-getc IS))
+      (set! lexer-ungetc     (lexer-get-func-ungetc IS)))))
diff --git a/src/guile/skribilo/coloring/xml.scm b/src/guile/skribilo/coloring/xml.scm
new file mode 100644
index 0000000..e3db36f
--- /dev/null
+++ b/src/guile/skribilo/coloring/xml.scm
@@ -0,0 +1,82 @@
+;;; xml.scm -- XML syntax highlighting.
+;;;
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+
+(define-module (skribilo coloring xml)
+  :export (xml)
+  :use-module (skribilo source)
+  :use-module (skribilo lib)
+  :use-module (ice-9 rdelim)
+  :use-module (ice-9 regex))
+
+
+(define %comment-rx (make-regexp "<!--(.|\\n)*-->" regexp/extended))
+
+(define (xml-fontifier str)
+  (let loop ((start 0)
+	     (result '()))
+    (if (>= start (string-length str))
+	(reverse! result)
+	(case (string-ref str start)
+	  ((#\")
+	   (let ((end (string-index str start #\")))
+	     (if (not end)
+		 (skribe-error 'xml-fontifier
+			       "unterminated XML string"
+			       (string-drop str start))
+		 (loop end
+		       (cons (new markup
+				  (markup '&source-string)
+				  (body (substring str start end)))
+			     result)))))
+	  ((#\<)
+	   (let ((end (string-index str #\> start)))
+	     (if (not end)
+		 (skribe-error 'xml-fontifier
+			       "unterminated XML tag"
+			       (string-drop str start))
+		 (let ((comment? (regexp-exec %comment-rx
+					      (substring str start end))))
+		   (loop end
+			 (cons (if comment?
+				   (new markup
+					(markup '&source-comment)
+					(body (substring str start end)))
+				   (new markup
+					(markup '&source-module)
+					(body (substring str start end))))
+			       result))))))
+
+	  (else
+	   (loop (+ 1 start)
+		 (if (or (null? result)
+			 (not (string? (car result))))
+		     (cons (string (string-ref str start)) result)
+		     (cons (string-append (car result)
+					  (string (string-ref str start)))
+			   (cdr result)))))))))
+
+
+(define xml
+  (new language
+       (name "xml")
+       (fontifier xml-fontifier)
+       (extractor #f)))
+
+;;; xml.scm ends here
diff --git a/src/guile/skribilo/condition.scm b/src/guile/skribilo/condition.scm
new file mode 100644
index 0000000..4d61efb
--- /dev/null
+++ b/src/guile/skribilo/condition.scm
@@ -0,0 +1,171 @@
+;;; condition.scm  --  Skribilo SRFI-35 error condition hierarchy.
+;;;
+;;; Copyright 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo condition)
+  :autoload   (srfi srfi-1)  (find)
+  :autoload   (srfi srfi-34) (guard)
+  :use-module (srfi srfi-35)
+  :use-module (srfi srfi-39)
+  :export     (&skribilo-error skribilo-error?
+	       &invalid-argument-error invalid-argument-error?
+	       &too-few-arguments-error too-few-arguments-error?
+
+	       &file-error file-error?
+	       &file-search-error file-search-error?
+	       &file-open-error file-open-error?
+	       &file-write-error file-write-error?
+
+	       register-error-condition-handler!
+	       lookup-error-condition-handler
+
+	       %call-with-skribilo-error-catch
+	       call-with-skribilo-error-catch))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; Top-level of Skribilo's SRFI-35 error conditions.
+;;;
+;;; Code:
+
+
+;;;
+;;; Standard error conditions.
+;;;
+
+(define-condition-type &skribilo-error &error
+  skribilo-error?)
+
+
+;;;
+;;; Generic errors.
+;;;
+
+(define-condition-type &invalid-argument-error &skribilo-error
+  invalid-argument-error?
+  (proc-name invalid-argument-error:proc-name)
+  (argument  invalid-argument-error:argument))
+
+(define-condition-type &too-few-arguments-error &skribilo-error
+  too-few-arguments-error?
+  (proc-name too-few-arguments-error:proc-name)
+  (arguments too-few-arguments-error:arguments))
+
+
+;;;
+;;; File errors.
+;;;
+
+(define-condition-type &file-error &skribilo-error
+  file-error?
+  (file-name file-error:file-name))
+
+(define-condition-type &file-search-error &file-error
+  file-search-error?
+  (path file-search-error:path))
+
+(define-condition-type &file-open-error &file-error
+  file-open-error?)
+
+(define-condition-type &file-write-error &file-error
+  file-write-error?)
+
+
+
+;;;
+;;; Adding new error conditions from other modules.
+;;;
+
+(define %external-error-condition-alist '())
+
+(define (register-error-condition-handler! pred handler)
+  (set! %external-error-condition-alist
+	(cons (cons pred handler)
+	      %external-error-condition-alist)))
+
+(define (lookup-error-condition-handler c)
+  (let ((pair (find (lambda (pair)
+		      (let ((pred (car pair)))
+			(pred c)))
+		    %external-error-condition-alist)))
+    (if (pair? pair)
+	(cdr pair)
+	#f)))
+
+
+
+;;;
+;;; Convenience functions.
+;;;
+
+(define (%call-with-skribilo-error-catch thunk exit exit-val)
+  (guard (c ((invalid-argument-error? c)
+	     (format (current-error-port) "in `~a': invalid argument: ~S~%"
+		     (invalid-argument-error:proc-name c)
+		     (invalid-argument-error:argument c))
+	     (exit exit-val))
+
+	    ((too-few-arguments-error? c)
+	     (format (current-error-port) "in `~a': too few arguments: ~S~%"
+		     (too-few-arguments-error:proc-name c)
+		     (too-few-arguments-error:arguments c)))
+
+	    ((file-search-error? c)
+	     (format (current-error-port) "~a: not found in path `~S'~%"
+		     (file-error:file-name c)
+		     (file-search-error:path c))
+	     (exit exit-val))
+
+	    ((file-open-error? c)
+	     (format (current-error-port) "~a: cannot open file~%"
+		     (file-error:file-name c))
+	     (exit exit-val))
+
+	    ((file-write-error? c)
+	     (format (current-error-port) "~a: cannot write to file~%"
+		     (file-error:file-name c))
+	     (exit exit-val))
+
+	    ((file-error? c)
+	     (format (current-error-port) "file error: ~a~%"
+		     (file-error:file-name c))
+	     (exit exit-val))
+
+	    (;;(skribilo-error? c)
+	     #t ;; XXX: The SRFI-35 currently in `guile-lib' doesn't work
+ 	        ;; properly with non-direct super-types.
+	     (let ((handler (lookup-error-condition-handler c)))
+	       (if (procedure? handler)
+		   (handler c)
+		   (format (current-error-port)
+			   "undefined skribilo error: ~S~%"
+			   c)))
+	     (exit exit-val)))
+
+	 (thunk)))
+
+(define-macro (call-with-skribilo-error-catch thunk)
+  `(call/cc (lambda (cont)
+	      (%call-with-skribilo-error-catch ,thunk cont #f))))
+
+;;; arch-tag: 285010f9-06ea-4c39-82c2-6c3604f668b3
+
+;;; conditions.scm ends here
diff --git a/src/guile/skribilo/config.scm.in b/src/guile/skribilo/config.scm.in
new file mode 100644
index 0000000..545612c
--- /dev/null
+++ b/src/guile/skribilo/config.scm.in
@@ -0,0 +1,20 @@
+;;; -*- Scheme -*-
+;;;
+
+(define-module (skribilo config))
+
+(define-public (skribilo-release)             "1.2")
+(define-public (skribilo-url)                 "http://www.nongnu.org/skribilo/")
+(define-public (skribilo-doc-directory)       "@SKRIBILO_DOC_DIR@")
+(define-public (skribilo-extension-directory) "@SKRIBILO_EXT_DIR@")
+(define-public (skribilo-default-path)        "@SKRIBILO_SKR_PATH@")
+(define-public (skribilo-scheme)              "guile")
+
+;; Compatibility.
+
+(define-public skribe-release      skribilo-release)
+(define-public skribe-url          skribilo-url)
+(define-public skribe-doc-dir      skribilo-doc-directory)
+(define-public skribe-ext-dir      skribilo-extension-directory)
+(define-public skribe-default-path skribilo-default-path)
+(define-public skribe-scheme       skribilo-scheme)
diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
new file mode 100644
index 0000000..f7709a0
--- /dev/null
+++ b/src/guile/skribilo/debug.scm
@@ -0,0 +1,168 @@
+;;; debug.scm  --  Debugging facilities.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+(define-module (skribilo debug)
+  :use-module (skribilo utils syntax)
+  :use-module (srfi srfi-17)
+  :use-module (srfi srfi-39)
+  :export-syntax (debug-item with-debug))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; Parameters.
+;;;
+
+;; Current debugging level.
+(define-public *debug*
+  (make-parameter 0 (lambda (val)
+		      (cond ((number? val) val)
+			    ((string? val)
+			     (string->number val))
+			    (else
+			     (error "*debug*: wrong argument type"
+				    val))))))
+
+;; Whether to use colors.
+(define-public *debug-use-colors?* (make-parameter #t))
+
+;; Where to spit debugging output.
+(define-public *debug-port* (make-parameter (current-output-port)))
+
+;; Whether to debug individual items.
+(define-public *debug-item?* (make-parameter #f))
+
+;; Watched (debugged) symbols (procedure names).
+(define-public *watched-symbols* (make-parameter '()))
+
+
+
+;;;
+;;; Implementation.
+;;;
+
+(define *debug-depth*   (make-parameter 0))
+(define *debug-margin*	(make-parameter ""))
+(define *margin-level*  (make-parameter 0))
+
+
+
+;;
+;;   debug-port
+;;
+; (define (debug-port . o)
+;    (cond
+;       ((null? o)
+;        *debug-port*)
+;       ((output-port? (car o))
+;        (set! *debug-port* o)
+;        o)
+;       (else
+;        (error 'debug-port "Illegal debug port" (car o)))))
+;
+
+;;;
+;;; debug-color
+;;;
+(define (debug-color col . o)
+  (with-output-to-string
+    (if (and (*debug-use-colors?*)
+	     (equal? (getenv "TERM") "xterm"))
+	(lambda ()
+	  (format #t "[1;~Am" (+ 31 col))
+	  (for-each display o)
+	  (display ""))
+	(lambda ()
+	  (for-each display o)))))
+
+;;;
+;;; debug-bold
+;;;
+(define (debug-bold . o)
+   (apply debug-color -30 o))
+
+;;;
+;;; debug-item
+;;;
+(define-macro (debug-item . args)
+  `(if (*debug-item?*) (%do-debug-item ,@args)))
+
+(define-public (%do-debug-item . args)
+  (begin
+    (display (*debug-margin*) (*debug-port*))
+    (display (debug-color (- (*debug-depth*) 1) "- ") (*debug-port*))
+    (for-each (lambda (a) (display a (*debug-port*))) args)
+    (newline (*debug-port*))))
+
+;;(define-macro (debug-item  . args)
+;;  `())
+
+
+;;;
+;;; %with-debug-margin
+;;;
+(define (%with-debug-margin margin thunk)
+  (parameterize ((*debug-depth*   (+ (*debug-depth*) 1))
+		 (*debug-margin*  (string-append (*debug-margin*) margin)))
+    (thunk)))
+
+;;;
+;;; %with-debug
+;;;
+(define-public (%do-with-debug lvl lbl thunk)
+  (parameterize ((*margin-level* lvl)
+                 (*debug-item?* #t))
+    (display (*debug-margin*) (*debug-port*))
+    (display (if (= (*debug-depth*) 0)
+                 (debug-color (*debug-depth*) "+ " lbl)
+                 (debug-color (*debug-depth*) "--+ " lbl))
+             (*debug-port*))
+    (newline (*debug-port*))
+    (%with-debug-margin (debug-color (*debug-depth*) "  |")
+                        thunk)))
+
+(define-macro (with-debug level label . body)
+  ;; We have this as a macro in order to avoid procedure calls in the
+  ;; non-debugging case.  Unfortunately, the macro below duplicates BODY,
+  ;; which has a negative impact on memory usage and startup time (XXX).
+  (if (number? level)
+      `(if (or (>= (*debug*) ,level)
+               (memq ,label (*watched-symbols*)))
+           (%do-with-debug ,level ,label (lambda () ,@body))
+           (begin ,@body))
+      (error "with-debug: syntax error")))
+
+
+; Example:
+
+; (with-debug 0 'foo1.1
+;   (debug-item 'foo2.1)
+;   (debug-item 'foo2.2)
+;   (with-debug 0 'foo2.3
+;      (debug-item 'foo3.1)
+;      (with-debug 0 'foo3.2
+;	(debug-item 'foo4.1)
+;	(debug-item 'foo4.2))
+;      (debug-item 'foo3.3))
+;   (debug-item 'foo2.4))
+
+;;; debug.scm ends here
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
new file mode 100644
index 0000000..06667ad
--- /dev/null
+++ b/src/guile/skribilo/engine.scm
@@ -0,0 +1,390 @@
+;;; engine.scm	-- Skribilo engines.
+;;;
+;;; Copyright 2003-2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2005  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo engine)
+  :use-module (skribilo debug)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo lib)
+
+  ;; `(skribilo writer)' depends on this module so it needs to be loaded
+  ;; after we defined `<engine>' and the likes.
+  :autoload (skribilo writer) (<writer>)
+
+  :use-module (oop goops)
+  :use-module (ice-9 optargs)
+  :autoload   (srfi srfi-39)  (make-parameter)
+
+  :export (<engine> engine? engine-ident engine-format
+		    engine-customs engine-filter engine-symbol-table
+
+	   *current-engine*
+	   default-engine default-engine-set!
+	   make-engine copy-engine find-engine lookup-engine
+	   engine-custom engine-custom-set! engine-custom-add!
+	   engine-format? engine-add-writer!
+	   processor-get-engine
+	   push-default-engine pop-default-engine
+
+	   engine-loaded? when-engine-is-loaded))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; Class definition.
+;;;
+
+;; Note on writers
+;; ---------------
+;;
+;; `writers' here is an `eq?' hash table where keys are markup names
+;; (symbols) and values are lists of markup writers (most of the time, the
+;; list will only contain one writer).  Each of these writer may define a
+;; predicate or class that may further restrict its applicability.
+;;
+;; `free-writers' is a list of writers that may apply to *any* kind of
+;; markup.  These are typically define by passing `#t' to `markup-writer'
+;; instead of a symbol:
+;;
+;;   (markup-writer #f (find-engine 'xml)
+;;     :before ...
+;;     ...)
+;;
+;; The XML engine contains an example of such free writers.  Again, these
+;; writers may define a predicate or a class restricting their applicability.
+;;
+;; The distinction between these two kinds of writers is mostly performance:
+;; "free writers" are rarely used and markup-specific are the most common
+;; case which we want to be fast.  Therefore, for the latter case, we can't
+;; afford traversing a list of markups, evaluating each and every markup
+;; predicate.
+;;
+;; For more details, see `markup-writer-get' and `lookup-markup-writer' in
+;; `(skribilo writer)'.
+
+(define-class <engine> ()
+  (ident		:init-keyword :ident		:init-value '???)
+  (format		:init-keyword :format		:init-value "raw")
+  (info		        :init-keyword :info		:init-value '())
+  (version		:init-keyword :version
+			:init-value 'unspecified)
+  (delegate		:init-keyword :delegate		:init-value #f)
+  (writers              :init-thunk make-hash-table)
+  (free-writers         :init-value '())
+  (filter		:init-keyword :filter		:init-value #f)
+  (customs		:init-keyword :custom		:init-value '())
+  (symbol-table	:init-keyword :symbol-table	:init-value '()))
+
+
+(define (engine? obj)
+  (is-a? obj <engine>))
+
+(define (engine-ident obj)
+  (slot-ref obj 'ident))
+
+(define (engine-format obj)
+  (slot-ref obj 'format))
+
+(define (engine-customs obj)
+  (slot-ref obj 'customs))
+
+(define (engine-filter obj)
+  (slot-ref obj 'filter))
+
+(define (engine-symbol-table obj)
+  (slot-ref obj 'symbol-table))
+
+
+
+;;;
+;;; Default engines.
+;;;
+
+(define *default-engine*	#f)
+(define *default-engines*	'())
+
+
+(define (default-engine)
+   *default-engine*)
+
+
+(define (default-engine-set! e)
+  (with-debug 5 'default-engine-set!
+     (debug-item "engine=" e)
+
+     (if (not (engine? e))
+	 (skribe-error 'default-engine-set! "bad engine ~S" e))
+     (set! *default-engine* e)
+     (set! *default-engines* (cons e *default-engines*))
+     e))
+
+
+(define (push-default-engine e)
+   (set! *default-engines* (cons e *default-engines*))
+   (default-engine-set! e))
+
+(define (pop-default-engine)
+   (if (null? *default-engines*)
+       (skribe-error 'pop-default-engine "Empty engine stack" '())
+       (begin
+	  (set! *default-engines* (cdr *default-engines*))
+	  (if (pair? *default-engines*)
+	      (default-engine-set! (car *default-engines*))
+	      (set! *default-engine* #f)))))
+
+
+(define (processor-get-engine combinator newe olde)
+  (cond
+    ((procedure? combinator)
+     (combinator newe olde))
+    ((engine? newe)
+     newe)
+    (else
+     olde)))
+
+
+(define (engine-format? fmt . e)
+  (let ((e (cond
+	     ((pair? e) (car e))
+	     (else (*current-engine*)))))
+    (if (not (engine? e))
+	(skribe-error 'engine-format? "no engine" e)
+	(string=? fmt (engine-format e)))))
+
+;;;
+;;; MAKE-ENGINE
+;;;
+(define* (make-engine ident :key (version 'unspecified)
+				(format "raw")
+				(filter #f)
+				(delegate #f)
+				(symbol-table '())
+				(custom '())
+				(info '()))
+  (let ((e (make <engine> :ident ident :version version :format format
+			  :filter filter :delegate delegate
+			  :symbol-table symbol-table
+			  :custom custom :info info)))
+    e))
+
+
+;;;
+;;; COPY-ENGINE
+;;;
+(define* (copy-engine ident e :key (version 'unspecified)
+				  (filter #f)
+				  (delegate #f)
+				  (symbol-table #f)
+				  (custom #f))
+  (let ((new (shallow-clone e)))
+    (slot-set! new 'ident	 ident)
+    (slot-set! new 'version	 version)
+    (slot-set! new 'filter	 (or filter (slot-ref e 'filter)))
+    (slot-set! new 'delegate	 (or delegate (slot-ref e 'delegate)))
+    (slot-set! new 'symbol-table (or symbol-table (slot-ref e 'symbol-table)))
+    (slot-set! new 'customs	 (or custom (slot-ref e 'customs)))
+
+    ;; XXX: We don't use `list-copy' here because writer lists are only
+    ;; consed, never mutated.
+
+    ;(slot-set! new 'free-writers (list-copy (slot-ref e 'free-writers)))
+
+    (let ((new-writers (make-hash-table)))
+      (hash-for-each (lambda (m w*)
+		       (hashq-set! new-writers m w*))
+		     (slot-ref e 'writers))
+      (slot-set! new 'writers new-writers))
+
+    new))
+
+
+
+;;;
+;;; Engine loading.
+;;;
+
+;; Each engine is to be stored in its own module with the `(skribilo engine)'
+;; hierarchy.  The `engine-id->module-name' procedure returns this module
+;; name based on the engine name.
+
+(define (engine-id->module-name id)
+  `(skribilo engine ,id))
+
+(define (engine-loaded? id)
+  "Check whether engine @var{id} is already loaded."
+  ;; Trick taken from `resolve-module' in `boot-9.scm'.
+  (nested-ref the-root-module
+	      `(%app modules ,@(engine-id->module-name id))))
+
+;; A mapping of engine names to hooks.
+(define %engine-load-hook (make-hash-table))
+
+(define (consume-load-hook! id)
+  (with-debug 5 'consume-load-hook!
+    (let ((hook (hashq-ref %engine-load-hook id)))
+      (if hook
+	  (begin
+	    (debug-item "running hook " hook " for engine " id)
+	    (hashq-remove! %engine-load-hook id)
+	    (run-hook hook))))))
+
+(define (when-engine-is-loaded id thunk)
+  "Run @var{thunk} only when engine with identifier @var{id} is loaded."
+  (if (engine-loaded? id)
+      (begin
+	;; Maybe the engine had already been loaded via `use-modules'.
+	(consume-load-hook! id)
+	(thunk))
+      (let ((hook (or (hashq-ref %engine-load-hook id)
+		      (let ((hook (make-hook)))
+			(hashq-set! %engine-load-hook id hook)
+			hook))))
+	(add-hook! hook thunk))))
+
+
+(define* (lookup-engine id :key (version 'unspecified))
+  "Look for an engine named @var{name} (a symbol) in the @code{(skribilo
+engine)} module hierarchy.  If no such engine was found, an error is raised,
+otherwise the requested engine is returned."
+  (with-debug 5 'lookup-engine
+     (debug-item "id=" id " version=" version)
+
+     (let* ((engine (symbol-append id '-engine))
+	    (m (resolve-module (engine-id->module-name id))))
+       (if (module-bound? m engine)
+	   (let ((e (module-ref m engine)))
+	     (if e (consume-load-hook! id))
+	     e)
+	   (error "no such engine" id)))))
+
+(define* (find-engine id :key (version 'unspecified))
+  (false-if-exception (apply lookup-engine (list id version))))
+
+
+
+
+
+;;;
+;;; Engine methods.
+;;;
+
+(define (engine-custom e id)
+  (let* ((customs (slot-ref e 'customs))
+	 (c       (assq id customs)))
+    (if (pair? c)
+	(cadr c)
+	'unspecified)))
+
+
+(define (engine-custom-set! e id val)
+  (let* ((customs (slot-ref e 'customs))
+	 (c       (assq id customs)))
+    (if (pair? c)
+	(set-car! (cdr c) val)
+	(slot-set! e 'customs (cons (list id val) customs)))))
+
+(define (engine-custom-add! e id val)
+   (let ((old (engine-custom e id)))
+      (if (unspecified? old)
+	  (engine-custom-set! e id (list val))
+	  (engine-custom-set! e id (cons val old)))))
+
+(define (engine-add-writer! e ident pred upred opt before action
+			    after class valid)
+  ;; Add a writer to engine E.  If IDENT is a symbol, then it should denote
+  ;; a markup name and the writer being added is specific to that markup.  If
+  ;; IDENT is `#t' (for instance), then it is assumed to be a ``free writer''
+  ;; that may apply to any kind of markup for which PRED returns true.
+
+  (define (check-procedure name proc arity)
+    (cond
+      ((not (procedure? proc))
+	 (skribe-error ident "Illegal procedure" proc))
+      ((not (equal? (%procedure-arity proc) arity))
+	 (skribe-error ident
+		       (format #f "Illegal ~S procedure" name)
+		       proc))))
+
+  (define (check-output name proc)
+    (and proc (or (string? proc) (check-procedure name proc 2))))
+
+  ;;
+  ;; Engine-add-writer! starts here
+  ;;
+  (if (not (is-a? e <engine>))
+      (skribe-error ident "Illegal engine" e))
+
+  ;; check the options
+  (if (not (or (eq? opt 'all) (list? opt)))
+      (skribe-error ident "Illegal options" opt))
+
+  ;; check the correctness of the predicate
+  (if pred
+      (check-procedure "predicate" pred 2))
+
+  ;; check the correctness of the validation proc
+  (if valid
+      (check-procedure "validate" valid 2))
+
+  ;; check the correctness of the three actions
+  (check-output "before" before)
+  (check-output "action" action)
+  (check-output "after" after)
+
+  ;; create a new writer and bind it
+  (let ((n (make <writer>
+	     :ident (if (symbol? ident) ident 'all)
+	     :class class :pred pred :upred upred :options opt
+	     :before before :action action :after after
+	     :validate valid)))
+    (if (symbol? ident)
+	(let ((writers (slot-ref e 'writers)))
+	  (hashq-set! writers ident
+		      (cons n (hashq-ref writers ident '()))))
+	(slot-set! e 'free-writers
+		   (cons n (slot-ref e 'free-writers))))
+    n))
+
+
+
+;;;
+;;; Current engine.
+;;;
+
+;;; `(skribilo module)' must be loaded before the first `find-engine' call.
+(use-modules (skribilo module))
+
+;; At this point, we're almost done with the bootstrap process.
+;(format #t "base engine: ~a~%" (lookup-engine 'base))
+
+(define *current-engine*
+  ;; By default, use the HTML engine.
+  (make-parameter (lookup-engine 'html)
+		  (lambda (val)
+		    (cond ((symbol? val) (lookup-engine val))
+			  ((engine? val) val)
+			  (else
+			   (error "invalid value for `*current-engine*'"
+				  val))))))
+
+
+;;; engine.scm ends here
diff --git a/src/guile/skribilo/engine/Makefile.am b/src/guile/skribilo/engine/Makefile.am
new file mode 100644
index 0000000..7b6ec2c
--- /dev/null
+++ b/src/guile/skribilo/engine/Makefile.am
@@ -0,0 +1,5 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/engine
+dist_guilemodule_DATA = base.scm context.scm html.scm html4.scm	\
+			latex-simple.scm latex.scm		\
+			lout.scm				\
+			xml.scm
diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm
new file mode 100644
index 0000000..8418e8b
--- /dev/null
+++ b/src/guile/skribilo/engine/base.scm
@@ -0,0 +1,479 @@
+;;; base.scm  --  BASE Skribe engine
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo engine base))
+
+;*---------------------------------------------------------------------*/
+;*    base-engine ...                                                  */
+;*---------------------------------------------------------------------*/
+(define base-engine
+   (default-engine-set!
+      (make-engine 'base
+		   :version 'plain
+		   :symbol-table '(("iexcl" "!")
+				   ("cent" "c")
+				   ("lguillemet" "\"")
+				   ("not" "!")
+				   ("registered" "(r)")
+				   ("degree" "o")
+				   ("plusminus" "+/-")
+				   ("micro" "o")
+				   ("paragraph" "p")
+				   ("middot" ".")
+				   ("rguillemet" "\"")
+				   ("iquestion" "?")
+				   ("Agrave" "À")
+				   ("Aacute" "A")
+				   ("Acircumflex" "Â")
+				   ("Atilde" "A")
+				   ("Amul" "A")
+				   ("Aring" "A")
+				   ("AEligature" "AE")
+				   ("Oeligature" "OE")
+				   ("Ccedilla" "Ç")
+				   ("Egrave" "È")
+				   ("Eacute" "É")
+				   ("Ecircumflex" "Ê")
+				   ("Euml" "E")
+				   ("Igrave" "I")
+				   ("Iacute" "I")
+				   ("Icircumflex" "Î")
+				   ("Iuml" "I")
+				   ("ETH" "D")
+				   ("Ntilde" "N")
+				   ("Ograve" "O")
+				   ("Oacute" "O")
+				   ("Ocurcumflex" "O")
+				   ("Otilde" "O")
+				   ("Ouml" "O")
+				   ("times" "x")
+				   ("Oslash" "O")
+				   ("Ugrave" "Ù")
+				   ("Uacute" "U")
+				   ("Ucircumflex" "Û")
+				   ("Uuml" "Ü")
+				   ("Yacute" "Y")
+				   ("agrave" "à")
+				   ("aacute" "a")
+				   ("acircumflex" "â")
+				   ("atilde" "a")
+				   ("amul" "a")
+				   ("aring" "a")
+				   ("aeligature" "æ")
+				   ("oeligature" "oe")
+				   ("ccedilla" "ç")
+				   ("egrave" "è")
+				   ("eacute" "é")
+				   ("ecircumflex" "ê")
+				   ("euml" "e")
+				   ("igrave" "i")
+				   ("iacute" "i")
+				   ("icircumflex" "î")
+				   ("iuml" "i")
+				   ("ntilde" "n")
+				   ("ograve" "o")
+				   ("oacute" "o")
+				   ("ocurcumflex" "o")
+				   ("otilde" "o")
+				   ("ouml" "o")
+				   ("divide" "/")
+				   ("oslash" "o")
+				   ("ugrave" "ù")
+				   ("uacute" "u")
+				   ("ucircumflex" "û")
+				   ("uuml" "ü")
+				   ("yacute" "y")
+				   ("ymul" "y")
+				   ;; punctuation
+				   ("bullet" ".")
+				   ("ellipsis" "...")
+				   ("<-" "<-")
+				   ("<--" "<--")
+				   ("uparrow" "^;")
+				   ("->" "->")
+				   ("-->" "-->")
+				   ("downarrow" "v")
+				   ("<->" "<->")
+				   ("<-->" "<-->")
+				   ("<+" "<+")
+				   ("<=" "<=;")
+				   ("<==" "<==")
+				   ("Uparrow" "^")
+				   ("=>" "=>")
+				   ("==>" "==>")
+				   ("Downarrow" "v")
+				   ("<=>" "<=>")
+				   ("<==>" "<==>")
+				   ;; Mathematical operators
+				   ("asterisk" "*")
+				   ("angle" "<")
+				   ("and" "^;")
+				   ("or" "v")
+				   ("models" "|=")
+				   ("vdash" "|-")
+				   ("dashv" "-|")
+				   ("sim" "~")
+				   ("mid" "|")
+				   ("langle" "<")
+				   ("rangle" ">")
+				   ;; LaTeX
+				   ("circ" "o")
+				   ("top" "T")
+				   ("lhd" "<")
+				   ("rhd" ">")
+				   ("parallel" "||")))))
+
+;*---------------------------------------------------------------------*/
+;*    mark ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'symbol
+   :action (lambda (n e)
+	      (let* ((s (markup-body n))
+		     (c (assoc s (engine-symbol-table e))))
+		 (if (pair? c)
+		     (display (cadr c))
+		     (output s e)))))
+
+;*---------------------------------------------------------------------*/
+;*    unref ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'unref
+   :options 'all
+   :action (lambda (n e)
+	      (let* ((s (markup-option n :skribe))
+		     (k (markup-option n 'kind))
+		     (f (cond
+			   (s
+			    (format #f "?~a@~a " k s))
+			   (else
+			    (format #f "?~a " k))))
+		     (msg (list f (markup-body n)))
+		     (n (list "[" (color :fg "red" (bold msg)) "]")))
+		 (skribe-eval n e))))
+
+;*---------------------------------------------------------------------*/
+;*    &the-bibliography ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-bibliography
+   :before (lambda (n e)
+	      (let ((w (markup-writer-get 'table e)))
+		 (and (writer? w) (invoke (writer-before w) n e))))
+   :action (lambda (n e)
+	      (when (pair? (markup-body n))
+		 (for-each (lambda (i) (output i e)) (markup-body n))))
+   :after (lambda (n e)
+	     (let ((w (markup-writer-get 'table e)))
+		(and (writer? w) (invoke (writer-after w) n e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry
+   :options '(:title)
+   :before (lambda (n e)
+	      (invoke (writer-before (markup-writer-get 'tr e)) n e))
+   :action (lambda (n e)
+	      (let ((wtc (markup-writer-get 'tc e)))
+		 ;; the label
+		 (markup-option-add! n :valign 'top)
+		 (markup-option-add! n :align 'right)
+		 (invoke (writer-before wtc) n e)
+		 (output n e (markup-writer-get '&bib-entry-label e))
+		 (invoke (writer-after wtc) n e)
+		 ;; the body
+		 (markup-option-add! n :valign 'top)
+		 (markup-option-add! n :align 'left)
+		 (invoke (writer-before wtc) n e)
+		 (output n e (markup-writer-get '&bib-entry-body))
+		 (invoke (writer-after wtc) n e)))
+   :after (lambda (n e)
+	     (invoke (writer-after (markup-writer-get 'tr e)) n e)))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-label ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before "["
+   :action (lambda (n e) (output (markup-option n :title) e))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-body ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-body
+   :action (lambda (n e)
+	      (define (output-fields descr)
+		 (let loop ((descr descr)
+			    (pending #f)
+			    (armed #f))
+		    (cond
+		       ((null? descr)
+			'done)
+		       ((pair? (car descr))
+			(if (eq? (caar descr) 'or)
+			    (let ((o1 (cadr (car descr))))
+			       (if (markup-option n o1)
+				   (loop (cons o1 (cdr descr))
+					 pending
+					 #t)
+				   (let ((o2 (caddr (car descr))))
+				      (loop (cons o2 (cdr descr))
+					    pending
+					    armed))))
+			    (let ((o (markup-option n (cadr (car descr)))))
+			       (if o
+				   (begin
+				      (if (and pending armed)
+					  (output pending e))
+				      (output (caar descr) e)
+				      (output o e)
+				      (if (pair? (cddr (car descr)))
+					  (output (caddr (car descr)) e))
+				      (loop (cdr descr) #f #t))
+				   (loop (cdr descr) pending armed)))))
+		       ((symbol? (car descr))
+			(let ((o (markup-option n (car descr))))
+			   (if o
+			       (begin
+				  (if (and armed pending)
+				      (output pending e))
+				  (output o e)
+				  (loop (cdr descr) #f #t))
+			       (loop (cdr descr) pending armed))))
+		       ((null? (cdr descr))
+			(output (car descr) e))
+		       ((string? (car descr))
+			(loop (cdr descr)
+			      (if pending pending (car descr))
+			      armed))
+		       (else
+			(skribe-error 'output-bib-fields
+				      "Illegal description"
+				      (car descr))))))
+	      (output-fields
+	       (case (markup-option n 'kind)
+		  ((techreport)
+		   `(author " -- " (or title url documenturl) " -- "
+			    number ", " institution ", "
+			    address ", " month ", " year ", "
+			    ("pp. " pages) "."))
+		  ((article)
+		   `(author " -- " (or title url documenturl) " -- "
+			    journal ", " volume "" ("(" number ")") ", "
+			    address ", " month ", " year ", "
+			    ("pp. " pages) "."))
+		  ((inproceedings)
+		   `(author " -- " (or title url documenturl) " -- "
+			    booktitle ", " series ", " ("(" number ")") ", "
+			    address ", " month ", " year ", "
+			    ("pp. " pages) "."))
+		  ((book)
+		   '(author " -- " (or title url documenturl) " -- "
+			    publisher ", " address
+			    ", " month ", " year ", " ("pp. " pages) "."))
+		  ((phdthesis)
+		   '(author " -- " (or title url documenturl) " -- " type ", "
+			    school ", " address
+			    ", " month ", " year"."))
+		  ((misc)
+		   '(author " -- " (or title url documenturl) " -- "
+			    publisher ", " address
+			    ", " month ", " year"."))
+		  (else
+		   '(author " -- " (or title url documenturl) " -- "
+			    publisher ", " address
+			    ", " month ", " year ", " ("pp. " pages) "."))))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-ident ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-ident
+   :action (lambda (n e)
+	      (output (markup-option n 'number) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-title ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+   :action (lambda (n e)
+	      (skribe-eval (bold (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-publisher ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-publisher
+   :action (lambda (n e)
+	      (skribe-eval (it (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &the-index ...  @label the-index@                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index
+   :options '(:column)
+   :before (lambda (n e)
+	      (output (markup-option n 'header) e))
+   :action (lambda (n e)
+	      (define (make-mark-entry n fst)
+		 (let ((l (tr :class 'index-mark-entry
+			     (td :colspan 2 :align 'left
+				(bold (it (sf n)))))))
+		    (if fst
+			(list l)
+			(list (tr (td :colspan 2)) l))))
+	      (define (make-primary-entry n p)
+		 (let* ((note (markup-option n :note))
+			(b (markup-body n))
+			(c (if note
+			       (list b
+				     (it (list " (" note ")")))
+			       b)))
+		    (when p
+		       (markup-option-add! b :text
+					   (list (markup-option b :text)
+						 ", p."))
+		       (markup-option-add! b :page #t))
+		    (tr :class 'index-primary-entry
+		       (td :colspan 2 :valign 'top :align 'left c))))
+	      (define (make-secondary-entry n p)
+		 (let* ((note (markup-option n :note))
+			(b (markup-body n))
+			(bb (markup-body b)))
+		    (cond
+		       ((not (or bb (is-markup? b 'url-ref)))
+			(skribe-error 'the-index
+				      "Illegal entry"
+				      b))
+		       (note
+			(let ((r (if bb
+				     (it (ref :class "the-index-secondary"
+					    :handle bb
+					    :page p
+					    :text (if p
+						      (list note ", p.")
+						      note)))
+				     (it (ref :class "the-index-secondary"
+					    :url (markup-option b :url)
+					    :page p
+					    :text (if p
+						      (list note ", p.")
+						      note))))))
+			   (tr :class 'index-secondary-entry
+			      (td :valign 'top :align 'right :width 1. " ...")
+			      (td :valign 'top :align 'left r))))
+		       (else
+			(let ((r (if bb
+				     (ref :class "the-index-secondary"
+					:handle bb
+					:page p
+					:text (if p " ..., p." " ..."))
+				     (ref :class "the-index-secondary"
+					:url (markup-option b :url)
+					:page p
+					:text (if p " ..., p." " ...")))))
+			   (tr :class 'index-secondary-entry
+			      (td :valign 'top :align 'right :width 1.)
+			      (td :valign 'top :align 'left r)))))))
+	      (define (make-column ie p)
+		 (let loop ((ie ie)
+			    (f #t))
+		    (cond
+		       ((null? ie)
+			'())
+		       ((not (pair? (car ie)))
+			(append (make-mark-entry (car ie) f)
+				(loop (cdr ie) #f)))
+		       (else
+			(cons (make-primary-entry (caar ie) p)
+			      (append (map (lambda (x)
+					      (make-secondary-entry x p))
+					   (cdar ie))
+				      (loop (cdr ie) #f)))))))
+	      (define (make-sub-tables ie nc p)
+		 (let* ((l (length ie))
+			(w (/ 100. nc))
+			(iepc (let ((d (/ l nc)))
+				 (if (integer? d)
+				     (inexact->exact d)
+				     (+ 1 (inexact->exact (truncate d))))))
+			(split (list-split ie iepc)))
+		    (tr (map (lambda (ies)
+				(td :valign 'top :width w
+				   (if (pair? ies)
+				       (table :width 100. (make-column ies p))
+				       "")))
+			     split))))
+	      (let* ((ie (markup-body n))
+		     (nc (markup-option n :column))
+		     (loc (ast-loc n))
+		     (pref (eq? (engine-custom e 'index-page-ref) #t))
+		     (t (cond
+			   ((null? ie)
+			    "")
+			   ;; FIXME: Since we don't support
+			   ;; `:&skribe-eval-location', we could set up a
+			   ;; `parameterize' thing around `skribe-eval' to
+			   ;; provide it with the right location information.
+			   ((or (not (integer? nc)) (= nc 1))
+			    (table :width 100.
+			       ;;:&skribe-eval-location loc
+			       :class "index-table"
+			       (make-column ie pref)))
+			   (else
+			    (table :width 100.
+			       ;;:&skribe-eval-location loc
+			       :class "index-table"
+			       (make-sub-tables ie nc pref))))))
+		 (output (skribe-eval t e) e))))
+
+;*---------------------------------------------------------------------*/
+;*    &the-index-header ...                                            */
+;*    -------------------------------------------------------------    */
+;*    The index header is only useful for targets that support         */
+;*    hyperlinks such as HTML.                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index-header
+   :action (lambda (n e) #f))
+
+;*---------------------------------------------------------------------*/
+;*    &prog-line ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&prog-line
+   :before (lambda (n e)
+	      (let ((n (markup-ident n)))
+		 (if n (skribe-eval (it (list n) ": ") e))))
+   :after "\n")
+
+;*---------------------------------------------------------------------*/
+;*    line-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+   :options '(:offset)
+   :action (lambda (n e)
+	      (let ((o (markup-option n :offset))
+		    (n (markup-ident (handle-body (markup-body n)))))
+		 (skribe-eval (it (if (integer? o) (+ o n) n)) e))))
+
+
+
+;;;; A VIRER (mais handle-body n'est pas défini)
+(markup-writer 'line-ref
+   :options '(:offset)
+   :action #f)
diff --git a/src/guile/skribilo/engine/context.scm b/src/guile/skribilo/engine/context.scm
new file mode 100644
index 0000000..c9e0986
--- /dev/null
+++ b/src/guile/skribilo/engine/context.scm
@@ -0,0 +1,1382 @@
+;;;;
+;;;; context.skr	-- ConTeXt mode for Skribe
+;;;;
+;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;;; USA.
+;;;;
+;;;;           Author: Erick Gallesio [eg@essi.fr]
+;;;;    Creation date: 23-Sep-2004 17:21 (eg)
+;;;; Last file update:  3-Nov-2004 12:54 (eg)
+;;;;
+
+(define-skribe-module (skribilo engine context))
+
+;;;; ======================================================================
+;;;;	context-customs ...
+;;;; ======================================================================
+(define context-customs
+  '((source-comment-color "#ffa600")
+    (source-error-color "red")
+    (source-define-color "#6959cf")
+    (source-module-color "#1919af")
+    (source-markup-color "#1919af")
+    (source-thread-color "#ad4386")
+    (source-string-color "red")
+    (source-bracket-color "red")
+    (source-type-color "#00cf00")
+    (index-page-ref #t)
+    (image-format ("jpg"))
+    (font-size 11)
+    (font-type "roman")
+    (user-style #f)
+    (document-style "book")))
+
+;;;; ======================================================================
+;;;;	context-encoding ...
+;;;; ======================================================================
+(define context-encoding
+  '((#\# "\\type{#}")
+    (#\| "\\type{|}")
+    (#\{ "$\\{$")
+    (#\} "$\\}$")
+    (#\~ "\\type{~}")
+    (#\& "\\type{&}")
+    (#\_ "\\type{_}")
+    (#\^ "\\type{^}")
+    (#\[ "\\type{[}")
+    (#\] "\\type{]}")
+    (#\< "\\type{<}")
+    (#\> "\\type{>}")
+    (#\$ "\\type{$}")
+    (#\% "\\%")
+    (#\\ "$\\backslash$")))
+
+;;;; ======================================================================
+;;;;	context-pre-encoding ...
+;;;; ======================================================================
+(define context-pre-encoding
+  (append '((#\space "~")
+	    (#\~ "\\type{~}"))
+	  context-encoding))
+
+
+;;;; ======================================================================
+;;;;	context-symbol-table ...
+;;;; ======================================================================
+(define (context-symbol-table math)
+   `(("iexcl" "!`")
+     ("cent" "c")
+     ("pound" "\\pounds")
+     ("yen" "Y")
+     ("section" "\\S")
+     ("mul" ,(math "^-"))
+     ("copyright" "\\copyright")
+     ("lguillemet" ,(math "\\ll"))
+     ("not" ,(math "\\neg"))
+     ("degree" ,(math "^{\\small{o}}"))
+     ("plusminus" ,(math "\\pm"))
+     ("micro" ,(math "\\mu"))
+     ("paragraph" "\\P")
+     ("middot" ,(math "\\cdot"))
+     ("rguillemet" ,(math "\\gg"))
+     ("1/4" ,(math "\\frac{1}{4}"))
+     ("1/2" ,(math "\\frac{1}{2}"))
+     ("3/4" ,(math "\\frac{3}{4}"))
+     ("iquestion" "?`")
+     ("Agrave" "\\`{A}")
+     ("Aacute" "\\'{A}")
+     ("Acircumflex" "\\^{A}")
+     ("Atilde" "\\~{A}")
+     ("Amul" "\\\"{A}")
+     ("Aring" "{\\AA}")
+     ("AEligature" "{\\AE}")
+     ("Oeligature" "{\\OE}")
+     ("Ccedilla" "{\\c{C}}")
+     ("Egrave" "{\\`{E}}")
+     ("Eacute" "{\\'{E}}")
+     ("Ecircumflex" "{\\^{E}}")
+     ("Euml" "\\\"{E}")
+     ("Igrave" "{\\`{I}}")
+     ("Iacute" "{\\'{I}}")
+     ("Icircumflex" "{\\^{I}}")
+     ("Iuml" "\\\"{I}")
+     ("ETH" "D")
+     ("Ntilde" "\\~{N}")
+     ("Ograve" "\\`{O}")
+     ("Oacute" "\\'{O}")
+     ("Ocurcumflex" "\\^{O}")
+     ("Otilde" "\\~{O}")
+     ("Ouml" "\\\"{O}")
+     ("times" ,(math "\\times"))
+     ("Oslash" "\\O")
+     ("Ugrave" "\\`{U}")
+     ("Uacute" "\\'{U}")
+     ("Ucircumflex" "\\^{U}")
+     ("Uuml" "\\\"{U}")
+     ("Yacute" "\\'{Y}")
+     ("szlig" "\\ss")
+     ("agrave" "\\`{a}")
+     ("aacute" "\\'{a}")
+     ("acircumflex" "\\^{a}")
+     ("atilde" "\\~{a}")
+     ("amul" "\\\"{a}")
+     ("aring" "\\aa")
+     ("aeligature" "\\ae")
+     ("oeligature" "{\\oe}")
+     ("ccedilla" "{\\c{c}}")
+     ("egrave" "{\\`{e}}")
+     ("eacute" "{\\'{e}}")
+     ("ecircumflex" "{\\^{e}}")
+     ("euml" "\\\"{e}")
+     ("igrave" "{\\`{\\i}}")
+     ("iacute" "{\\'{\\i}}")
+     ("icircumflex" "{\\^{\\i}}")
+     ("iuml" "\\\"{\\i}")
+     ("ntilde" "\\~{n}")
+     ("ograve" "\\`{o}")
+     ("oacute" "\\'{o}")
+     ("ocurcumflex" "\\^{o}")
+     ("otilde" "\\~{o}")
+     ("ouml" "\\\"{o}")
+     ("divide" ,(math "\\div"))
+     ("oslash" "\\o")
+     ("ugrave" "\\`{u}")
+     ("uacute" "\\'{u}")
+     ("ucircumflex" "\\^{u}")
+     ("uuml" "\\\"{u}")
+     ("yacute" "\\'{y}")
+     ("ymul" "\\\"{y}")
+     ;; Greek
+     ("Alpha" "A")
+     ("Beta" "B")
+     ("Gamma" ,(math "\\Gamma"))
+     ("Delta" ,(math "\\Delta"))
+     ("Epsilon" "E")
+     ("Zeta" "Z")
+     ("Eta" "H")
+     ("Theta" ,(math "\\Theta"))
+     ("Iota" "I")
+     ("Kappa" "K")
+     ("Lambda" ,(math "\\Lambda"))
+     ("Mu" "M")
+     ("Nu" "N")
+     ("Xi" ,(math "\\Xi"))
+     ("Omicron" "O")
+     ("Pi" ,(math "\\Pi"))
+     ("Rho" "P")
+     ("Sigma" ,(math "\\Sigma"))
+     ("Tau" "T")
+     ("Upsilon" ,(math "\\Upsilon"))
+     ("Phi" ,(math "\\Phi"))
+     ("Chi" "X")
+     ("Psi" ,(math "\\Psi"))
+     ("Omega" ,(math "\\Omega"))
+     ("alpha" ,(math "\\alpha"))
+     ("beta" ,(math "\\beta"))
+     ("gamma" ,(math "\\gamma"))
+     ("delta" ,(math "\\delta"))
+     ("epsilon" ,(math "\\varepsilon"))
+     ("zeta" ,(math "\\zeta"))
+     ("eta" ,(math "\\eta"))
+     ("theta" ,(math "\\theta"))
+     ("iota" ,(math "\\iota"))
+     ("kappa" ,(math "\\kappa"))
+     ("lambda" ,(math "\\lambda"))
+     ("mu" ,(math "\\mu"))
+     ("nu" ,(math "\\nu"))
+     ("xi" ,(math "\\xi"))
+     ("omicron" ,(math "\\o"))
+     ("pi" ,(math "\\pi"))
+     ("rho" ,(math "\\rho"))
+     ("sigmaf" ,(math "\\varsigma"))
+     ("sigma" ,(math "\\sigma"))
+     ("tau" ,(math "\\tau"))
+     ("upsilon" ,(math "\\upsilon"))
+     ("phi" ,(math "\\varphi"))
+     ("chi" ,(math "\\chi"))
+     ("psi" ,(math "\\psi"))
+     ("omega" ,(math "\\omega"))
+     ("thetasym" ,(math "\\vartheta"))
+     ("piv" ,(math "\\varpi"))
+     ;; punctuation
+     ("bullet" ,(math "\\bullet"))
+     ("ellipsis" ,(math "\\ldots"))
+     ("weierp" ,(math "\\wp"))
+     ("image" ,(math "\\Im"))
+     ("real" ,(math "\\Re"))
+     ("tm" ,(math "^{\\sc\\tiny{tm}}"))
+     ("alef" ,(math "\\aleph"))
+     ("<-" ,(math "\\leftarrow"))
+     ("<--" ,(math "\\longleftarrow"))
+     ("uparrow" ,(math "\\uparrow"))
+     ("->" ,(math "\\rightarrow"))
+     ("-->" ,(math "\\longrightarrow"))
+     ("downarrow" ,(math "\\downarrow"))
+     ("<->" ,(math "\\leftrightarrow"))
+     ("<-->" ,(math "\\longleftrightarrow"))
+     ("<+" ,(math "\\hookleftarrow"))
+     ("<=" ,(math "\\Leftarrow"))
+     ("<==" ,(math "\\Longleftarrow"))
+     ("Uparrow" ,(math "\\Uparrow"))
+     ("=>" ,(math "\\Rightarrow"))
+     ("==>" ,(math "\\Longrightarrow"))
+     ("Downarrow" ,(math "\\Downarrow"))
+     ("<=>" ,(math "\\Leftrightarrow"))
+     ("<==>" ,(math "\\Longleftrightarrow"))
+     ;; Mathematical operators
+     ("forall" ,(math "\\forall"))
+     ("partial" ,(math "\\partial"))
+     ("exists" ,(math "\\exists"))
+     ("emptyset" ,(math "\\emptyset"))
+     ("infinity" ,(math "\\infty"))
+     ("nabla" ,(math "\\nabla"))
+     ("in" ,(math "\\in"))
+     ("notin" ,(math "\\notin"))
+     ("ni" ,(math "\\ni"))
+     ("prod" ,(math "\\Pi"))
+     ("sum" ,(math "\\Sigma"))
+     ("asterisk" ,(math "\\ast"))
+     ("sqrt" ,(math "\\surd"))
+     ("propto" ,(math "\\propto"))
+     ("angle" ,(math "\\angle"))
+     ("and" ,(math "\\wedge"))
+     ("or" ,(math "\\vee"))
+     ("cap" ,(math "\\cap"))
+     ("cup" ,(math "\\cup"))
+     ("integral" ,(math "\\int"))
+     ("models" ,(math "\\models"))
+     ("vdash" ,(math "\\vdash"))
+     ("dashv" ,(math "\\dashv"))
+     ("sim" ,(math "\\sim"))
+     ("cong" ,(math "\\cong"))
+     ("approx" ,(math "\\approx"))
+     ("neq" ,(math "\\neq"))
+     ("equiv" ,(math "\\equiv"))
+     ("le" ,(math "\\leq"))
+     ("ge" ,(math "\\geq"))
+     ("subset" ,(math "\\subset"))
+     ("supset" ,(math "\\supset"))
+     ("subseteq" ,(math "\\subseteq"))
+     ("supseteq" ,(math "\\supseteq"))
+     ("oplus" ,(math "\\oplus"))
+     ("otimes" ,(math "\\otimes"))
+     ("perp" ,(math "\\perp"))
+     ("mid" ,(math "\\mid"))
+     ("lceil" ,(math "\\lceil"))
+     ("rceil" ,(math "\\rceil"))
+     ("lfloor" ,(math "\\lfloor"))
+     ("rfloor" ,(math "\\rfloor"))
+     ("langle" ,(math "\\langle"))
+     ("rangle" ,(math "\\rangle"))
+     ;; Misc
+     ("loz" ,(math "\\diamond"))
+     ("spades" ,(math "\\spadesuit"))
+     ("clubs" ,(math "\\clubsuit"))
+     ("hearts" ,(math "\\heartsuit"))
+     ("diams" ,(math "\\diamondsuit"))
+     ("euro" "\\euro{}")
+     ;; ConTeXt
+     ("dag" "\\dag")
+     ("ddag" "\\ddag")
+     ("circ" ,(math "\\circ"))
+     ("top" ,(math "\\top"))
+     ("bottom" ,(math "\\bot"))
+     ("lhd" ,(math "\\triangleleft"))
+     ("rhd" ,(math "\\triangleright"))
+     ("parallel" ,(math "\\parallel"))))
+
+;;;; ======================================================================
+;;;;	context-width
+;;;; ======================================================================
+(define (context-width width)
+  (cond
+    ((string? width)
+     width)
+    ((and (number? width) (inexact? width))
+     (string-append (number->string (/ width 100.)) "\\textwidth"))
+    (else
+     (string-append (number->string width) "pt"))))
+
+;;;; ======================================================================
+;;;;	context-dim
+;;;; ======================================================================
+(define (context-dim dimension)
+  (cond
+    ((string? dimension)
+     dimension)
+    ((number? dimension)
+     (string-append (number->string (inexact->exact (round dimension)))
+		    "pt"))))
+
+;;;; ======================================================================
+;;;;	context-url
+;;;; ======================================================================
+(define(context-url url text e)
+  (let ((name (gensym 'url))
+	(text (or text url)))
+    (printf "\\useURL[~A][~A][][" name url)
+    (output text e)
+    (printf "]\\from[~A]" name)))
+
+;;;; ======================================================================
+;;;;	Color Management ...
+;;;; ======================================================================
+(define *skribe-context-color-table* (make-hashtable))
+
+(define (skribe-color->context-color spec)
+  (receive (r g b)
+     (skribe-color->rgb spec)
+     (let ((ff (exact->inexact #xff)))
+       (format "r=~a,g=~a,b=~a"
+	       (number->string (/ r ff))
+	       (number->string (/ g ff))
+	       (number->string (/ b ff))))))
+
+
+(define (skribe-declare-used-colors)
+  (printf "\n%%Colors\n")
+  (for-each (lambda (spec)
+	      (let ((c (hashtable-get *skribe-context-color-table* spec)))
+		(unless (string? c)
+		  ;; Color was never used before
+		  (let ((name (symbol->string (gensym 'col))))
+		    (hashtable-put! *skribe-context-color-table* spec name)
+		    (printf "\\definecolor[~A][~A]\n"
+			    name
+			    (skribe-color->context-color spec))))))
+	    (skribe-get-used-colors))
+  (newline))
+
+(define (skribe-declare-standard-colors engine)
+  (for-each (lambda (x)
+	      (skribe-use-color! (engine-custom engine x)))
+	    '(source-comment-color source-define-color source-module-color
+	      source-markup-color  source-thread-color source-string-color
+	      source-bracket-color source-type-color)))
+
+(define (skribe-get-color spec)
+  (let ((c (and (hashtable? *skribe-context-color-table*)
+		(hashtable-get *skribe-context-color-table* spec))))
+    (if (not (string? c))
+	(skribe-error 'context "Can't find color" spec)
+	c)))
+
+;;;; ======================================================================
+;;;;	context-engine ...
+;;;; ======================================================================
+(define context-engine
+   (default-engine-set!
+      (make-engine 'context
+	 :version 1.0
+	 :format "context"
+	 :delegate (find-engine 'base)
+	 :filter (make-string-replace context-encoding)
+	 :symbol-table (context-symbol-table (lambda (m) (format #f "$~a$" m)))
+	 :custom context-customs)))
+
+;;;; ======================================================================
+;;;;	document ...
+;;;; ======================================================================
+(markup-writer 'document
+   :options '(:title :subtitle :author :ending :env)
+   :before (lambda (n e)
+	     ;; Prelude
+	     (printf "% interface=en output=pdftex\n")
+	     (display "%%%% -*- TeX -*-\n")
+	     (printf "%%%% File automatically generated by Skribe ~A on ~A\n\n"
+		     (skribe-release) (date))
+	     ;; Make URLs active
+	     (printf "\\setupinteraction[state=start]\n")
+	     ;; Choose the document font
+	     (printf "\\setupbodyfont[~a,~apt]\n" (engine-custom e 'font-type)
+		     (engine-custom e 'font-size))
+	     ;; Color
+	     (display "\\setupcolors[state=start]\n")
+	     ;; Load Style
+	     (printf "\\input skribe-context-~a.tex\n"
+		     (engine-custom e 'document-style))
+	     ;; Insert User customization
+	     (let ((s (engine-custom e 'user-style)))
+	       (when s (printf "\\input ~a\n" s)))
+	     ;; Output used colors
+	     (skribe-declare-standard-colors e)
+	     (skribe-declare-used-colors)
+
+	     (display "\\starttext\n\\StartTitlePage\n")
+	     ;; title
+	     (let ((t (markup-option n :title)))
+	       (when t
+		 (skribe-eval (new markup
+				   (markup '&context-title)
+				   (body t)
+				   (options
+				      `((subtitle ,(markup-option n :subtitle)))))
+			      e
+			      :env `((parent ,n)))))
+	     ;; author(s)
+	     (let ((a (markup-option n :author)))
+	       (when a
+		 (if (list? a)
+		     ;; List of authors. Use multi-columns
+		     (begin
+		       (printf "\\defineparagraphs[Authors][n=~A]\n" (length a))
+		       (display "\\startAuthors\n")
+		       (let Loop ((l a))
+			 (unless (null? l)
+			   (output (car l) e)
+			   (unless (null? (cdr l))
+			     (display "\\nextAuthors\n")
+			     (Loop (cdr l)))))
+		       (display "\\stopAuthors\n\n"))
+		     ;; One author, that's easy
+		     (output a e))))
+	     ;; End of the title
+	     (display "\\StopTitlePage\n"))
+   :after (lambda (n e)
+	     (display "\n\\stoptext\n")))
+
+
+
+;;;; ======================================================================
+;;;;	&context-title ...
+;;;; ======================================================================
+(markup-writer '&context-title
+   :before "{\\DocumentTitle{"
+   :action (lambda (n e)
+	     (output (markup-body n) e)
+	     (let ((sub (markup-option n 'subtitle)))
+	       (when sub
+		 (display "\\\\\n\\switchtobodyfont[16pt]\\it{")
+		 (output sub e)
+		 (display "}\n"))))
+   :after "}}")
+
+;;;; ======================================================================
+;;;;	author ...
+;;;; ======================================================================
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :action (lambda (n e)
+	     (let ((name        (markup-option n :name))
+		   (title       (markup-option n :title))
+		   (affiliation (markup-option n :affiliation))
+		   (email       (markup-option n :email))
+		   (url         (markup-option n :url))
+		   (address     (markup-option n :address))
+		   (phone       (markup-option n :phone))
+		   (out         (lambda (n)
+				  (output n e)
+				  (display "\\\\\n"))))
+	       (display "{\\midaligned{")
+	       (when name	(out name))
+	       (when title	(out title))
+	       (when affiliation	(out affiliation))
+	       (when (pair? address)	(for-each out address))
+	       (when phone		(out phone))
+	       (when email		(out email))
+	       (when url		(out url))
+	       (display "}}\n"))))
+
+
+;;;; ======================================================================
+;;;;	toc ...
+;;;; ======================================================================
+(markup-writer 'toc
+   :options '()
+   :action (lambda (n e) (display "\\placecontent\n")))
+
+;;;; ======================================================================
+;;;;	context-block-before ...
+;;;; ======================================================================
+(define (context-block-before name name-unnum)
+   (lambda (n e)
+      (let ((num (markup-option n :number)))
+	 (printf "\n\n%% ~a\n" (string-canonicalize (markup-ident n)))
+	 (printf "\\~a[~a]{" (if num name name-unnum)
+		 (string-canonicalize (markup-ident n)))
+	 (output (markup-option n :title) e)
+	 (display "}\n"))))
+
+
+;;;; ======================================================================
+;;;;	chapter, section,  ...
+;;;; ======================================================================
+(markup-writer 'chapter
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'chapter 'title))
+
+
+(markup-writer 'section
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'section 'subject))
+
+
+(markup-writer 'subsection
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'subsection 'subsubject))
+
+
+(markup-writer 'subsubsection
+   :options '(:title :number :toc :file :env)
+   :before (context-block-before 'subsubsection 'subsubsubject))
+
+;;;; ======================================================================
+;;;;    paragraph ...
+;;;; ======================================================================
+(markup-writer 'paragraph
+   :options '(:title :number :toc :env)
+   :after "\\par\n")
+
+;;;; ======================================================================
+;;;;	footnote ...
+;;;; ======================================================================
+(markup-writer 'footnote
+   :before "\\footnote{"
+   :after "}")
+
+;;;; ======================================================================
+;;;;	linebreak ...
+;;;; ======================================================================
+(markup-writer 'linebreak
+   :action "\\crlf ")
+
+;;;; ======================================================================
+;;;;	hrule ...
+;;;; ======================================================================
+(markup-writer 'hrule
+   :options '(:width :height)
+   :before (lambda (n e)
+	     (printf "\\blackrule[width=~A,height=~A]\n"
+		     (context-width  (markup-option n :width))
+		     (context-dim    (markup-option n :height)))))
+
+;;;; ======================================================================
+;;;;	color ...
+;;;; ======================================================================
+(markup-writer 'color
+   :options '(:bg :fg :width :margin :border)
+   :before (lambda (n e)
+	     (let ((bg (markup-option n :bg))
+		   (fg (markup-option n :fg))
+		   (w  (markup-option n :width))
+		   (m  (markup-option n :margin))
+		   (b  (markup-option n :border))
+		   (c  (markup-option n :round-corner)))
+	       (if (or bg w m b)
+		   (begin
+		     (printf "\\startframedtext[width=~a" (if w
+							      (context-width w)
+							      "fit"))
+		     (printf ",rulethickness=~A" (if b (context-width b) "0pt"))
+		     (when m
+		       (printf ",offset=~A" (context-width m)))
+		     (when bg
+		       (printf ",background=color,backgroundcolor=~A"
+			       (skribe-get-color bg)))
+		     (when fg
+		       (printf ",foregroundcolor=~A"
+			       (skribe-get-color fg)))
+		     (when c
+		       (display ",framecorner=round"))
+		     (printf "]\n"))
+		   ;; Probably just a foreground was specified
+		   (when fg
+		     (printf "\\startcolor[~A] " (skribe-get-color fg))))))
+   :after (lambda (n e)
+	    (let ((bg (markup-option n :bg))
+		   (fg (markup-option n :fg))
+		   (w  (markup-option n :width))
+		   (m  (markup-option n :margin))
+		   (b  (markup-option n :border)))
+	      (if (or bg w m b)
+		(printf "\\stopframedtext ")
+		(when fg
+		  (printf "\\stopcolor "))))))
+;;;; ======================================================================
+;;;;	frame ...
+;;;; ======================================================================
+(markup-writer 'frame
+   :options '(:width :border :margin)
+   :before (lambda (n e)
+	     (let ((m (markup-option n :margin))
+		   (w (markup-option n :width))
+		   (b (markup-option n :border))
+		   (c (markup-option n :round-corner)))
+	       (printf "\\startframedtext[width=~a" (if w
+							(context-width w)
+							"fit"))
+	       (printf ",rulethickness=~A" (context-dim b))
+	       (printf ",offset=~A" (context-width m))
+	       (when c
+		 (display ",framecorner=round"))
+	       (printf "]\n")))
+   :after "\\stopframedtext ")
+
+;;;; ======================================================================
+;;;;	font ...
+;;;; ======================================================================
+(markup-writer 'font
+   :options '(:size)
+   :action (lambda (n e)
+	     (let* ((size (markup-option n :size))
+		    (cs   (engine-custom e 'font-size))
+		    (ns   (cond
+			    ((and (integer? size) (exact? size))
+			     (if (> size 0)
+				 size
+				 (+ cs size)))
+			    ((and (number? size) (inexact? size))
+			     (+ cs (inexact->exact size)))
+			    ((string? size)
+			     (let ((nb (string->number size)))
+			       (if (not (number? nb))
+				   (skribe-error
+				    'font
+				    (format #f "Illegal font size ~s" size)
+				    nb)
+				   (+ cs nb))))))
+		     (ne (make-engine (gensym 'context)
+				      :delegate e
+				      :filter (engine-filter e)
+				      :symbol-table (engine-symbol-table e)
+				      :custom `((font-size ,ns)
+						,@(engine-customs e)))))
+	       (printf "{\\switchtobodyfont[~apt]" ns)
+	       (output (markup-body n) ne)
+	       (display "}"))))
+
+
+;;;; ======================================================================
+;;;;    flush ...
+;;;; ======================================================================
+(markup-writer 'flush
+   :options '(:side)
+   :before (lambda (n e)
+	     (case (markup-option n :side)
+		 ((center)
+		  (display "\n\n\\midaligned{"))
+		 ((left)
+		  (display "\n\n\\leftaligned{"))
+		 ((right)
+		  (display "\n\n\\rightaligned{"))))
+   :after "}\n")
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+   :before "\n\n\\midaligned{"
+   :after "}\n")
+
+;;;; ======================================================================
+;;;;   pre ...
+;;;; ======================================================================
+(markup-writer 'pre
+   :before "{\\tt\n\\startlines\n\\fixedspaces\n"
+   :action (lambda (n e)
+	     (let ((ne (make-engine
+			  (gensym 'context)
+			  :delegate e
+			  :filter (make-string-replace context-pre-encoding)
+			  :symbol-table (engine-symbol-table e)
+			  :custom (engine-customs e))))
+	       (output (markup-body n) ne)))
+   :after  "\n\\stoplines\n}")
+
+;;;; ======================================================================
+;;;;	prog ...
+;;;; ======================================================================
+(markup-writer 'prog
+   :options '(:line :mark)
+   :before "{\\tt\n\\startlines\n\\fixedspaces\n"
+   :action (lambda (n e)
+	     (let ((ne (make-engine
+			  (gensym 'context)
+			  :delegate e
+			  :filter (make-string-replace context-pre-encoding)
+			  :symbol-table (engine-symbol-table e)
+			  :custom (engine-customs e))))
+	       (output (markup-body n) ne)))
+   :after  "\n\\stoplines\n}")
+
+
+;;;; ======================================================================
+;;;;    itemize, enumerate ...
+;;;; ======================================================================
+(define (context-itemization-action n e descr?)
+  (let ((symbol (markup-option n :symbol)))
+    (for-each (lambda (item)
+		(if symbol
+		    (begin
+		      (display "\\sym{")
+		      (output symbol e)
+		      (display "}"))
+		    ;; output a \item iff not a description
+		    (unless descr?
+		      (display "  \\item ")))
+		(output item e)
+		(newline))
+	      (markup-body n))))
+
+(markup-writer 'itemize
+   :options '(:symbol)
+   :before "\\startnarrower[left]\n\\startitemize[serried]\n"
+   :action (lambda (n e) (context-itemization-action n e #f))
+   :after "\\stopitemize\n\\stopnarrower\n")
+
+
+(markup-writer 'enumerate
+   :options '(:symbol)
+   :before "\\startnarrower[left]\n\\startitemize[n][standard]\n"
+   :action (lambda (n e) (context-itemization-action n e #f))
+   :after "\\stopitemize\n\\stopnarrower\n")
+
+;;;; ======================================================================
+;;;;    description ...
+;;;; ======================================================================
+(markup-writer 'description
+   :options '(:symbol)
+   :before "\\startnarrower[left]\n\\startitemize[serried]\n"
+   :action (lambda (n e) (context-itemization-action n e #t))
+   :after "\\stopitemize\n\\stopnarrower\n")
+
+;;;; ======================================================================
+;;;;    item ...
+;;;; ======================================================================
+(markup-writer 'item
+   :options '(:key)
+   :action (lambda (n e)
+	     (let ((k (markup-option n :key)))
+	       (when k
+		 ;; Output the key(s)
+		 (let Loop ((l (if (pair? k) k (list k))))
+		   (unless (null? l)
+		     (output (bold (car l)) e)
+		     (unless (null? (cdr l))
+		       (display "\\crlf\n"))
+		     (Loop (cdr l))))
+		 (display "\\nowhitespace\\startnarrower[left]\n"))
+	       ;; Output body
+	       (output (markup-body n) e)
+	       ;; Terminate
+	       (when k
+		 (display "\n\\stopnarrower\n")))))
+
+;;;; ======================================================================
+;;;;	blockquote ...
+;;;; ======================================================================
+(markup-writer 'blockquote
+   :before "\n\\startnarrower[left,right]\n"
+   :after  "\n\\stopnarrower\n")
+
+
+;;;; ======================================================================
+;;;;	figure ...
+;;;; ======================================================================
+(markup-writer 'figure
+   :options '(:legend :number :multicolumns)
+   :action (lambda (n e)
+	     (let ((ident (markup-ident n))
+		   (number (markup-option n :number))
+		   (legend (markup-option n :legend)))
+	       (unless number
+		 (display "{\\setupcaptions[number=off]\n"))
+	       (display "\\placefigure\n")
+	       (printf "  [~a]\n" (string-canonicalize ident))
+	       (display "  {") (output legend e) (display "}\n")
+	       (display "  {") (output (markup-body n) e) (display "}")
+	       (unless number
+		 (display "}\n")))))
+
+;;;; ======================================================================
+;;;;    table ...
+;;;; ======================================================================
+						;; width doesn't work
+(markup-writer 'table
+   :options '(:width :border :frame :rules :cellpadding)
+   :before (lambda (n e)
+	     (let ((width  (markup-option n :width))
+		   (border (markup-option n :border))
+		   (frame  (markup-option n :frame))
+		   (rules  (markup-option n :rules))
+		   (cstyle (markup-option n :cellstyle))
+		   (cp     (markup-option n :cellpadding))
+		   (cs     (markup-option n :cellspacing)))
+	       (printf "\n{\\bTABLE\n")
+	       (printf "\\setupTABLE[")
+	       (printf "width=~A" (if width (context-width width) "fit"))
+	       (when border
+		 (printf ",rulethickness=~A" (context-dim border)))
+	       (when cp
+		 (printf ",offset=~A" (context-width cp)))
+	       (printf ",frame=off]\n")
+
+	       (when rules
+		 (let ((hor  "\\setupTABLE[row][bottomframe=on,topframe=on]\n")
+		       (vert "\\setupTABLE[c][leftframe=on,rightframe=on]\n"))
+		   (case rules
+		     ((rows) (display hor))
+		     ((cols) (display vert))
+		     ((all)  (display hor) (display vert)))))
+
+	       (when frame
+		 ;;  hsides, vsides, lhs, rhs, box, border
+		 (let ((top   "\\setupTABLE[row][first][frame=off,topframe=on]\n")
+		       (bot   "\\setupTABLE[row][last][frame=off,bottomframe=on]\n")
+		       (left  "\\setupTABLE[c][first][frame=off,leftframe=on]\n")
+		       (right "\\setupTABLE[c][last][frame=off,rightframe=on]\n"))
+		 (case frame
+		   ((above)      (display top))
+		   ((below)      (display bot))
+		   ((hsides)     (display top) (display bot))
+		   ((lhs)        (display left))
+		   ((rhs)        (display right))
+		   ((vsides)     (display left) (diplay right))
+		   ((box border) (display top)  (display bot)
+				 (display left) (display right)))))))
+
+   :after  (lambda (n e)
+	     (printf "\\eTABLE}\n")))
+
+
+;;;; ======================================================================
+;;;;    tr ...
+;;;; ======================================================================
+(markup-writer 'tr
+   :options '(:bg)
+   :before (lambda (n e)
+	     (display "\\bTR")
+	     (let ((bg (markup-option n :bg)))
+	       (when bg
+		 (printf "[background=color,backgroundcolor=~A]"
+			 (skribe-get-color bg)))))
+   :after  "\\eTR\n")
+
+
+;;;; ======================================================================
+;;;;    tc ...
+;;;; ======================================================================
+(markup-writer 'tc
+   :options '(:width :align :valign :colspan)
+   :before (lambda (n e)
+	     (let ((th?     (eq? 'th (markup-option n 'markup)))
+		   (width   (markup-option n :width))
+		   (align   (markup-option n :align))
+		   (valign  (markup-option n :valign))
+		   (colspan (markup-option n :colspan))
+		   (rowspan (markup-option n :rowspan))
+		   (bg      (markup-option n :bg)))
+	       (printf "\\bTD[")
+	       (printf "width=~a" (if width (context-width width) "fit"))
+	       (when valign
+		 ;; This is buggy. In fact valign an align can't be both
+		 ;; specified in ConTeXt
+		 (printf ",align=~a" (case valign
+				       ((center) 'lohi)
+				       ((bottom) 'low)
+				       ((top)    'high))))
+	       (when align
+		 (printf ",align=~a" (case align
+				       ((left) 'right) ; !!!!
+				       ((right) 'left) ; !!!!
+				       (else    'middle))))
+	       (unless (equal? colspan 1)
+		 (printf ",nx=~a" colspan))
+	       (display "]")
+	       (when th?
+		 ;; This is a TH, output is bolded
+		 (display "{\\bf{"))))
+
+   :after (lambda (n e)
+	     (when (equal? (markup-option n 'markup) 'th)
+	       ;; This is a TH, output is bolded
+	       (display "}}"))
+	     (display "\\eTD")))
+
+;;;; ======================================================================
+;;;;	image ...
+;;;; ======================================================================
+(markup-writer 'image
+   :options '(:file :url :width :height :zoom)
+   :action (lambda (n e)
+	     (let* ((file   (markup-option n :file))
+		    (url    (markup-option n :url))
+		    (width  (markup-option n :width))
+		    (height (markup-option n :height))
+		    (zoom   (markup-option n :zoom))
+		    (body   (markup-body n))
+		    (efmt   (engine-custom e 'image-format))
+		    (img    (or url (convert-image file
+						   (if (list? efmt)
+						       efmt
+						       '("jpg"))))))
+	       (if (not (string? img))
+		   (skribe-error 'context "Illegal image" file)
+		   (begin
+		     (printf "\\externalfigure[~A][frame=off" (strip-ref-base img))
+		     (if zoom   (printf ",factor=~a"   (inexact->exact zoom)))
+		     (if width  (printf ",width=~a"    (context-width width)))
+		     (if height (printf ",height=~apt" (context-dim height)))
+		     (display "]"))))))
+
+
+;;;; ======================================================================
+;;;;   Ornaments ...
+;;;; ======================================================================
+(markup-writer 'roman :before "{\\rm{" :after "}}")
+(markup-writer 'bold :before "{\\bf{" :after "}}")
+(markup-writer 'underline :before  "{\\underbar{" :after "}}")
+(markup-writer 'emph :before "{\\em{" :after "}}")
+(markup-writer 'it :before "{\\it{" :after "}}")
+(markup-writer 'code :before "{\\tt{" :after "}}")
+(markup-writer 'var :before "{\\tt{" :after "}}")
+(markup-writer 'sc :before "{\\sc{" :after "}}")
+;;//(markup-writer 'sf :before "{\\sf{" :after "}}")
+(markup-writer 'sub :before "{\\low{" :after "}}")
+(markup-writer 'sup :before "{\\high{" :after "}}")
+
+
+;;//
+;;//(markup-writer 'tt
+;;//   :before "{\\texttt{"
+;;//   :action (lambda (n e)
+;;//	      (let ((ne (make-engine
+;;//			   (gensym 'latex)
+;;//			   :delegate e
+;;//			   :filter (make-string-replace latex-tt-encoding)
+;;//			   :custom (engine-customs e)
+;;//			   :symbol-table (engine-symbol-table e))))
+;;//		 (output (markup-body n) ne)))
+;;//   :after "}}")
+
+;;;; ======================================================================
+;;;;    q ...
+;;;; ======================================================================
+(markup-writer 'q
+   :before "\\quotation{"
+   :after "}")
+
+;;;; ======================================================================
+;;;;    mailto ...
+;;;; ======================================================================
+(markup-writer 'mailto
+   :options '(:text)
+   :action (lambda (n e)
+	     (let ((text (markup-option n :text))
+		   (url  (markup-body n)))
+	       (when (pair? url)
+		 (context-url (format #f "mailto:~A" (car url))
+			      (or text
+				  (car url))
+			      e)))))
+;;;; ======================================================================
+;;;;   mark ...
+;;;; ======================================================================
+(markup-writer 'mark
+   :before (lambda (n e)
+	      (printf "\\reference[~a]{}\n"
+		      (string-canonicalize (markup-ident n)))))
+
+;;;; ======================================================================
+;;;;   ref ...
+;;;; ======================================================================
+(markup-writer 'ref
+   :options '(:text :chapter :section :subsection :subsubsection
+	      :figure :mark :handle :page)
+   :action (lambda (n e)
+	      (let* ((text (markup-option n :text))
+		     (page (markup-option n :page))
+		     (c    (handle-ast (markup-body n)))
+		     (id   (markup-ident c)))
+		(cond
+		  (page ;; Output the page only (this is a hack)
+		     (when text (output text e))
+		     (printf "\\at[~a]"
+			     (string-canonicalize id)))
+		  ((or (markup-option n :chapter)
+		       (markup-option n :section)
+		       (markup-option n :subsection)
+		       (markup-option n :subsubsection))
+		   (if text
+		       (printf "\\goto{~a}[~a]" (or text id)
+			       (string-canonicalize id))
+		       (printf "\\in[~a]" (string-canonicalize id))))
+		  ((markup-option n :mark)
+		     (printf "\\goto{~a}[~a]"
+			     (or text id)
+			     (string-canonicalize id)))
+		  (else ;; Output a little image indicating the direction
+		      (printf "\\in[~a]" (string-canonicalize id)))))))
+
+;;;; ======================================================================
+;;;;   bib-ref ...
+;;;; ======================================================================
+(markup-writer 'bib-ref
+   :options '(:text :bib)
+   :before (lambda (n e) (output "[" e))
+   :action (lambda (n e)
+	     (let* ((obj   (handle-ast (markup-body n)))
+		    (title (markup-option obj :title))
+		    (ref   (markup-option title 'number))
+		    (ident (markup-ident obj)))
+	       (printf "\\goto{~a}[~a]" ref (string-canonicalize ident))))
+   :after (lambda (n e) (output "]" e)))
+
+;;;; ======================================================================
+;;;;   bib-ref+ ...
+;;;; ======================================================================
+(markup-writer 'bib-ref+
+   :options '(:text :bib)
+   :before (lambda (n e) (output "[" e))
+   :action (lambda (n e)
+	      (let loop ((rs (markup-body n)))
+		 (cond
+		    ((null? rs)
+		     #f)
+		    (else
+		     (if (is-markup? (car rs) 'bib-ref)
+			 (invoke (writer-action (markup-writer-get 'bib-ref e))
+				 (car rs)
+				 e)
+			 (output (car rs) e))
+		     (if (pair? (cdr rs))
+			 (begin
+			    (display ",")
+			    (loop (cdr rs))))))))
+   :after (lambda (n e) (output "]" e)))
+
+;;;; ======================================================================
+;;;;	url-ref ...
+;;;; ======================================================================
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :action (lambda (n e)
+	     (context-url (markup-option n :url) (markup-option n :text) e)))
+
+;;//;*---------------------------------------------------------------------*/
+;;//;*    line-ref ...                                                     */
+;;//;*---------------------------------------------------------------------*/
+;;//(markup-writer 'line-ref
+;;//   :options '(:offset)
+;;//   :before "{\\textit{"
+;;//   :action (lambda (n e)
+;;//	      (let ((o (markup-option n :offset))
+;;//		    (v (string->number (markup-option n :text))))
+;;//		 (cond
+;;//		    ((and (number? o) (number? v))
+;;//		     (display (+ o v)))
+;;//		    (else
+;;//		     (display v)))))
+;;//   :after "}}")
+
+
+;;;; ======================================================================
+;;;;	&the-bibliography ...
+;;;; ======================================================================
+(markup-writer '&the-bibliography
+   :before "\n% Bibliography\n\n")
+
+
+;;;; ======================================================================
+;;;;	&bib-entry ...
+;;;; ======================================================================
+(markup-writer '&bib-entry
+   :options '(:title)
+   :action (lambda (n e)
+	     (skribe-eval (mark (markup-ident n)) e)
+	     (output n e (markup-writer-get '&bib-entry-label e))
+	     (output n e (markup-writer-get '&bib-entry-body e)))
+   :after "\n\n")
+
+;;;; ======================================================================
+;;;;	&bib-entry-label ...
+;;;; ======================================================================
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before (lambda (n e) (output "[" e))
+   :action (lambda (n e) (output (markup-option n :title) e))
+   :after  (lambda (n e) (output "] "e)))
+
+;;;; ======================================================================
+;;;;	&bib-entry-title ...
+;;;; ======================================================================
+(markup-writer '&bib-entry-title
+   :action (lambda (n e)
+	     (let* ((t  (bold (markup-body n)))
+		    (en (handle-ast (ast-parent n)))
+		    (url #f ) ;;;;;;;;;;;;;;;// (markup-option en 'url))
+		    (ht (if url (ref :url (markup-body url) :text t) t)))
+	       (skribe-eval ht e))))
+
+
+;;//;*---------------------------------------------------------------------*/
+;;//;*    &bib-entry-url ...                                               */
+;;//;*---------------------------------------------------------------------*/
+;;//(markup-writer '&bib-entry-url
+;;//   :action (lambda (n e)
+;;//	      (let* ((en (handle-ast (ast-parent n)))
+;;//		     (url (markup-option en 'url))
+;;//		     (t (bold (markup-body url))))
+;;//		 (skribe-eval (ref :url (markup-body url) :text t) e))))
+
+
+;;;; ======================================================================
+;;;;	&the-index ...
+;;;; ======================================================================
+(markup-writer '&the-index
+   :options '(:column)
+   :action
+   (lambda (n e)
+     (define (make-mark-entry n)
+       (display "\\blank[medium]\n{\\bf\\it\\tfc{")
+       (skribe-eval (bold n) e)
+       (display "}}\\crlf\n"))
+
+     (define (make-primary-entry n)
+       (let ((b (markup-body n)))
+	 (markup-option-add! b :text (list (markup-option b :text) ", "))
+	 (markup-option-add! b :page #t)
+	 (output n e)))
+
+     (define (make-secondary-entry n)
+       (let* ((note (markup-option n :note))
+	      (b    (markup-body n))
+	      (bb   (markup-body b)))
+	 (if note
+	     (begin   ;; This is another entry
+	       (display "\\crlf\n ... ")
+	       (markup-option-add! b :text (list note ", ")))
+	     (begin   ;; another line on an entry
+	       (markup-option-add! b :text ", ")))
+	 (markup-option-add! b :page #t)
+	 (output n e)))
+
+     ;; Writer body starts here
+     (let ((col  (markup-option n :column)))
+       (when col
+	 (printf "\\startcolumns[n=~a]\n" col))
+       (for-each (lambda (item)
+		   ;;(DEBUG "ITEM= ~S" item)
+		   (if (pair? item)
+		       (begin
+			 (make-primary-entry (car item))
+			 (for-each (lambda (x) (make-secondary-entry x))
+				   (cdr item)))
+		       (make-mark-entry item))
+		   (display "\\crlf\n"))
+		 (markup-body n))
+       (when col
+	 (printf "\\stopcolumns\n")))))
+
+;;;; ======================================================================
+;;;;    &source-comment ...
+;;;; ======================================================================
+(markup-writer '&source-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (it (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-line-comment ...
+;;;; ======================================================================
+(markup-writer '&source-line-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-keyword ...
+;;;; ======================================================================
+(markup-writer '&source-keyword
+   :action (lambda (n e)
+	      (skribe-eval (it (markup-body n)) e)))
+
+;;;; ======================================================================
+;;;;    &source-error ...
+;;;; ======================================================================
+(markup-writer '&source-error
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-error-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'error-color) cc)
+			     (color :fg cc (it n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-define ...
+;;;; ======================================================================
+(markup-writer '&source-define
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-define-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-module ...
+;;;; ======================================================================
+(markup-writer '&source-module
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-module-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-markup ...
+;;;; ======================================================================
+(markup-writer '&source-markup
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-markup-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-thread ...
+;;;; ======================================================================
+(markup-writer '&source-thread
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-thread-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-string ...
+;;;; ======================================================================
+(markup-writer '&source-string
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-string-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-bracket ...
+;;;; ======================================================================
+(markup-writer '&source-bracket
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-bracket-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-type ...
+;;;; ======================================================================
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-key ...
+;;;; ======================================================================
+(markup-writer '&source-key
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;;    &source-type ...
+;;;; ======================================================================
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg "red" (bold n1))
+			     (bold n1))))
+		 (skribe-eval n2 e))))
+
+
+
+;;;; ======================================================================
+;;;;	Context Only Markups
+;;;; ======================================================================
+
+;;;
+;;; Margin -- put text in the margin
+;;;
+(define-markup (margin #!rest opts #!key (ident #f) (class "margin")
+			(side 'right) text)
+  (new markup
+       (markup 'margin)
+       (ident (or ident (symbol->string (gensym 'ident))))
+       (class class)
+       (required-options '(:text))
+       (options (the-options opts :ident :class))
+       (body (the-body opts))))
+
+(markup-writer 'margin
+   :options '(:text)
+   :before (lambda (n e)
+	     (display
+	      "\\setupinmargin[align=right,style=\\tfx\\setupinterlinespace]\n")
+	     (display "\\inright{")
+	     (output (markup-option n :text) e)
+	     (display "}{"))
+   :after  "}")
+
+;;;
+;;; ConTeXt and TeX
+;;;
+(define-markup (ConTeXt #!key (space #t))
+  (if (engine-format? "context")
+      (! (if space "\\CONTEXT\\ " "\\CONTEXT"))
+      "ConTeXt"))
+
+(define-markup (TeX #!key (space #t))
+  (if (engine-format? "context")
+      (! (if space "\\TEX\\ " "\\TEX"))
+      "ConTeXt"))
+
+;;;; ======================================================================
+;;;;    Restore the base engine
+;;;; ======================================================================
+(default-engine-set! (find-engine 'base))
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
new file mode 100644
index 0000000..6232b96
--- /dev/null
+++ b/src/guile/skribilo/engine/html.scm
@@ -0,0 +1,2313 @@
+;;; html.scm  --  HTML engine.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo engine html)
+  :autoload   (skribilo parameters) (*destination-file*)
+  :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)))
+
+
+;; Keep a reference to the base engine.
+(define base-engine (find-engine 'base))
+
+(if (not (engine? base-engine))
+    (error "bootstrap problem: base engine broken" base-engine))
+
+;*---------------------------------------------------------------------*/
+;*    html-file-default ...                                            */
+;*---------------------------------------------------------------------*/
+(define html-file-default
+   ;; Default implementation of the `file-name-proc' custom.
+   (let ((table '())
+	 (filename (tmpnam)))
+      (define (get-file-name base suf)
+	(let* ((c (assoc base table))
+	       (n (if (pair? c)
+		      (let ((n (+ 1 (cdr c))))
+			 (set-cdr! c n)
+			 n)
+		      (begin
+			 (set! table (cons (cons base 1) table))
+			 1))))
+	   (format #f "~a-~a.~a" base n suf)))
+      (lambda (node e)
+	(let ((f (markup-option node filename))
+	      (file (markup-option node :file)))
+	   (cond
+	      ((string? f)
+	       f)
+	      ((string? file)
+	       file)
+	      ((or file
+		   (and (is-markup? node 'chapter)
+			(engine-custom e 'chapter-file))
+		   (and (is-markup? node 'section)
+			(engine-custom e 'section-file))
+		   (and (is-markup? node 'subsection)
+			(engine-custom e 'subsection-file))
+		   (and (is-markup? node 'subsubsection)
+			(engine-custom e 'subsubsection-file)))
+	       (let* ((b (or (and (string? (*destination-file*))
+				  (prefix (*destination-file*)))
+			     ""))
+		      (s (or (and (string? (*destination-file*))
+				  (suffix (*destination-file*)))
+			     "html"))
+		      (nm (get-file-name b s)))
+		  (markup-option-add! node filename nm)
+		  nm))
+	      ((document? node)
+	       (*destination-file*))
+	      (else
+	       (let ((p (ast-parent node)))
+		  (if (container? p)
+		      (let ((file (html-file p e)))
+			 (if (string? file)
+			     (begin
+				(markup-option-add! node filename file)
+				file)
+			     #f))
+		      #f))))))))
+
+;*---------------------------------------------------------------------*/
+;*    html-engine ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-public html-engine
+   ;; setup the html engine
+   (default-engine-set!
+      (make-engine 'html
+	 :version 1.0
+	 :format "html"
+	 :delegate (find-engine 'base)
+	 :filter (make-string-replace '((#\< "&lt;")
+					(#\> "&gt;")
+					(#\& "&amp;")
+					(#\" "&quot;")
+					(#\@ "&#x40;")))
+	 :custom `(;; the icon associated with the URL
+		   (favicon #f)
+		   ;; charset used
+		   (charset "ISO-8859-1")
+		   ;; enable/disable Javascript
+		   (javascript #f)
+		   ;; user html head
+		   (head #f)
+		   ;; user CSS
+		   (css ())
+		   ;; user inlined CSS
+		   (inline-css ())
+		   ;; user JS
+		   (js ())
+		   ;; emit-sui
+		   (emit-sui #f)
+		   ;; the body
+		   (background #f)
+		   (foreground #f)
+		   ;; the margins
+		   (margin-padding 3)
+		   (left-margin #f)
+		   (chapter-left-margin #f)
+		   (section-left-margin #f)
+		   (left-margin-font #f)
+		   (left-margin-size 17.)
+		   (left-margin-background #f)
+		   (left-margin-foreground #f)
+		   (right-margin #f)
+		   (chapter-right-margin #f)
+		   (section-right-margin #f)
+		   (right-margin-font #f)
+		   (right-margin-size 17.)
+		   (right-margin-background #f)
+		   (right-margin-foreground #f)
+		   ;; author configuration
+		   (author-font #f)
+		   ;; title configuration
+		   (title-font #f)
+		   (title-background #f)
+		   (title-foreground #f)
+		   (file-title-separator " -- ")
+		   ;; html file naming
+		   (file-name-proc ,html-file-default)
+		   ;; index configuration
+		   (index-header-font-size #f) ;; +2.
+		   ;; chapter configuration
+		   (chapter-number->string number->string)
+		   (chapter-file #f)
+		   ;; section configuration
+		   (section-title-start "<h3>")
+		   (section-title-stop "</h3>")
+		   (section-title-background #f)
+		   (section-title-foreground #f)
+		   (section-title-number-separator " ")
+		   (section-number->string number->string)
+		   (section-file #f)
+		   ;; subsection configuration
+		   (subsection-title-start "<h3>")
+		   (subsection-title-stop "</h3>")
+		   (subsection-title-background #f)
+		   (subsection-title-foreground #f)
+		   (subsection-title-number-separator " ")
+		   (subsection-number->string number->string)
+		   (subsection-file #f)
+		   ;; subsubsection configuration
+		   (subsubsection-title-start "<h4>")
+		   (subsubsection-title-stop "</h4>")
+		   (subsubsection-title-background #f)
+		   (subsubsection-title-foreground #f)
+		   (subsubsection-title-number-separator " ")
+		   (subsubsection-number->string number->string)
+		   (subsubsection-file #f)
+		   ;; source fontification
+		   (source-color #t)
+		   (source-comment-color "#ffa600")
+		   (source-error-color "red")
+		   (source-define-color "#6959cf")
+		   (source-module-color "#1919af")
+		   (source-markup-color "#1919af")
+		   (source-thread-color "#ad4386")
+		   (source-string-color "red")
+		   (source-bracket-color "red")
+		   (source-type-color "#00cf00")
+		   ;; image
+		   (image-format ("png" "gif" "jpg" "jpeg")))
+	 :symbol-table '(("iexcl" "&#161;")
+			 ("cent" "&#162;")
+			 ("pound" "&#163;")
+			 ("currency" "&#164;")
+			 ("yen" "&#165;")
+			 ("section" "&#167;")
+			 ("mul" "&#168;")
+			 ("copyright" "&#169;")
+			 ("female" "&#170;")
+			 ("lguillemet" "&#171;")
+			 ("not" "&#172;")
+			 ("registered" "&#174;")
+			 ("degree" "&#176;")
+			 ("plusminus" "&#177;")
+			 ("micro" "&#181;")
+			 ("paragraph" "&#182;")
+			 ("middot" "&#183;")
+			 ("male" "&#184;")
+			 ("rguillemet" "&#187;")
+			 ("1/4" "&#188;")
+			 ("1/2" "&#189;")
+			 ("3/4" "&#190;")
+			 ("iquestion" "&#191;")
+			 ("Agrave" "&#192;")
+			 ("Aacute" "&#193;")
+			 ("Acircumflex" "&#194;")
+			 ("Atilde" "&#195;")
+			 ("Amul" "&#196;")
+			 ("Aring" "&#197;")
+			 ("AEligature" "&#198;")
+			 ("Oeligature" "&#338;")
+			 ("Ccedilla" "&#199;")
+			 ("Egrave" "&#200;")
+			 ("Eacute" "&#201;")
+			 ("Ecircumflex" "&#202;")
+			 ("Euml" "&#203;")
+			 ("Igrave" "&#204;")
+			 ("Iacute" "&#205;")
+			 ("Icircumflex" "&#206;")
+			 ("Iuml" "&#207;")
+			 ("ETH" "&#208;")
+			 ("Ntilde" "&#209;")
+			 ("Ograve" "&#210;")
+			 ("Oacute" "&#211;")
+			 ("Ocurcumflex" "&#212;")
+			 ("Otilde" "&#213;")
+			 ("Ouml" "&#214;")
+			 ("times" "&#215;")
+			 ("Oslash" "&#216;")
+			 ("Ugrave" "&#217;")
+			 ("Uacute" "&#218;")
+			 ("Ucircumflex" "&#219;")
+			 ("Uuml" "&#220;")
+			 ("Yacute" "&#221;")
+			 ("THORN" "&#222;")
+			 ("szlig" "&#223;")
+			 ("agrave" "&#224;")
+			 ("aacute" "&#225;")
+			 ("acircumflex" "&#226;")
+			 ("atilde" "&#227;")
+			 ("amul" "&#228;")
+			 ("aring" "&#229;")
+			 ("aeligature" "&#230;")
+			 ("oeligature" "&#339;")
+			 ("ccedilla" "&#231;")
+			 ("egrave" "&#232;")
+			 ("eacute" "&#233;")
+			 ("ecircumflex" "&#234;")
+			 ("euml" "&#235;")
+			 ("igrave" "&#236;")
+			 ("iacute" "&#237;")
+			 ("icircumflex" "&#238;")
+			 ("iuml" "&#239;")
+			 ("eth" "&#240;")
+			 ("ntilde" "&#241;")
+			 ("ograve" "&#242;")
+			 ("oacute" "&#243;")
+			 ("ocurcumflex" "&#244;")
+			 ("otilde" "&#245;")
+			 ("ouml" "&#246;")
+			 ("divide" "&#247;")
+			 ("oslash" "&#248;")
+			 ("ugrave" "&#249;")
+			 ("uacute" "&#250;")
+			 ("ucircumflex" "&#251;")
+			 ("uuml" "&#252;")
+			 ("yacute" "&#253;")
+			 ("thorn" "&#254;")
+			 ("ymul" "&#255;")
+			 ;; Greek
+			 ("Alpha" "&#913;")
+			 ("Beta" "&#914;")
+			 ("Gamma" "&#915;")
+			 ("Delta" "&#916;")
+			 ("Epsilon" "&#917;")
+			 ("Zeta" "&#918;")
+			 ("Eta" "&#919;")
+			 ("Theta" "&#920;")
+			 ("Iota" "&#921;")
+			 ("Kappa" "&#922;")
+			 ("Lambda" "&#923;")
+			 ("Mu" "&#924;")
+			 ("Nu" "&#925;")
+			 ("Xi" "&#926;")
+			 ("Omicron" "&#927;")
+			 ("Pi" "&#928;")
+			 ("Rho" "&#929;")
+			 ("Sigma" "&#931;")
+			 ("Tau" "&#932;")
+			 ("Upsilon" "&#933;")
+			 ("Phi" "&#934;")
+			 ("Chi" "&#935;")
+			 ("Psi" "&#936;")
+			 ("Omega" "&#937;")
+			 ("alpha" "&#945;")
+			 ("beta" "&#946;")
+			 ("gamma" "&#947;")
+			 ("delta" "&#948;")
+			 ("epsilon" "&#949;")
+			 ("zeta" "&#950;")
+			 ("eta" "&#951;")
+			 ("theta" "&#952;")
+			 ("iota" "&#953;")
+			 ("kappa" "&#954;")
+			 ("lambda" "&#955;")
+			 ("mu" "&#956;")
+			 ("nu" "&#957;")
+			 ("xi" "&#958;")
+			 ("omicron" "&#959;")
+			 ("pi" "&#960;")
+			 ("rho" "&#961;")
+			 ("sigmaf" "&#962;")
+			 ("sigma" "&#963;")
+			 ("tau" "&#964;")
+			 ("upsilon" "&#965;")
+			 ("phi" "&#966;")
+			 ("chi" "&#967;")
+			 ("psi" "&#968;")
+			 ("omega" "&#969;")
+			 ("thetasym" "&#977;")
+			 ("piv" "&#982;")
+			 ;; punctuation
+			 ("bullet" "&#8226;")
+			 ("ellipsis" "&#8230;")
+			 ("weierp" "&#8472;")
+			 ("image" "&#8465;")
+			 ("real" "&#8476;")
+			 ("tm" "&#8482;")
+			 ("alef" "&#8501;")
+			 ("<-" "&#8592;")
+			 ("<--" "&#8592;")
+			 ("uparrow" "&#8593;")
+			 ("->" "&#8594;")
+			 ("-->" "&#8594;")
+			 ("downarrow" "&#8595;")
+			 ("<->" "&#8596;")
+			 ("<-->" "&#8596;")
+			 ("<+" "&#8629;")
+			 ("<=" "&#8656;")
+			 ("<==" "&#8656;")
+			 ("Uparrow" "&#8657;")
+			 ("=>" "&#8658;")
+			 ("==>" "&#8658;")
+			 ("Downarrow" "&#8659;")
+			 ("<=>" "&#8660;")
+			 ("<==>" "&#8660;")
+			 ;; Mathematical operators
+			 ("forall" "&#8704;")
+			 ("partial" "&#8706;")
+			 ("exists" "&#8707;")
+			 ("emptyset" "&#8709;")
+			 ("infinity" "&#8734;")
+			 ("nabla" "&#8711;")
+			 ("in" "&#8712;")
+			 ("notin" "&#8713;")
+			 ("ni" "&#8715;")
+			 ("prod" "&#8719;")
+			 ("sum" "&#8721;")
+			 ("asterisk" "&#8727;")
+			 ("sqrt" "&#8730;")
+			 ("propto" "&#8733;")
+			 ("angle" "&#8736;")
+			 ("and" "&#8743;")
+			 ("or" "&#8744;")
+			 ("cap" "&#8745;")
+			 ("cup" "&#8746;")
+			 ("integral" "&#8747;")
+			 ("therefore" "&#8756;")
+			 ("models" "|=")
+			 ("vdash" "|-")
+			 ("dashv" "-|")
+			 ("sim" "&#8764;")
+			 ("cong" "&#8773;")
+			 ("approx" "&#8776;")
+			 ("neq" "&#8800;")
+			 ("equiv" "&#8801;")
+			 ("le" "&#8804;")
+			 ("ge" "&#8805;")
+			 ("subset" "&#8834;")
+			 ("supset" "&#8835;")
+			 ("nsupset" "&#8835;")
+			 ("subseteq" "&#8838;")
+			 ("supseteq" "&#8839;")
+			 ("oplus" "&#8853;")
+			 ("otimes" "&#8855;")
+			 ("perp" "&#8869;")
+			 ("mid" "|")
+			 ("lceil" "&#8968;")
+			 ("rceil" "&#8969;")
+			 ("lfloor" "&#8970;")
+			 ("rfloor" "&#8971;")
+			 ("langle" "&#9001;")
+			 ("rangle" "&#9002;")
+			 ;; Misc
+			 ("loz" "&#9674;")
+			 ("spades" "&#9824;")
+			 ("clubs" "&#9827;")
+			 ("hearts" "&#9829;")
+			 ("diams" "&#9830;")
+			 ("euro" "&#8464;")
+			 ;; LaTeX
+			 ("dag" "dag")
+			 ("ddag" "ddag")
+			 ("circ" "o")
+			 ("top" "T")
+			 ("bottom" "&#8869;")
+			 ("lhd" "<")
+			 ("rhd" ">")
+			 ("parallel" "||")))))
+
+;*---------------------------------------------------------------------*/
+;*    html-file ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (html-file n e)
+  (let ((proc (or (engine-custom e 'file-name-proc) html-file-default)))
+    (proc n e)))
+
+;*---------------------------------------------------------------------*/
+;*    html-title-engine ...                                            */
+;*---------------------------------------------------------------------*/
+(define html-title-engine
+   (copy-engine 'html-title base-engine
+      :filter (make-string-replace '((#\< "&lt;")
+				     (#\> "&gt;")
+				     (#\& "&amp;")
+				     (#\" "&quot;")))))
+
+;*---------------------------------------------------------------------*/
+;*    html-browser-title ...                                           */
+;*---------------------------------------------------------------------*/
+(define (html-browser-title n)
+   (and (markup? n)
+	(or (markup-option n :html-title)
+	    (if (document? n)
+		(markup-option n :title)
+		(html-browser-title (ast-parent n))))))
+
+
+;*---------------------------------------------------------------------*/
+;*    html-container-number ...                                        */
+;*    -------------------------------------------------------------    */
+;*    Returns a string representing the container number               */
+;*---------------------------------------------------------------------*/
+(define (html-container-number c e)
+   (define (html-number n proc)
+      (cond
+	 ((string? n)
+	  n)
+	 ((number? n)
+	  (if (procedure? proc)
+	      (proc n)
+	      (number->string n)))
+	 (else
+	  "")))
+   (define (html-chapter-number c)
+      (html-number (markup-option c :number)
+		   (engine-custom e 'chapter-number->string)))
+   (define (html-section-number c)
+      (let ((p (ast-parent c))
+	    (s (html-number (markup-option c :number)
+			    (engine-custom e 'section-number->string))))
+	 (cond
+	    ((is-markup? p 'chapter)
+	     (string-append (html-chapter-number p) "." s))
+	    (else
+	     (string-append s)))))
+   (define (html-subsection-number c)
+      (let ((p (ast-parent c))
+	    (s (html-number (markup-option c :number)
+			    (engine-custom e 'subsection-number->string))))
+	 (cond
+	    ((is-markup? p 'section)
+	     (string-append (html-section-number p) "." s))
+	    (else
+	     (string-append "." s)))))
+   (define (html-subsubsection-number c)
+      (let ((p (ast-parent c))
+	    (s (html-number (markup-option c :number)
+			    (engine-custom e 'subsubsection-number->string))))
+	 (cond
+	    ((is-markup? p 'subsection)
+	     (string-append (html-subsection-number p) "." s))
+	    (else
+	     (string-append ".." s)))))
+   (define (inner-html-container-number c)
+      (html-number (markup-option c :number) #f))
+   (let ((n (markup-option c :number)))
+      (if (not n)
+	  ""
+	  (case (markup-markup c)
+	     ((chapter)
+	      (html-chapter-number c))
+	     ((section)
+	      (html-section-number c))
+	     ((subsection)
+	      (html-subsection-number c))
+	     ((subsubsection)
+	      (html-subsubsection-number c))
+	     (else
+	      (if (container? c)
+		  (inner-html-container-number c)
+		  (skribe-error 'html-container-number
+				"Not a container"
+				(markup-markup c))))))))
+
+;*---------------------------------------------------------------------*/
+;*    html-counter ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (html-counter cnts)
+   (cond
+      ((not cnts)
+       "")
+      ((null? cnts)
+       "")
+      ((not (pair? cnts))
+       cnts)
+      ((null? (cdr cnts))
+       (format #f "~a." (car cnts)))
+      (else
+       (let loop ((cnts cnts))
+	  (if (null? (cdr cnts))
+	      (format #f "~a" (car cnts))
+	      (format #f "~a.~a" (car cnts) (loop (cdr cnts))))))))
+
+;*---------------------------------------------------------------------*/
+;*    html-width ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-public (html-width width)
+   (cond
+      ((and (integer? width) (exact? width))
+       (format #f "~A" width))
+      ((real? width)
+       (format #f "~A%" (inexact->exact (round width))))
+      ((string? width)
+       width)
+      (else
+       (skribe-error 'html-width "bad width" width))))
+
+;*---------------------------------------------------------------------*/
+;*    html-class ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-public (html-class m)
+   (if (markup? m)
+       (let ((c (markup-class m)))
+	  (if (or (string? c) (symbol? c) (number? c))
+	      (printf " class=\"~a\"" c)))))
+
+;*---------------------------------------------------------------------*/
+;*    html-markup-class ...                                            */
+;*---------------------------------------------------------------------*/
+(define-public (html-markup-class m)
+   (lambda (n e)
+      (printf "<~a" m)
+      (html-class n)
+      (display ">")))
+
+;*---------------------------------------------------------------------*/
+;*    html-color-spec? ...                                             */
+;*---------------------------------------------------------------------*/
+(define (html-color-spec? v)
+   (and v
+	(not (unspecified? v))
+	(or (not (string? v)) (> (string-length v) 0))))
+
+;*---------------------------------------------------------------------*/
+;*    document ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+   :options '(:title :author :ending :html-title :env :keywords)
+   :action (lambda (n e)
+	      (let* ((id (markup-ident n))
+		     (title (new markup
+			       (markup '&html-document-title)
+			       (parent n)
+			       (ident (string-append id "-title"))
+			       (class (markup-class n))
+			       (options `((author ,(markup-option n :author))))
+			       (body (markup-option n :title)))))
+		 (&html-generic-document n title e)))
+   :after (lambda (n e)
+	     (if (engine-custom e 'emit-sui)
+		 (document-sui n e))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-html ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-html
+   :before "<!-- 95% W3C COMPLIANT, 95% CSS FREE, RAW HTML -->
+<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+<html>\n"
+   :after "</html>")
+
+;*---------------------------------------------------------------------*/
+;*    &html-head ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-head
+   :before (lambda (n e)
+             (printf "<head>\n")
+             (printf "<meta http-equiv=\"Content-Type\" content=\"text/html;")
+             (printf "charset=~A\">\n" (engine-custom (find-engine 'html)
+                                                      'charset)))
+   :after "</head>\n\n")
+
+;*---------------------------------------------------------------------*/
+;*    &html-meta ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-meta
+   :before "<meta name=\"keywords\" content=\""
+   :action (lambda (n e)
+             (let ((kw* (map ast->string (or (markup-body n) '()))))
+               (output (keyword-list->comma-separated kw*) e)))
+   :after  "\">\n")
+
+;*---------------------------------------------------------------------*/
+;*    &html-body ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-body
+   :before (lambda (n e)
+	      (let ((bg (engine-custom e 'background)))
+		 (display "<body")
+		 (html-class n)
+		 (when (html-color-spec? bg) (printf " bgcolor=\"~a\"" bg))
+		 (display ">\n")))
+   :after "</body>\n")
+
+;*---------------------------------------------------------------------*/
+;*    &html-page ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-page
+   :action (lambda (n e)
+	      (define (html-margin m fn size bg fg cla)
+		 (printf "<td align=\"left\" valign=\"top\" class=\"~a\"" cla)
+		 (if size
+		     (printf " width=\"~a\"" (html-width size)))
+		 (if (html-color-spec? bg)
+		     (printf " bgcolor=\"~a\">" bg)
+		     (display ">"))
+		 (printf "<div class=\"~a\">\n" cla)
+		 (cond
+		    ((and (string? fg) (string? fn))
+		     (printf "<font color=\"~a\" \"~a\">" fg fn))
+		    ((string? fg)
+		     (printf "<font color=\"~a\">" fg))
+		    ((string? fn)
+		     (printf "<font \"~a\">" fn)))
+		 (if (procedure? m)
+		     (skribe-eval (m n e) e)
+		     (output m e))
+		 (if (or (string? fg) (string? fn))
+		     (display "</font>"))
+		 (display "</div></td>\n"))
+	      (let ((body (markup-body n))
+		    (lm (engine-custom e 'left-margin))
+		    (lmfn (engine-custom e 'left-margin-font))
+		    (lms (engine-custom e 'left-margin-size))
+		    (lmbg (engine-custom e 'left-margin-background))
+		    (lmfg (engine-custom e 'left-margin-foreground))
+		    (rm (engine-custom e 'right-margin))
+		    (rmfn (engine-custom e 'right-margin-font))
+		    (rms (engine-custom e 'right-margin-size))
+		    (rmbg (engine-custom e 'right-margin-background))
+		    (rmfg (engine-custom e 'right-margin-foreground)))
+		 (cond
+		    ((and lm rm)
+		     (let* ((ep (engine-custom e 'margin-padding))
+			    (ac (if (number? ep) ep 0)))
+			(printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribilo-margins\"><tr>\n" ac))
+		     (html-margin lm lmfn lms lmbg lmfg "skribilo-left-margin")
+		     (html-margin body #f #f #f #f "skribilo-body")
+		     (html-margin rm rmfn rms rmbg rmfg "skribilo-right-margin")
+		     (display "</tr></table>"))
+		    (lm
+		     (let* ((ep (engine-custom e 'margin-padding))
+			    (ac (if (number? ep) ep 0)))
+			(printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribilo-margins\"><tr>\n" ac))
+		     (html-margin lm lmfn lms lmbg lmfg "skribilo-left-margin")
+		     (html-margin body #f #f #f #f "skribilo-body")
+		     (display "</tr></table>"))
+		    (rm
+		     (let* ((ep (engine-custom e 'margin-padding))
+			    (ac (if (number? ep) ep 0)))
+			(printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribilo-margins\"><tr>\n"))
+		     (html-margin body #f #f #f #f "skribilo-body")
+		     (html-margin rm rmfn rms rmbg rmfg "skribilo-right-margin")
+		     (display "</tr></table>"))
+		    (else
+		     (display "<div class=\"skribilo-body\">\n")
+		     (output body e)
+		     (display "</div>\n"))))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-header ...                                         */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-header n e)
+   (let* ((ic (engine-custom e 'favicon))
+	  (id (markup-ident n)))
+      (unless (string? id)
+	 (skribe-error '&html-generic-header
+		       (format #f "Illegal identifier `~a'" id)
+		       n))
+      ;; title
+      (output (new markup
+		 (markup '&html-header-title)
+		 (parent n)
+		 (ident (string-append id "-title"))
+		 (class (markup-class n))
+		 (body (markup-body n)))
+	      e)
+      ;; favicon
+      (output (new markup
+		 (markup '&html-header-favicon)
+		 (parent n)
+		 (ident (string-append id "-favicon"))
+		 (body (cond
+			  ((string? ic)
+			   ic)
+			  ((procedure? ic)
+			   (ic d e))
+			  (else #f))))
+	      e)
+      ;; style
+      (output (new markup
+		 (markup '&html-header-style)
+		 (parent n)
+		 (ident (string-append id "-style"))
+		 (class (markup-class n)))
+	      e)
+      ;; css
+      (output (new markup
+		 (markup '&html-header-css)
+		 (parent n)
+		 (ident (string-append id "-css"))
+		 (body (let ((c (engine-custom e 'css)))
+			  (if (string? c)
+			      (list c)
+			      c))))
+	      e)
+      ;; javascript
+      (output (new markup
+		 (markup '&html-header-javascript)
+		 (parent n)
+		 (ident (string-append id "-javascript")))
+	      e)))
+
+(markup-writer '&html-header-title
+   :before "<title>"
+   :action (lambda (n e)
+	      (output (markup-body n) html-title-engine))
+   :after "</title>\n")
+
+(markup-writer '&html-header-favicon
+   :action (lambda (n e)
+	      (let ((i (markup-body n)))
+		 (when i
+		    (printf " <link rel=\"shortcut icon\" href=~s>\n" i)))))
+
+(markup-writer '&html-header-css
+   :action (lambda (n e)
+	      (let ((css (markup-body n)))
+		 (when (pair? css)
+		    (for-each (lambda (css)
+				 (printf " <link href=~s rel=\"stylesheet\" type=\"text/css\">\n" css))
+			      css)))))
+
+(markup-writer '&html-header-style
+   :before " <style type=\"text/css\">\n  <!--\n"
+   :action (lambda (n e)
+	      (let ((hd (engine-custom e 'head))
+		    (icss (let ((ic (engine-custom e 'inline-css)))
+			     (if (string? ic)
+				 (list ic)
+				 ic))))
+		 (display "  pre { font-family: monospace }\n")
+		 (display "  tt { font-family: monospace }\n")
+		 (display "  code { font-family: monospace }\n")
+		 (display "  p.flushright { text-align: right }\n")
+		 (display "  p.flushleft { text-align: left }\n")
+		 (display "  span.sc { font-variant: small-caps }\n")
+		 (display "  span.sf { font-family: sans-serif }\n")
+		 (display "  span.skribetitle { font-family: sans-serif; font-weight: bolder; font-size: x-large; }\n")
+		 (when hd (display (format #f "  ~a\n" hd)))
+		 (when (pair? icss)
+		    (for-each (lambda (css)
+				 (let ((p (open-input-file css)))
+				    (if (not (input-port? p))
+					(skribe-error
+					 'html-css
+					 "Can't open CSS file for input"
+					 css)
+					(begin
+					   (let loop ((l (read-line p)))
+					      (unless (eof-object? l)
+						 (display l)
+						 (newline)
+						 (loop (read-line p))))
+					   (close-input-port p)))))
+			      icss))))
+   :after "  -->\n </style>\n")
+
+(markup-writer '&html-header-javascript
+   :action (lambda (n e)
+	      (when (engine-custom e 'javascript)
+		 (display " <script language=\"JavaScript\" type=\"text/javascript\">\n")
+		 (display " <!--\n")
+		 (display "  function skribenospam( n, d, f ) {\n")
+		 (display "    nn=n.replace( / /g , \".\" );\n" )
+		 (display "    dd=d.replace( / /g , \".\" );\n" )
+		 (display "    document.write( \"<a href=\\\"mailto:\" + nn + \"@\" + dd + \"\\\">\" );\n")
+		 (display "    if( f ) {\n")
+		 (display "      document.write( \"<tt>\" + nn + \"@\" + dd + \"</\" + \"tt><\" + \"/a>\" );\n")
+		 (display "    }\n")
+		 (display "  }\n")
+		 (display " -->\n")
+		 (display " </script>\n"))
+	      (let* ((ejs (engine-custom e 'js))
+		     (js (cond
+			    ((string? ejs)
+			     (list ejs))
+			    ((list? ejs)
+			     ejs)
+			    (else
+			     '()))))
+		 (for-each (lambda (s)
+			      (printf "<script type=\"text/javascript\" src=\"~a\"></script>" s))
+			   js))))
+
+
+;*---------------------------------------------------------------------*/
+;*    &html-header ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-document-header :action &html-generic-header)
+(markup-writer '&html-chapter-header :action &html-generic-header)
+(markup-writer '&html-section-header :action &html-generic-header)
+(markup-writer '&html-subsection-header :action &html-generic-header)
+(markup-writer '&html-subsubsection-header :action &html-generic-header)
+
+;*---------------------------------------------------------------------*/
+;*    &html-ending ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-ending
+   :before "<div class=\"skribilo-ending\">"
+   :action (lambda (n e)
+	      (let ((body (markup-body n)))
+		 (if body
+		     (output body #t)
+		     (skribe-eval
+		      (list (hrule)
+			    (p :class "ending"
+			       (font :size -1
+				     (list "This HTML page was "
+					   "produced by "
+					   (ref :text "Skribilo"
+						:url (skribilo-url))
+					   "."
+					   (linebreak)
+					   "Last update: "
+					   (s19:date->string
+					    (s19:current-date))))))
+		      e))))
+   :after "</div>\n")
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-title ...                                          */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-title n e)
+   (let* ((title (markup-body n))
+	  (authors (markup-option n 'author))
+	  (tbg (engine-custom e 'title-background))
+	  (tfg (engine-custom e 'title-foreground))
+	  (tfont (engine-custom e 'title-font)))
+      (when title
+	 (display "<table width=\"100%\" class=\"skribilo-title\" cellspacing=\"0\" cellpadding=\"0\"><tbody>\n<tr>")
+	 (if (html-color-spec? tbg)
+	     (printf "<td align=\"center\"~A>"
+                     (if (html-color-spec? tbg)
+                         (string-append "bgcolor=\"" tbg "\"")
+                         ""))
+	     (display "<td align=\"center\">"))
+	 (if (string? tfg)
+	     (printf "<font color=\"~a\">" tfg))
+	 (when title
+	    (if (string? tfont)
+		(begin
+		   (printf "<font ~a><strong>" tfont)
+		   (output title e)
+		   (display "</strong></font>"))
+		(begin
+		   (printf "<div class=\"skribilo-title\"><strong><big>")
+		   (output title e)
+		   (display "</big></strong></div>"))))
+	 (if (not authors)
+	     (display "\n")
+	     (html-title-authors authors e))
+	 (if (string? tfg)
+	     (display "</font>"))
+	 (display "</td></tr></tbody></table>\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-document-title ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-document-title :action &html-generic-title)
+(markup-writer '&html-chapter-title :action &html-generic-title)
+(markup-writer '&html-section-title :action &html-generic-title)
+(markup-writer '&html-subsection-title :action &html-generic-title)
+(markup-writer '&html-subsubsection-title :action &html-generic-title)
+
+;*---------------------------------------------------------------------*/
+;*    &html-footnotes                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-footnotes
+   :before (lambda (n e)
+	      (let ((footnotes (markup-body n)))
+		 (when (pair? footnotes)
+		    (display "<div class=\"skribilo-footnote\">")
+		    (display "<br><br>\n")
+		    (display "<hr width='20%' size='2' align='left'>\n"))))
+   :action (lambda (n e)
+	      (let ((footnotes (markup-body n)))
+		 (when (pair? footnotes)
+		    (let loop ((fns footnotes))
+		       (if (pair? fns)
+			   (let ((fn (car fns)))
+			      (printf "<a name=\"footnote-~a\">"
+				      (string-canonicalize
+				       (container-ident fn)))
+			      (printf "<sup><small>~a</small></sup></a>: "
+				      (markup-option fn :number))
+			      (output (markup-body fn) e)
+			      (display "\n<br>\n")
+			      (loop (cdr fns)))))
+		    (display "<div>")))))
+
+;*---------------------------------------------------------------------*/
+;*    html-title-authors ...                                           */
+;*---------------------------------------------------------------------*/
+(define-public (html-title-authors authors e)
+   (define (html-authorsN authors cols first)
+      (define (make-row authors . opt)
+	 (tr (map (lambda (v)
+		     (apply td :align 'center :valign 'top v opt))
+		  authors)))
+      (define (make-rows authors)
+	 (let loop ((authors authors)
+		    (rows '())
+		    (row '())
+		    (cnum 0))
+	    (cond
+	       ((null? authors)
+		(reverse! (cons (make-row (reverse! row)) rows)))
+	       ((= cnum cols)
+		(loop authors
+		      (cons (make-row (reverse! row)) rows)
+		      '()
+		      0))
+	       (else
+		(loop (cdr authors)
+		      rows
+		      (cons (car authors) row)
+		      (+ cnum 1))))))
+      (output (table :cellpadding 10
+		 (if first
+		     (cons (make-row (list (car authors)) :colspan cols)
+			   (make-rows (cdr authors)))
+		     (make-rows authors)))
+	      e))
+   (cond
+      ((pair? authors)
+       (display "<center>\n")
+       (let ((len (length authors)))
+	  (case len
+	     ((1)
+	      (output (car authors) e))
+	     ((2 3)
+	      (html-authorsN authors len #f))
+	     ((4)
+	      (html-authorsN authors 2 #f))
+	     (else
+	      (html-authorsN authors 3 #t))))
+       (display "</center>\n"))
+      (else
+       (html-title-authors (list authors) e))))
+
+;*---------------------------------------------------------------------*/
+;*    document-sui ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (document-sui n e)
+   (define (sui)
+      (display "(sui \"")
+      (skribe-eval (markup-option n :title) html-title-engine)
+      (display "\"\n")
+      (printf "  :file ~s\n" (sui-referenced-file n e))
+      (sui-marks n e)
+      (sui-blocks 'chapter n e)
+      (sui-blocks 'section n e)
+      (sui-blocks 'subsection n e)
+      (sui-blocks 'subsubsection n e)
+      (display "  )\n"))
+   (if (string? (*destination-file*))
+       (let ((f (format #f "~a.sui" (prefix (*destination-file*)))))
+	  (with-output-to-file f sui))
+       (sui)))
+
+;*---------------------------------------------------------------------*/
+;*    sui-referenced-file ...                                          */
+;*---------------------------------------------------------------------*/
+(define (sui-referenced-file n e)
+   (let ((file (html-file n e)))
+      (if (member (suffix file) '("skb" "sui" "skr" "html"))
+	  (string-append (strip-ref-base (prefix file)) ".html")
+	  file)))
+
+;*---------------------------------------------------------------------*/
+;*    sui-marks ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (sui-marks n e)
+   (printf "  (marks")
+   (for-each (lambda (m)
+		(printf "\n    (~s" (markup-ident m))
+		(printf " :file ~s" (sui-referenced-file m e))
+		(printf " :mark ~s" (markup-ident m))
+		(when (markup-class m)
+		   (printf " :class ~s" (markup-class m)))
+		(display ")"))
+	     (search-down (lambda (n) (is-markup? n 'mark)) n))
+   (display ")\n"))
+
+;*---------------------------------------------------------------------*/
+;*    sui-blocks ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (sui-blocks kind n e)
+   (printf "  (~as" kind)
+   (for-each (lambda (chap)
+		(display "\n    (\"")
+		(skribe-eval (markup-option chap :title) html-title-engine)
+		(printf "\" :file ~s" (sui-referenced-file chap e))
+		(printf " :mark ~s" (markup-ident chap))
+		(when (markup-class chap)
+		   (printf " :class ~s" (markup-class chap)))
+		(display ")"))
+	     (container-search-down (lambda (n) (is-markup? n kind)) n))
+   (display ")\n"))
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :before (lambda (n e)
+	      (display "<table")
+	      (html-class n)
+	      (display "><tbody>\n"))
+   :action (lambda (n e)
+	      (let ((name (markup-option n :name))
+		    (title (markup-option n :title))
+		    (affiliation (markup-option n :affiliation))
+		    (email (markup-option n :email))
+		    (url (markup-option n :url))
+		    (address (markup-option n :address))
+		    (phone (markup-option n :phone))
+		    (nfn (engine-custom e 'author-font))
+		    (align (markup-option n :align)))
+		 (define (row n)
+		    (printf "<tr><td align=\"~a\">" align)
+		    (output n e)
+		    (display "</td></tr>"))
+		 ;; name
+		 (printf "<tr><td align=\"~a\">" align)
+		 (if nfn (printf "<font ~a>\n" nfn))
+		 (output name e)
+		 (if nfn (printf "</font>\n"))
+		 (display "</td></tr>")
+		 ;; title
+		 (if title (row title))
+		 ;; affiliation
+		 (if affiliation (row affiliation))
+		 ;; address
+		 (if (pair? address)
+		     (for-each row address))
+		 ;; telephone
+		 (if phone (row phone))
+		 ;; email
+		 (if email (row email))
+		 ;; url
+		 (if url (row url))))
+   :after "</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :predicate (lambda (n e) (markup-option n :photo))
+   :before (lambda (n e)
+	      (display "<table")
+	      (html-class n)
+	      (display "><tbody>\n<tr>"))
+   :action (lambda (n e)
+	      (let ((photo (markup-option n :photo)))
+		 (display "<td>")
+		 (output photo e)
+		 (display "</td><td>")
+		 (markup-option-add! n :photo #f)
+		 (output n e)
+		 (markup-option-add! n :photo photo)
+		 (display "</td>")))
+   :after "</tr>\n</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;*    toc ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'toc
+   :options 'all
+   :action (lambda (n e)
+	      (define (col n)
+		 (let loop ((i 0))
+		      (if (< i n)
+			  (begin
+			     (display "<td></td>")
+			     (loop (+ i 1))))))
+	      (define (toc-entry fe level)
+		 (let* ((c (car fe))
+			(ch (cdr fe))
+			(t (markup-option c :title))
+			(id (markup-ident c))
+			(f (html-file c e)))
+		    (unless (string? id)
+		       (skribe-error 'toc
+				     (format #f "illegal identifier `~a'" id)
+				     c))
+		    (display " <tr>")
+		    ;; blank columns
+		    (col level)
+		    ;; number
+		    (printf "<td valign=\"top\" align=\"left\">~a</td>"
+			    (html-container-number c e))
+		    ;; title
+		    (printf "<td colspan=\"~a\" width=\"100%\">"
+			    (- 4 level))
+		    (printf "<a href=\"~a#~a\">"
+			    (if (and (*destination-file*)
+				     (string=? f (*destination-file*)))
+				""
+				(strip-ref-base (or f (*destination-file*) "")))
+			    (string-canonicalize id))
+		    (output (markup-option c :title) e)
+		    (display "</a></td>")
+		    (display "</tr>\n")
+		    ;; the children
+		    (for-each (lambda (n) (toc-entry n (+ 1 level))) ch)))
+
+	      (let* ((c (markup-option n :chapter))
+		     (s (markup-option n :section))
+		     (ss (markup-option n :subsection))
+		     (sss (markup-option n :subsubsection))
+		     (b (markup-body n))
+		     (bb (if (handle? b)
+			     (handle-ast b)
+			     b)))
+		 (if (not (container? bb))
+		     (error 'toc
+			    "Illegal body (container expected)"
+			    (if (markup? bb)
+				(markup-markup bb)
+				"???"))
+		     (let ((lst (find-down (lambda (x)
+					     (and (markup? x)
+						  (markup-option x :toc)
+						  (or (and sss (is-markup? x 'subsubsection))
+						      (and ss (is-markup? x 'subsection))
+						      (and s (is-markup? x 'section))
+						      (and c (is-markup? x 'chapter))
+						      (markup-option n (symbol->keyword
+									(markup-markup x))))))
+					   (container-body bb))))
+		       ;; avoid to produce an empty table
+		       (unless (null? lst)
+			  (display "<table cellspacing=\"1\" cellpadding=\"1\" width=\"100%\"")
+			  (html-class n)
+			  (display ">\n<tbody>\n")
+
+			  (for-each (lambda (n) (toc-entry n 0)) lst)
+
+			  (display "</tbody>\n</table>\n")))))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-document ...                                       */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-document n title e)
+   (let* ((id (markup-ident n))
+	  (header (new markup
+		     (markup '&html-chapter-header)
+		     (ident (string-append id "-header"))
+		     (class (markup-class n))
+		     (parent n)
+		     (body (html-browser-title n))))
+          (meta (new markup
+                   (markup '&html-meta)
+                   (ident (string-append id "-meta"))
+                   (class (markup-class n))
+                   (parent n)
+                   (body (markup-option (ast-document n) :keywords))))
+	  (head (new markup
+		   (markup '&html-head)
+		   (ident (string-append id "-head"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body (list header meta))))
+	  (ftnote (new markup
+		     (markup '&html-footnotes)
+		     (ident (string-append id "-footnote"))
+		     (class (markup-class n))
+		     (parent n)
+		     (body (reverse!
+			    (container-env-get n 'footnote-env)))))
+	  (page (new markup
+		   (markup '&html-page)
+		   (ident (string-append id "-page"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body (list (markup-body n) ftnote))))
+	  (ending (new markup
+		     (markup '&html-ending)
+		     (ident (string-append id "-ending"))
+		     (class (markup-class n))
+		     (parent n)
+		     (body (or (markup-option n :ending)
+			       (let ((p (ast-document n)))
+				  (and p (markup-option p :ending)))))))
+	  (body (new markup
+		   (markup '&html-body)
+		   (ident (string-append id "-body"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body (list title page ending))))
+	  (html (new markup
+		   (markup '&html-html)
+		   (ident (string-append id "-html"))
+		   (class (markup-class n))
+		   (parent n)
+		   (body (list head body)))))
+      ;; No file must be opened for documents. These files are
+      ;; directly opened by Skribe
+      (if (document? n)
+	  (output html e)
+	  (with-output-to-file (html-file n e)
+	     (lambda ()
+		(output html e))))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-generic-subdocument ...                                    */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-subdocument n e)
+   (let* ((p (ast-document n))
+	  (id (markup-ident n))
+	  (ti (let* ((nb (html-container-number n e))
+		     (tc (markup-option n :title))
+		     (ti (if (document? p)
+			     (list (markup-option p :title)
+				   (engine-custom e 'file-title-separator)
+				   tc)
+			     tc))
+		     (sep (engine-custom
+			     e
+			     (symbol-append (markup-markup n)
+					    '-title-number-separator)))
+		     (nti (and tc
+			       (if (and nb (not (equal? nb "")))
+				   (list nb
+					 (if (unspecified? sep) ". " sep)
+					 ti)
+				   ti))))
+		 (new markup
+		    (markup (symbol-append '&html- (markup-markup n) '-title))
+		    (ident (string-append id "-title"))
+		    (parent n)
+		    (options '((author ())))
+		    (body nti)))))
+      (case (markup-markup n)
+	 ((chapter)
+	  (skribe-message "  [~s chapter: ~a]\n" (engine-ident e) id))
+	 ((section)
+	  (skribe-message "    [~s section: ~a]\n" (engine-ident e) id)))
+      (&html-generic-document n ti e)))
+
+;*---------------------------------------------------------------------*/
+;*    chapter ... @label chapter@                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'chapter
+   :options '(:title :number :file :toc :html-title :env)
+   :before (lambda (n e)
+	      (let ((title (markup-option n :title))
+		    (ident (markup-ident n)))
+		 (display "<!-- ")
+		 (output title html-title-engine)
+		 (display " -->\n")
+		 (display "<a name=\"")
+		 (display (string-canonicalize ident))
+		 (display "\"></a>\n")
+		 (display "<center><h1")
+		 (html-class n)
+		 (display ">")
+		 (output (html-container-number n e) e)
+		 (display " ")
+		 (output (markup-option n :title) e)
+		 (display "</h1></center>")))
+   :after "<br>")
+
+;; This writer is invoked only for chapters rendered inside separate files!
+(markup-writer 'chapter
+   :options '(:title :number :file :toc :html-title :env)
+   :predicate (lambda (n e)
+		 (or (markup-option n :file)
+		     (engine-custom e 'chapter-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    html-section-title ...                                           */
+;*---------------------------------------------------------------------*/
+(define (html-section-title n e)
+   (let* ((title (markup-option n :title))
+	  (number (markup-option n :number))
+	  (c (markup-class n))
+	  (ident (markup-ident n))
+	  (kind (markup-markup n))
+	  (tbg (engine-custom e (symbol-append kind '-title-background)))
+	  (tfg (engine-custom e (symbol-append kind '-title-foreground)))
+	  (tstart (engine-custom e (symbol-append kind '-title-start)))
+	  (tstop (engine-custom e (symbol-append kind '-title-stop)))
+	  (nsep (engine-custom e (symbol-append kind '-title-number-separator))))
+      ;; the section header
+      (display "<!-- ")
+      (output title html-title-engine)
+      (display " -->\n")
+      (display "<a name=\"")
+      (display (string-canonicalize ident))
+      (display "\"></a>\n")
+      (if c
+	  (printf "<div class=\"~a-title\">" c)
+	  (printf "<div class=\"skribilo-~a-title\">" (markup-markup n)))
+      (when (html-color-spec? tbg)
+	 (display "<table width=\"100%\">")
+	 (printf "<tr><td bgcolor=\"~a\">" tbg))
+      (display tstart)
+      (if tfg (printf "<font color=\"~a\">" tfg))
+      (if number
+	  (begin
+	     (output (html-container-number n e) e)
+	     (output nsep e)))
+      (output title e)
+      (if tfg (display "</font>\n"))
+      (display tstop)
+      (when (and (string? tbg) (> (string-length tbg) 0))
+	 (display "</td></tr></table>\n"))
+      (display "</div>")
+      (display "<div")
+      (html-class n)
+      (display ">"))
+   (newline))
+
+;*---------------------------------------------------------------------*/
+;*    section ...  @label section@                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :before html-section-title
+   :after "</div><br>\n")
+
+;; on-file section writer
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :predicate (lambda (n e)
+		 (or (markup-option n :file)
+		     (engine-custom e 'section-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    subsection ... @label subsection@                                */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsection
+   :options '(:title :html-title :number :toc :env :file)
+   :before html-section-title
+   :after "</div>\n")
+
+;; on-file subsection writer
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :predicate (lambda (n e)
+		 (or (markup-option n :file)
+		     (engine-custom e 'subsection-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    subsubsection ... @label subsubsection@                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsubsection
+   :options '(:title :html-title :number :toc :env :file)
+   :before html-section-title
+   :after "</div>\n")
+
+;; on-file subsection writer
+(markup-writer 'section
+   :options '(:title :html-title :number :toc :file :env)
+   :predicate (lambda (n e)
+		 (or (markup-option n :file)
+		     (engine-custom e 'subsubsection-file)))
+   :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;*    paragraph ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'paragraph
+   :before (lambda (n e)
+	      (when (and (>= (skribe-debug) 2) (location? (ast-loc n)))
+		 (printf "<span style=\"display: block; position: relative; left: -2cm; font-size: x-small; font-style: italic; color: ff8e1e;\">~a</span>"
+			 (ast-location n)))
+	      ((html-markup-class "p") n e))
+   :after "</p>")
+
+;*---------------------------------------------------------------------*/
+;*    ~ ...                                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '~
+   :before "&nbsp;"
+   :after #f
+   :action #f)
+
+;*---------------------------------------------------------------------*/
+;*    footnote ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'footnote
+   :options '(:label)
+   :action (lambda (n e)
+	      (printf "<a href=\"#footnote-~a\"><sup><small>~a</small></sup></a>"
+		      (string-canonicalize (container-ident n))
+		      (markup-option n :label))))
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'linebreak
+	       :before (lambda (n e)
+			  (display "<br")
+			  (html-class n)
+			  (display "/>")))
+
+;*---------------------------------------------------------------------*/
+;*    hrule ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'hrule
+   :options '(:width :height)
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (height (markup-option n :height)))
+		 (display "<hr")
+		 (html-class n)
+		 (if (< width 100)
+		     (printf " width=\"~a\"" (html-width width)))
+		 (if (> height 1)
+		     (printf " size=\"~a\"" height))
+		 (display ">"))))
+
+;*---------------------------------------------------------------------*/
+;*    color ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'color
+   :options '(:bg :fg :width :margin)
+   :before (lambda (n e)
+	      (let ((m (markup-option n :margin))
+		    (w (markup-option n :width))
+		    (bg (markup-option n :bg))
+		    (fg (markup-option n :fg)))
+		 (when (html-color-spec? bg)
+		    (display "<table cellspacing=\"0\"")
+		    (html-class n)
+		    (printf " cellpadding=\"~a\"" (if m m 0))
+		    (if w (printf " width=\"~a\"" (html-width w)))
+		    (display "><tbody>\n<tr>")
+		    (display "<td bgcolor=\"")
+		    (output bg e)
+		    (display "\">"))
+		 (when (html-color-spec? fg)
+		    (display "<font color=\"")
+		    (output fg e)
+		    (display "\">"))))
+   :after (lambda (n e)
+	     (when (html-color-spec? (markup-option n :fg))
+		(display "</font>"))
+	     (when (html-color-spec? (markup-option n :bg))
+		(display "</td></tr>\n</tbody></table>"))))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'frame
+   :options '(:width :margin :border)
+   :before (lambda (n e)
+	      (let ((m (markup-option n :margin))
+		    (b (markup-option n :border))
+		    (w (markup-option n :width)))
+		 (display "<table cellspacing=\"0\"")
+		 (html-class n)
+		 (printf " cellpadding=\"~a\"" (if m m 0))
+		 (printf " border=\"~a\"" (if b b 0))
+		 (if w (printf " width=\"~a\"" (html-width w)))
+		 (display "><tbody>\n<tr><td>")))
+   :after "</td></tr>\n</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;*    font ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'font
+   :options '(:size :face)
+   :before (lambda (n e)
+	      (let ((size (markup-option n :size))
+		    (face (markup-option n :face)))
+		 (when (and (number? size) (inexact? size))
+		    (let ((s (if (> size 0) "<big>" "<small>"))
+			  (d (if (> size 0) 1 -1)))
+		       (do ((i (inexact->exact size) (- i d)))
+			   ((= i 0))
+			   (display s))))
+		 (when (or (and (number? size) (exact? size)) face)
+		    (display "<font")
+		    (html-class n)
+		    (when (and (number? size) (exact? size) (not (= size 0)))
+		       (printf " size=\"~a\"" size))
+		    (when face (printf " face=\"~a\"" face))
+		    (display ">"))))
+   :after (lambda (n e)
+	     (let ((size (markup-option n :size))
+		   (face (markup-option n :face)))
+		(when (or (and (number? size) (exact? size) (not (= size 0)))
+			  face)
+		   (display "</font>"))
+		(when (and (number? size) (inexact? size))
+		   (let ((s (if (> size 0) "</big>" "</small>"))
+			 (d (if (> size 0) 1 -1)))
+		      (do ((i (inexact->exact size) (- i d)))
+			  ((= i 0))
+			  (display s)))))))
+
+;*---------------------------------------------------------------------*/
+;*    flush ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'flush
+   :options '(:side)
+   :before (lambda (n e)
+	      (case (markup-option n :side)
+		 ((center)
+		  (display "<center")
+		  (html-class n)
+		  (display ">\n"))
+		 ((left)
+		  (display "<p style=\"text-align:left;\"")
+		  (html-class n)
+		  (display ">\n"))
+		 ((right)
+		  (display "<table ")
+		  (html-class n)
+		  (display "width=\"100%\" cellpadding=\"0\" cellspacing=\"0\" border=\"0\"><tr><td align=\"right\">"))
+		 (else
+		  (skribe-error 'flush
+				"Illegal side"
+				(markup-option n :side)))))
+   :after (lambda (n e)
+	     (case (markup-option n :side)
+		((center)
+		 (display "</center>\n"))
+		((right)
+		 (display "</td></tr></table>\n"))
+		((left)
+		 (display "</p>\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+   :before (html-markup-class "center")
+   :after "</center>\n")
+
+;*---------------------------------------------------------------------*/
+;*    pre ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'pre :before (html-markup-class "pre") :after "</pre>\n")
+
+;*---------------------------------------------------------------------*/
+;*    prog ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'prog
+   :options '(:line :mark)
+   :before (html-markup-class "pre")
+   :after "</pre>\n")
+
+;*---------------------------------------------------------------------*/
+;*    itemize ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'itemize
+   :options '(:symbol)
+   :before (html-markup-class "ul")
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			  (let ((ident (and (markup? item)
+					    (markup-ident item))))
+			   (display "<li")
+			   (html-class item)
+			   (display ">")
+			    (if ident  ;; produce an anchor
+				(printf "\n<a name=\"~a\"></a>\n"
+					(string-canonicalize ident)))
+			   (output item e)
+			    (display "</li>\n")))
+			(markup-body n)))
+   :after "</ul>")
+
+;*---------------------------------------------------------------------*/
+;*    enumerate ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'enumerate
+   :options '(:symbol)
+   :before (html-markup-class "ol")
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			  (let ((ident (and (markup? item)
+					    (markup-ident item))))
+			   (display "<li")
+			   (html-class item)
+			   (display ">")
+			    (if ident  ;; produce an anchor
+				(printf "\n<a name=\"~a\"></a>\n" ident))
+			   (output item e)
+			    (display "</li>\n")))
+			(markup-body n)))
+   :after "</ol>")
+
+;*---------------------------------------------------------------------*/
+;*    description ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'description
+   :options '(:symbol)
+   :before (html-markup-class "dl")
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (let ((k (markup-option item :key)))
+			      (for-each (lambda (i)
+					   (display " <dt")
+					   (html-class i)
+					   (display ">")
+					   (output i e)
+					   (display "</dt>"))
+					(if (pair? k) k (list k)))
+			      (display "<dd")
+			      (html-class item)
+			      (display ">")
+			      (output (markup-body item) e)
+			      (display "</dd>\n")))
+			(markup-body n)))
+   :after "</dl>")
+
+;*---------------------------------------------------------------------*/
+;*    item ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'item
+   :options '(:key)
+   :action (lambda (n e)
+	      (let ((k (markup-option n :key)))
+		 (if k
+		     (begin
+			(display "<b")
+			(html-class n)
+			(display ">")
+			(output k e)
+			(display "</b> "))))
+	      (output (markup-body n) e)))
+
+;*---------------------------------------------------------------------*/
+;*    blockquote ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'blockquote
+   :options '()
+   :before (lambda (n e)
+	     (display "<blockquote ")
+	     (html-class n)
+	     (display ">\n"))
+   :after "\n</blockquote>\n")
+
+;*---------------------------------------------------------------------*/
+;*    figure ... @label figure@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'figure
+   :options '(:legend :number :multicolumns :legend-width)
+   :before (html-markup-class "br")
+   :action (lambda (n e)
+	      (let ((ident (markup-ident n))
+		    (number (markup-option n :number))
+		    (legend (markup-option n :legend)))
+		 (display "<a name=\"")
+		 (display (string-canonicalize ident))
+		 (display "\"></a>\n")
+		 (output (markup-body n) e)
+		 (display "<br>\n")
+		 (output (new markup
+			    (markup '&html-figure-legend)
+			    (parent n)
+			    (ident (string-append ident "-legend"))
+			    (class (markup-class n))
+			    (options `((:number ,number)))
+			    (body legend))
+			 e)))
+   :after "<br>")
+
+;*---------------------------------------------------------------------*/
+;*    &html-figure-legend ...                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-figure-legend
+   :options '(:number)
+   :before (lambda (n e)
+	      (display "<center>")
+	      (let ((number (markup-option n :number))
+		    (legend (markup-option n :legend)))
+		 (if number
+		     (printf "<strong>Fig. ~a:</strong> " number)
+		     (printf "<strong>Fig. :</strong> "))))
+   :after "</center>")
+
+;*---------------------------------------------------------------------*/
+;*    table ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'table
+   :options '(:border :width :frame :rules :cellstyle :cellpadding :cellspacing)
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (border (markup-option n :border))
+		    (frame (markup-option n :frame))
+		    (rules (markup-option n :rules))
+		    (cstyle (markup-option n :cellstyle))
+		    (cp (markup-option n :cellpadding))
+		    (cs (markup-option n :cellspacing)))
+		 (display "<table")
+		 (html-class n)
+		 (if width (printf " width=\"~a\"" (html-width width)))
+		 (if border (printf " border=\"~a\"" border))
+		 (if (and (number? cp) (>= cp 0))
+		     (printf " cellpadding=\"~a\"" cp))
+		 (if (and (number? cs) (>= cs 0))
+		     (printf " cellspacing=\"~a\"" cs))
+		 (cond
+		    ((symbol? cstyle)
+		     (printf " style=\"border-collapse: ~a;\"" cstyle))
+		    ((string? cstyle)
+		     (printf " style=\"border-collapse: separate; border-spacing=~a\"" cstyle))
+		    ((number? cstyle)
+		     (printf " style=\"border-collapse: separate; border-spacing=~apt\"" cstyle)))
+		 (if frame
+		     (printf " frame=\"~a\""
+			     (if (eq? frame 'none) "void" frame)))
+		 (if (and rules (not (eq? rules 'header)))
+		     (printf " rules=\"~a\"" rules))
+		 (display "><tbody>\n")))
+   :after "</tbody></table>\n")
+
+;*---------------------------------------------------------------------*/
+;*    tr ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tr
+   :options '(:bg)
+   :before (lambda (n e)
+	      (let ((bg (markup-option n :bg)))
+		 (display "<tr")
+		 (html-class n)
+		 (when (html-color-spec? bg) (printf " bgcolor=\"~a\"" bg))
+		 (display ">")))
+   :after "</tr>\n")
+
+;*---------------------------------------------------------------------*/
+;*    tc ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tc
+   :options '(markup :width :align :valign :colspan :rowspan :bg)
+   :before (lambda (n e)
+	      (let ((markup (or (markup-option n 'markup) 'td))
+		    (width (markup-option n :width))
+		    (align (markup-option n :align))
+		    (valign (let ((v (markup-option n :valign)))
+			       (cond
+				  ((or (eq? v 'center)
+				       (equal? v "center"))
+				   "middle")
+				  (else
+				   v))))
+		    (colspan (markup-option n :colspan))
+		    (rowspan (markup-option n :rowspan))
+		    (bg (markup-option n :bg)))
+		 (printf "<~a" markup)
+		 (html-class n)
+		 (if width (printf " width=\"~a\"" (html-width width)))
+		 (if align (printf " align=\"~a\"" align))
+		 (if valign (printf " valign=\"~a\"" valign))
+		 (if colspan (printf " colspan=\"~a\"" colspan))
+		 (if rowspan (printf " rowspan=\"~a\"" rowspan))
+		 (when (html-color-spec? bg)
+		    (printf " bgcolor=\"~a\"" bg))
+		 (display ">")))
+   :after (lambda (n e)
+	     (let ((markup (or (markup-option n 'markup) 'td)))
+		(printf "</~a>" markup))))
+
+;*---------------------------------------------------------------------*/
+;*    image ... @label image@                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'image
+   :options '(:file :url :width :height)
+   :action (lambda (n e)
+	      (let* ((file (markup-option n :file))
+		     (url (markup-option n :url))
+		     (width (markup-option n :width))
+		     (height (markup-option n :height))
+		     (body (markup-body n))
+		     (efmt (engine-custom e 'image-format))
+		     (img (or url (convert-image file
+						 (if (list? efmt)
+						     efmt
+						     '("gif" "jpg" "png"))))))
+		 (if (not (string? img))
+		     (skribe-error 'html "Illegal image" file)
+		     (begin
+			(printf "<img src=\"~a\" border=\"0\"" img)
+			(html-class n)
+			(if body
+			    (begin
+			       (display " alt=\"")
+			       (output body e)
+			       (display "\""))
+			    (printf " alt=\"~a\"" file))
+			(if width (printf " width=\"~a\"" (html-width width)))
+			(if height (printf " height=\"~a\"" height))
+			(display ">"))))))
+
+;*---------------------------------------------------------------------*/
+;*    Ornaments ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'roman :before "")
+(markup-writer 'bold :before (html-markup-class "strong") :after "</strong>")
+(markup-writer 'underline :before (html-markup-class "u") :after "</u>")
+(markup-writer 'strike :before (html-markup-class "strike") :after "</strike>")
+(markup-writer 'emph :before (html-markup-class "em") :after "</em>")
+(markup-writer 'kbd :before (html-markup-class "kbd") :after "</kbd>")
+(markup-writer 'it :before (html-markup-class "em") :after "</em>")
+(markup-writer 'tt :before (html-markup-class "tt") :after "</tt>")
+(markup-writer 'code :before (html-markup-class "code") :after "</code>")
+(markup-writer 'var :before (html-markup-class "var") :after "</var>")
+(markup-writer 'samp :before (html-markup-class "samp") :after "</samp>")
+(markup-writer 'sc :before "<span class=\"sc\">" :after "</span>")
+(markup-writer 'sf :before "<span class=\"sf\">" :after "</span>")
+(markup-writer 'sub :before (html-markup-class "sub") :after "</sub>")
+(markup-writer 'sup :before (html-markup-class "sup") :after "</sup>")
+
+;*---------------------------------------------------------------------*/
+;*    q ... @label q@                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'q
+   :before "\""
+   :after "\"")
+
+;*---------------------------------------------------------------------*/
+;*    mailto ... @label mailto@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+   :options '(:text)
+   :action (lambda (n e)
+	      (let ((text (markup-option n :text)))
+		 (display "<a href=\"mailto:")
+		 (output (markup-body n) e)
+		 (display #\")
+		 (html-class n)
+		 (display #\>)
+		 (if text
+		     (output text e)
+		     (skribe-eval (tt (markup-body n)) e))
+		 (display "</a>"))))
+
+;*---------------------------------------------------------------------*/
+;*    mailto ... @label mailto@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+   :options '(:text)
+   :predicate (lambda (n e)
+		 (and (engine-custom e 'javascript)
+		      (or (string? (markup-body n))
+			  (and (pair? (markup-body n))
+			       (null? (cdr (markup-body n)))
+			       (string? (car (markup-body n)))))))
+   :action (lambda (n e)
+	      (let* ((body (markup-body n))
+		     (email (if (string? body) body (car body)))
+		     (split (pregexp-split "@" email))
+		     (na (car split))
+		     (do (if (pair? (cdr split)) (cadr split) ""))
+		     (nn (pregexp-replace* "[.]" na " "))
+		     (dd (pregexp-replace* "[.]" do " "))
+		     (text (markup-option n :text)))
+		(display "<script language=\"JavaScript\" type=\"text/javascript\"")
+		(if (not text)
+		    (printf ">skribenospam( ~s, ~s, true )" nn dd)
+		    (begin
+		      (printf ">skribenospam( ~s, ~s, false )" nn dd)
+		      (display "</script>")
+		      (output text e)
+		      (display "<script language=\"JavaScript\" type=\"text/javascript\">document.write(\"</\" + \"a>\")")))
+		(display "</script>\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    mark ... @label mark@                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mark
+   :before (lambda (n e)
+	      (printf "<a name=\"~a\"" (string-canonicalize (markup-ident n)))
+	      (html-class n)
+	      (display ">"))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    ref ... @label ref@                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer 'ref
+   :options '(:text :chapter :section :subsection :subsubsection :figure :mark :handle)
+   :before (lambda (n e)
+	      (let* ((c (handle-ast (markup-body n)))
+		     (id (markup-ident c))
+		     (f (html-file c e))
+		     (class (if (markup-class n)
+				(markup-class n)
+				"skribilo-ref")))
+		 (printf "<a href=\"~a#~a\" class=\"~a\""
+			 (if (and (*destination-file*)
+				  (string=? f (*destination-file*)))
+			     ""
+			     (strip-ref-base (or f (*destination-file*) "")))
+			 (string-canonicalize id)
+			 class)
+		 (display ">")))
+   :action (lambda (n e)
+	      (let ((t (markup-option n :text))
+		    (m (markup-option n 'mark))
+		    (f (markup-option n :figure))
+		    (c (markup-option n :chapter))
+		    (s (markup-option n :section))
+		    (ss (markup-option n :subsection))
+		    (sss (markup-option n :subsubsection)))
+		 (cond
+		    (t
+		     (output t e))
+		    (f
+		     (output (new markup
+				(markup '&html-figure-ref)
+				(body (markup-body n)))
+			     e))
+		    ((or c s ss sss)
+		     (output (new markup
+				(markup '&html-section-ref)
+				(body (markup-body n)))
+			     e))
+
+		    ((not m)
+		     (output (new markup
+				(markup '&html-unmark-ref)
+				(body (markup-body n)))
+			     e))
+		    (else
+		     (display m)))))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    &html-figure-ref ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-figure-ref
+   :action (lambda (n e)
+	      (let ((c (handle-ast (markup-body n))))
+		 (if (or (not (markup? c))
+			 (not (is-markup? c 'figure)))
+		     (display "???")
+		     (output (markup-option c :number) e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-section-ref ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-section-ref
+   :action (lambda (n e)
+	      (let ((c (handle-ast (markup-body n))))
+		 (if (not (markup? c))
+		     (display "???")
+		     (output (markup-option c :title) e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &html-unmark-ref ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-unmark-ref
+   :action (lambda (n e)
+	      (let ((c (handle-ast (markup-body n))))
+		 (if (not (markup? c))
+		     (display "???")
+		     (let ((t (markup-option c :title)))
+			(if t
+			    (output t e)
+			    (let ((l (markup-option c :legend)))
+			       (if l
+				   (output t e)
+				   (display
+				    (string-canonicalize
+				     (markup-ident c)))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e) (output n e (markup-writer-get 'ref e)))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref+ ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref+
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e)
+	      (let loop ((rs (markup-body n)))
+		 (cond
+		    ((null? rs)
+		     #f)
+		    (else
+		     (if (is-markup? (car rs) 'bib-ref)
+			 (output (car rs) e (markup-writer-get 'ref e))
+			 (output (car rs) e))
+		     (if (pair? (cdr rs))
+			 (begin
+			    (display ",")
+			    (loop (cdr rs))))))))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    url-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :before (lambda (n e)
+	      (let* ((url (markup-option n :url))
+		     (class (cond
+			       ((markup-class n)
+				(markup-class n))
+			       ((not (string? url))
+				#f)
+			       (else
+				(let ((l (string-length url)))
+				   (let loop ((i 0))
+				      (cond
+					 ((= i l)
+					  #f)
+					 ((char=? (string-ref url i) #\:)
+					  (substring url 0 i))
+					 (else
+					  (loop (+ i 1))))))))))
+		 (display "<a href=\"")
+		 (output url html-title-engine)
+		 (display "\"")
+		 (when class (printf " class=\"~a\"" class))
+		 (display ">")))
+   :action (lambda (n e)
+	      (let ((v (markup-option n :text)))
+		 (output (or v (markup-option n :url)) e)))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    line-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+   :options '(:offset)
+   :before (html-markup-class "i")
+   :action (lambda (n e)
+	      (let ((o (markup-option n :offset))
+		    (v (string->number (markup-option n :text))))
+		 (if (and (number? o) (number? v))
+		     (markup-option-add! n :text (+ o v)))
+		 (output n e (markup-writer-get 'ref e))
+		 (if (and (number? o) (number? v))
+		     (markup-option-add! n :text v))))
+   :after "</i>")
+
+;*---------------------------------------------------------------------*/
+;*    page-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'page-ref
+   :options '(:mark :handle)
+   :action (lambda (n e)
+	      (error 'page-ref:html "Not implemented yet" n)))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-label ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before (lambda (n e)
+	      (printf "<a name=\"~a\"" (string-canonicalize (markup-ident n)))
+	      (html-class n)
+	      (display ">"))
+   :action (lambda (n e)
+	      (output n e (markup-writer-get '&bib-entry-label base-engine)))
+   :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-title ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+   :action (lambda (n e)
+	      (let* ((t (bold (markup-body n)))
+		     (en (handle-ast (ast-parent n)))
+		     (url (or (markup-option en 'url)
+			      (markup-option en 'documenturl)))
+		     (ht (if url (ref :url (markup-body url) :text t) t)))
+		 (skribe-eval ht e))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-url ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-url
+   :action (lambda (n e)
+	      (let* ((en (handle-ast (ast-parent n)))
+		     (url (markup-option en 'url))
+		     (t (bold (markup-body url))))
+		 (skribe-eval (ref :url (markup-body url) :text t) e))))
+
+;*---------------------------------------------------------------------*/
+;*    &the-index-header ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index-header
+   :action (lambda (n e)
+	      (display "<center")
+	      (html-class n)
+	      (display ">")
+	      (for-each (lambda (h)
+			   (let ((f (engine-custom e 'index-header-font-size)))
+			      (if f
+				  (skribe-eval (font :size f (bold (it h))) e)
+				  (output h e))
+			      (display " ")))
+			(markup-body n))
+	      (display "</center>")
+	      (skribe-eval (linebreak 2) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &source-comment ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (it (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-line-comment ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-line-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-keyword ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-keyword
+   :action (lambda (n e)
+	      (skribe-eval (bold (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &source-error ...                                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-error
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-error-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-define ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-define
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-define-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-module ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-module
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-module-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-markup ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-markup
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-markup-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-thread ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-thread
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-thread-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-string ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-string
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-string-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-bracket ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-bracket
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-bracket-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (bold n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-type ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-key ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-key
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-type ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg "red" (bold n1))
+			     (bold n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/src/guile/skribilo/engine/html4.scm b/src/guile/skribilo/engine/html4.scm
new file mode 100644
index 0000000..48550ef
--- /dev/null
+++ b/src/guile/skribilo/engine/html4.scm
@@ -0,0 +1,168 @@
+;;;;
+;;;; html4.skr				-- HTML 4.01 Engine
+;;;;
+;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;;; USA.
+;;;;
+;;;;           Author: Erick Gallesio [eg@essi.fr]
+;;;;    Creation date: 18-Feb-2004 11:58 (eg)
+;;;; Last file update: 26-Feb-2004 21:09 (eg)
+;;;;
+
+(define-skribe-module (skribilo engine html4))
+
+(define (find-children node)
+  (define (flat l)
+    (cond
+      ((null? l) l)
+      ((pair? l) (append (flat (car l))
+			 (flat (cdr l))))
+      (else      (list l))))
+
+  (if (markup? node)
+      (flat (markup-body node))
+      node))
+
+;;; ======================================================================
+
+(let ((le (find-engine 'html)))
+  ;;----------------------------------------------------------------------
+  ;;	Customizations
+  ;;----------------------------------------------------------------------
+  (engine-custom-set! le 'html-variant    "html4")
+  (engine-custom-set! le 'html4-logo      "http://www.w3.org/Icons/valid-html401")
+  (engine-custom-set! le 'html4-validator "http://validator.w3.org/check/referer")
+
+  ;;----------------------------------------------------------------------
+  ;;	&html-html ...
+  ;;----------------------------------------------------------------------
+  (markup-writer '&html-html le
+     :before "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+<html>\n"
+     :after "</html>")
+
+  ;;----------------------------------------------------------------------
+  ;;	&html-ending
+  ;;----------------------------------------------------------------------
+  (let* ((img (engine-custom le 'html4-logo))
+	 (url (engine-custom le 'html4-validator))
+	 (bottom (list (hrule)
+		      (table :width 100.
+			 (tr
+			    (td :align 'left
+			       (font :size -1 [
+				 This ,(sc "Html") page has been produced by
+				      ,(ref :url (skribe-url) :text "Skribe").
+				      ,(linebreak)
+				      Last update ,(it (date)).]))
+			    (td :align 'right :valign 'top
+			       (ref :url url
+				  :text (image :url img :width 88 :height 31))))))))
+    (markup-writer '&html-ending le
+       :before "<div class=\"skribe-ending\">"
+       :action (lambda (n e)
+		 (let ((body (markup-body n)))
+		   (if body
+		       (output body #t)
+		       (skribe-eval bottom e))))
+       :after "</div>\n"))
+
+  ;;----------------------------------------------------------------------
+  ;;	color ...
+  ;;----------------------------------------------------------------------
+  (markup-writer 'color le
+     :options '(:bg :fg :width :margin)
+     :before (lambda (n e)
+	       (let ((m    (markup-option n :margin))
+		     (w    (markup-option n :width))
+		     (bg   (markup-option n :bg))
+		     (fg   (markup-option n :fg)))
+		 (when bg
+		   (display "<table cellspacing=\"0\"")
+		   (html-class n)
+		   (printf " cellpadding=\"~a\"" (if m m 0))
+		   (if w (printf " width=\"~a\"" (html-width w)))
+		   (display "><tbody>\n<tr>")
+		   (display "<td bgcolor=\"")
+		   (output bg e)
+		   (display "\">"))
+		 (when fg
+		   (display "<span style=\"color:")
+		   (output fg e)
+		   (display ";\">"))))
+     :after (lambda (n e)
+	      (when (markup-option n :fg)
+		(display "</span>"))
+	      (when (markup-option n :bg)
+		(display "</td></tr>\n</tbody></table>"))))
+
+  ;;----------------------------------------------------------------------
+  ;;	font ...
+  ;;----------------------------------------------------------------------
+  (markup-writer 'font le
+     :options '(:size :face)
+     :before (lambda (n e)
+	       (let ((face (markup-option n :face))
+		     (size (let ((sz (markup-option n :size)))
+			     (cond
+			       ((or (unspecified? sz) (not sz))
+				#f)
+			       ((and (number? sz) (or (inexact? sz) (negative? sz)))
+				(format #f "~a%"
+					(+ 100
+					   (* 20 (inexact->exact (truncate sz))))))
+			       ((number? sz)
+				sz)
+			       (else
+				(skribe-error 'font
+					      (format #f
+						      "illegal font size ~s" sz)
+					      n))))))
+		 (display "<span ")
+		 (html-class n)
+		 (display "style=\"")
+		 (if size (printf "font-size: ~a; " size))
+		 (if face (printf "font-family:'~a'; " face))
+		 (display "\">")))
+     :after "</span>")
+
+  ;;----------------------------------------------------------------------
+  ;;	paragraph ...
+  ;;----------------------------------------------------------------------
+  (copy-markup-writer 'paragraph le
+     :validate (lambda (n e)
+		 (let ((pred (lambda (x)
+			       (and (container? x)
+				    (not (memq (markup-markup x) '(font color)))))))
+		   (not (any pred (find-children n))))))
+
+  ;;----------------------------------------------------------------------
+  ;;	roman ...
+  ;;----------------------------------------------------------------------
+  (markup-writer 'roman le
+     :before "<span style=\"font-family: serif\">"
+     :after "</span>")
+
+  ;;----------------------------------------------------------------------
+  ;;	table ...
+  ;;----------------------------------------------------------------------
+  (let ((old-writer (markup-writer-get 'table le)))
+    (copy-markup-writer 'table le
+	:validate (lambda (n e)
+		    (not (null? (markup-body n))))))
+)
diff --git a/src/guile/skribilo/engine/latex-simple.scm b/src/guile/skribilo/engine/latex-simple.scm
new file mode 100644
index 0000000..638c158
--- /dev/null
+++ b/src/guile/skribilo/engine/latex-simple.scm
@@ -0,0 +1,103 @@
+(define-skribe-module (skribilo engine latex-simple))
+
+;;;
+;;; LES CUSTOMS SONT TROP SPECIFIQUES POUR LA DISTRIBS. NE DOIT PAS VIRER
+;;; CE FICHIER (sion simplifie il ne rest plus grand chose)
+;;;		Erick 27-10-04
+;;;
+
+
+;*=====================================================================*/
+;*    scmws04/src/latex-style.skr                                      */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Damien Ciabrini                                   */
+;*    Creation    :  Tue Aug 24 19:17:04 2004                          */
+;*    Last change :  Thu Oct 28 21:45:25 2004 (eg)                     */
+;*    Copyright   :  2004 Damien Ciabrini, see LICENCE file            */
+;*    -------------------------------------------------------------    */
+;*    Custom style for Latex...                                        */
+;*=====================================================================*/
+
+(let* ((le (find-engine 'latex))
+       (oa (markup-writer-get 'author le)))
+   ; latex class & package for the workshop
+   (engine-custom-set! le 'documentclass "\\documentclass[letterpaper]{sigplan-proc}")
+   (engine-custom-set! le 'usepackage
+   "\\usepackage{epsfig}
+\\usepackage{workshop}
+\\conferenceinfo{Fifth Workshop on Scheme and Functional Programming.}
+	       {September 22, 2004, Snowbird, Utah, USA.}
+\\CopyrightYear{2004}
+\\CopyrightHolder{Damien Ciabrini}
+\\renewcommand{\\ttdefault}{cmtt}
+")
+   (engine-custom-set! le 'image-format '("eps"))
+   (engine-custom-set! le 'source-define-color "#000080")
+   (engine-custom-set! le 'source-thread-color "#8080f0")
+   (engine-custom-set! le 'source-string-color "#000000")
+
+   ; hyperref options
+   (engine-custom-set! le 'hyperref #t)
+   (engine-custom-set! le 'hyperref-usepackage
+   "\\usepackage[bookmarksopen=true, bookmarksopenlevel=2,bookmarksnumbered=true,colorlinks,linkcolor=blue,citecolor=blue,pdftitle={Debugging Scheme Fair Threads}, pdfsubject={debugging cooperative threads based on reactive programming}, pdfkeywords={debugger, functional, reactive programming, Scheme}, pdfauthor={Damien Ciabrini}]{hyperref}")
+   ; nbsp with ~ char
+   (set! latex-encoding (delete! (assoc #\~ latex-encoding) latex-encoding))
+
+   ; let latex process citations
+   (markup-writer 'bib-ref le
+      :options '(:text :bib)
+      :before "\\cite{"
+      :action (lambda (n e) (display (markup-option n :bib)))
+      :after "}")
+   (markup-writer 'bib-ref+ le
+      :options '(:text :bib)
+      :before "\\cite{"
+      :action (lambda (n e)
+		 (let loop ((bibs (markup-option n :bib)))
+		    (if (pair? bibs)
+			(begin
+			   (display (car bibs))
+			   (if (pair? (cdr bibs)) (display ", "))
+			   (loop (cdr bibs))))))
+      :after "}")
+   (markup-writer '&the-bibliography le
+      :action (lambda (n e)
+		 (print "\\bibliographystyle{abbrv}")
+		 (display "\\bibliography{biblio}")))
+
+   ; ACM-style for authors
+   (markup-writer '&latex-author le
+      :before (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (if (pair? body)
+			(print "\\numberofauthors{" (length body) "}"))
+		    (print "\\author{")))
+      :after "}\n")
+   (markup-writer 'author le
+      :options (writer-options oa)
+      :before ""
+      :action (lambda (n e)
+		 (let ((name (markup-option n :name))
+		       (affiliation (markup-option n :affiliation))
+		       (address (markup-option n :address))
+		       (email (markup-option n :email)))
+		    (define (row pre n post)
+		       (display pre)
+		       (output n e)
+		       (display post)
+		       (display "\\\\\n"))
+		    ;; name
+		    (if name (row "\\alignauthor " name ""))
+		    ;; affiliation
+		    (if affiliation (row "\\affaddr{" affiliation "}"))
+		    ;; address
+		    (if (pair? address)
+			(for-each (lambda (x)
+				     (row "\\affaddr{" x "}")) address))
+		    ;; email
+		    (if email (row "\\email{" email "}"))))
+      :after "")
+)
+
+(define (include-biblio)
+   (the-bibliography))
diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm
new file mode 100644
index 0000000..8d5b88f
--- /dev/null
+++ b/src/guile/skribilo/engine/latex.scm
@@ -0,0 +1,1784 @@
+;;; latex.scm  --  LaTeX engine.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo engine latex))
+
+;*---------------------------------------------------------------------*/
+;*    latex-verbatim-encoding ...                                      */
+;*---------------------------------------------------------------------*/
+(define latex-verbatim-encoding
+   '((#\\ "{\\char92}")
+     (#\^ "{\\char94}")
+     (#\{ "\\{")
+     (#\} "\\}")
+     (#\& "\\&")
+     (#\$ "\\$")
+     (#\# "\\#")
+     (#\_ "\\_")
+     (#\% "\\%")
+     (#\~ "$_{\\mbox{\\char126}}$")
+     (#\ç "\\c{c}")
+     (#\Ç "\\c{C}")
+     (#\â "\\^{a}")
+     (#\Â "\\^{A}")
+     (#\à "\\`{a}")
+     (#\À "\\`{A}")
+     (#\é "\\'{e}")
+     (#\É "\\'{E}")
+     (#\è "\\`{e}")
+     (#\È "\\`{E}")
+     (#\ê "\\^{e}")
+     (#\Ê "\\^{E}")
+     (#\ù "\\`{u}")
+     (#\Ù "\\`{U}")
+     (#\û "\\^{u}")
+     (#\Û "\\^{U}")
+     (#\ø "{\\o}")
+     (#\ô "\\^{o}")
+     (#\Ô "\\^{O}")
+     (#\ö "\\\"{o}")
+     (#\Ö "\\\"{O}")
+     (#\î "\\^{\\i}")
+     (#\Î "\\^{I}")
+     (#\ï "\\\"{\\i}")
+     (#\Ï "\\\"{I}")
+     (#\] "{\\char93}")
+     (#\[ "{\\char91}")
+     (#\» "\\,{\\tiny{$^{\\gg}$}}")
+     (#\« "{\\tiny{$^{\\ll}$}}\\,")))
+
+;*---------------------------------------------------------------------*/
+;*    latex-encoding ...                                               */
+;*---------------------------------------------------------------------*/
+(define latex-encoding
+   (append '((#\| "$|$")
+	     (#\< "$<$")
+	     (#\> "$>$")
+	     (#\: "{\\char58}")
+	     (#\# "{\\char35}")
+	     (#\Newline " %\n"))
+	   latex-verbatim-encoding))
+		  
+;*---------------------------------------------------------------------*/
+;*    latex-tt-encoding ...                                            */
+;*---------------------------------------------------------------------*/
+(define latex-tt-encoding
+   (append '((#\. ".\\-")
+	     (#\/ "/\\-"))
+	   latex-encoding))
+		  
+;*---------------------------------------------------------------------*/
+;*    latex-pre-encoding ...                                           */
+;*---------------------------------------------------------------------*/
+(define latex-pre-encoding
+   (append '((#\Space "\\ ")
+	     (#\Newline "\\\\\n"))
+	   latex-encoding))
+
+;*---------------------------------------------------------------------*/
+;*    latex-symbol-table ...                                           */
+;*---------------------------------------------------------------------*/
+(define (latex-symbol-table math)
+   `(("iexcl" "!`")
+     ("cent" "c")
+     ("pound" "\\pounds")
+     ("yen" "Y")
+     ("section" "\\S")
+     ("mul" ,(math "^-"))
+     ("copyright" "\\copyright")
+     ("lguillemet" ,(math "\\ll"))
+     ("not" ,(math "\\neg"))
+     ("degree" ,(math "^{\\small{o}}"))
+     ("plusminus" ,(math "\\pm"))
+     ("micro" ,(math "\\mu"))
+     ("paragraph" "\\P")
+     ("middot" ,(math "\\cdot"))
+     ("rguillemet" ,(math "\\gg"))
+     ("1/4" ,(math "\\frac{1}{4}"))
+     ("1/2" ,(math "\\frac{1}{2}"))
+     ("3/4" ,(math "\\frac{3}{4}"))
+     ("iquestion" "?`")
+     ("Agrave" "\\`{A}")
+     ("Aacute" "\\'{A}")
+     ("Acircumflex" "\\^{A}")
+     ("Atilde" "\\~{A}")
+     ("Amul" "\\\"{A}")
+     ("Aring" "{\\AA}")
+     ("AEligature" "{\\AE}")
+     ("Oeligature" "{\\OE}")
+     ("Ccedilla" "{\\c{C}}")
+     ("Egrave" "{\\`{E}}")
+     ("Eacute" "{\\'{E}}")
+     ("Ecircumflex" "{\\^{E}}")
+     ("Euml" "\\\"{E}")
+     ("Igrave" "{\\`{I}}")
+     ("Iacute" "{\\'{I}}")
+     ("Icircumflex" "{\\^{I}}")
+     ("Iuml" "\\\"{I}")
+     ("ETH" "D")
+     ("Ntilde" "\\~{N}")
+     ("Ograve" "\\`{O}")
+     ("Oacute" "\\'{O}")
+     ("Ocurcumflex" "\\^{O}")
+     ("Otilde" "\\~{O}")
+     ("Ouml" "\\\"{O}")
+     ("times" ,(math "\\times"))
+     ("Oslash" "\\O")
+     ("Ugrave" "\\`{U}")
+     ("Uacute" "\\'{U}")
+     ("Ucircumflex" "\\^{U}")
+     ("Uuml" "\\\"{U}")
+     ("Yacute" "\\'{Y}")
+     ("szlig" "\\ss")
+     ("agrave" "\\`{a}")
+     ("aacute" "\\'{a}")
+     ("acircumflex" "\\^{a}")
+     ("atilde" "\\~{a}")
+     ("amul" "\\\"{a}")
+     ("aring" "\\aa")
+     ("aeligature" "\\ae")
+     ("oeligature" "{\\oe}")
+     ("ccedilla" "{\\c{c}}")
+     ("egrave" "{\\`{e}}")
+     ("eacute" "{\\'{e}}")
+     ("ecircumflex" "{\\^{e}}")
+     ("euml" "\\\"{e}")
+     ("igrave" "{\\`{\\i}}")
+     ("iacute" "{\\'{\\i}}")
+     ("icircumflex" "{\\^{\\i}}")
+     ("iuml" "\\\"{\\i}")
+     ("ntilde" "\\~{n}")
+     ("ograve" "\\`{o}")
+     ("oacute" "\\'{o}")
+     ("ocurcumflex" "\\^{o}")
+     ("otilde" "\\~{o}")
+     ("ouml" "\\\"{o}")
+     ("divide" ,(math "\\div"))
+     ("oslash" "\\o")
+     ("ugrave" "\\`{u}")
+     ("uacute" "\\'{u}")
+     ("ucircumflex" "\\^{u}")
+     ("uuml" "\\\"{u}")
+     ("yacute" "\\'{y}")
+     ("ymul" "\\\"{y}")
+     ;; Greek
+     ("Alpha" "A")
+     ("Beta" "B")
+     ("Gamma" ,(math "\\Gamma"))
+     ("Delta" ,(math "\\Delta"))
+     ("Epsilon" "E")
+     ("Zeta" "Z")
+     ("Eta" "H")
+     ("Theta" ,(math "\\Theta"))
+     ("Iota" "I")
+     ("Kappa" "K")
+     ("Lambda" ,(math "\\Lambda"))
+     ("Mu" "M")
+     ("Nu" "N")
+     ("Xi" ,(math "\\Xi"))
+     ("Omicron" "O")
+     ("Pi" ,(math "\\Pi"))
+     ("Rho" "P")
+     ("Sigma" ,(math "\\Sigma"))
+     ("Tau" "T")
+     ("Upsilon" ,(math "\\Upsilon"))
+     ("Phi" ,(math "\\Phi"))
+     ("Chi" "X")
+     ("Psi" ,(math "\\Psi"))
+     ("Omega" ,(math "\\Omega"))
+     ("alpha" ,(math "\\alpha"))
+     ("beta" ,(math "\\beta"))
+     ("gamma" ,(math "\\gamma"))
+     ("delta" ,(math "\\delta"))
+     ("epsilon" ,(math "\\varepsilon"))
+     ("zeta" ,(math "\\zeta"))
+     ("eta" ,(math "\\eta"))
+     ("theta" ,(math "\\theta"))
+     ("iota" ,(math "\\iota"))
+     ("kappa" ,(math "\\kappa"))
+     ("lambda" ,(math "\\lambda"))
+     ("mu" ,(math "\\mu"))
+     ("nu" ,(math "\\nu"))
+     ("xi" ,(math "\\xi"))
+     ("omicron" ,(math "\\o"))
+     ("pi" ,(math "\\pi"))
+     ("rho" ,(math "\\rho"))
+     ("sigmaf" ,(math "\\varsigma"))
+     ("sigma" ,(math "\\sigma"))
+     ("tau" ,(math "\\tau"))
+     ("upsilon" ,(math "\\upsilon"))
+     ("phi" ,(math "\\varphi"))
+     ("chi" ,(math "\\chi"))
+     ("psi" ,(math "\\psi"))
+     ("omega" ,(math "\\omega"))
+     ("thetasym" ,(math "\\vartheta"))
+     ("piv" ,(math "\\varpi"))
+     ;; punctuation
+     ("bullet" ,(math "\\bullet"))
+     ("ellipsis" ,(math "\\ldots"))
+     ("weierp" ,(math "\\wp"))
+     ("image" ,(math "\\Im"))
+     ("real" ,(math "\\Re"))
+     ("tm" ,(math "^{\\sc\\tiny{tm}}"))
+     ("alef" ,(math "\\aleph"))
+     ("<-" ,(math "\\leftarrow"))
+     ("<--" ,(math "\\longleftarrow"))
+     ("uparrow" ,(math "\\uparrow"))
+     ("->" ,(math "\\rightarrow"))
+     ("-->" ,(math "\\longrightarrow"))
+     ("downarrow" ,(math "\\downarrow"))
+     ("<->" ,(math "\\leftrightarrow"))
+     ("<-->" ,(math "\\longleftrightarrow"))
+     ("<+" ,(math "\\hookleftarrow"))
+     ("<=" ,(math "\\Leftarrow"))
+     ("<==" ,(math "\\Longleftarrow"))
+     ("Uparrow" ,(math "\\Uparrow"))
+     ("=>" ,(math "\\Rightarrow"))
+     ("==>" ,(math "\\Longrightarrow"))
+     ("Downarrow" ,(math "\\Downarrow"))
+     ("<=>" ,(math "\\Leftrightarrow"))
+     ("<==>" ,(math "\\Longleftrightarrow"))
+     ;; Mathematical operators
+     ("forall" ,(math "\\forall"))
+     ("partial" ,(math "\\partial"))
+     ("exists" ,(math "\\exists"))
+     ("emptyset" ,(math "\\emptyset"))
+     ("infinity" ,(math "\\infty"))
+     ("nabla" ,(math "\\nabla"))
+     ("in" ,(math "\\in"))
+     ("notin" ,(math "\\notin"))
+     ("ni" ,(math "\\ni"))
+     ("prod" ,(math "\\Pi"))
+     ("sum" ,(math "\\Sigma"))
+     ("asterisk" ,(math "\\ast"))
+     ("sqrt" ,(math "\\surd"))
+     ("propto" ,(math "\\propto"))
+     ("angle" ,(math "\\angle"))
+     ("and" ,(math "\\wedge"))
+     ("or" ,(math "\\vee"))
+     ("cap" ,(math "\\cap"))
+     ("cup" ,(math "\\cup"))
+     ("integral" ,(math "\\int"))
+     ("models" ,(math "\\models"))
+     ("vdash" ,(math "\\vdash"))
+     ("dashv" ,(math "\\dashv"))
+     ("sim" ,(math "\\sim"))
+     ("cong" ,(math "\\cong"))
+     ("approx" ,(math "\\approx"))
+     ("neq" ,(math "\\neq"))
+     ("equiv" ,(math "\\equiv"))
+     ("le" ,(math "\\leq"))
+     ("ge" ,(math "\\geq"))
+     ("subset" ,(math "\\subset"))
+     ("supset" ,(math "\\supset"))
+     ("subseteq" ,(math "\\subseteq"))
+     ("supseteq" ,(math "\\supseteq"))
+     ("oplus" ,(math "\\oplus"))
+     ("otimes" ,(math "\\otimes"))
+     ("perp" ,(math "\\perp"))
+     ("mid" ,(math "\\mid"))
+     ("lceil" ,(math "\\lceil"))
+     ("rceil" ,(math "\\rceil"))
+     ("lfloor" ,(math "\\lfloor"))
+     ("rfloor" ,(math "\\rfloor"))
+     ("langle" ,(math "\\langle"))
+     ("rangle" ,(math "\\rangle"))
+     ;; Misc
+     ("loz" ,(math "\\diamond"))
+     ("spades" ,(math "\\spadesuit"))
+     ("clubs" ,(math "\\clubsuit"))
+     ("hearts" ,(math "\\heartsuit"))
+     ("diams" ,(math "\\diamondsuit"))
+     ("euro" "\\euro{}")
+     ;; LaTeX
+     ("dag" "\\dag")
+     ("ddag" "\\ddag")
+     ("circ" ,(math "\\circ"))
+     ("top" ,(math "\\top"))
+     ("bottom" ,(math "\\bot"))
+     ("lhd" ,(math "\\triangleleft"))
+     ("rhd" ,(math "\\triangleright"))
+     ("parallel" ,(math "\\parallel"))))
+
+;*---------------------------------------------------------------------*/
+;*    latex-engine ...                                                 */
+;*---------------------------------------------------------------------*/
+(define latex-engine
+   (default-engine-set!
+      (make-engine 'latex
+	 :version 1.0
+	 :format "latex"
+	 :delegate (find-engine 'base)
+	 :filter (make-string-replace latex-encoding)
+	 :custom '((documentclass "\\documentclass{article}")
+		   (usepackage "\\usepackage{epsfig}\n")
+		   (predocument "\\newdimen\\oldframetabcolsep\n\\newdimen\\oldcolortabcolsep\n\\newdimen\\oldpretabcolsep\n")
+		   (postdocument #f)
+		   (maketitle "\\date{}\n\\maketitle")
+		   (%font-size 0)
+		   ;; color
+		   (color #t)
+		   (color-usepackage "\\usepackage{color}\n")
+		   ;; hyperref
+		   (hyperref #t)
+		   (hyperref-usepackage "\\usepackage[setpagesize=false]{hyperref}\n")
+		   ;; source fontification
+		   (source-color #t)
+		   (source-comment-color "#ffa600")
+		   (source-error-color "red")
+		   (source-define-color "#6959cf")
+		   (source-module-color "#1919af")
+		   (source-markup-color "#1919af")
+		   (source-thread-color "#ad4386")
+		   (source-string-color "red")
+		   (source-bracket-color "red")
+		   (source-type-color "#00cf00")
+		   (image-format ("eps"))
+		   (index-page-ref #t))
+	 :symbol-table (latex-symbol-table 
+			(lambda (m)
+			   (format #f "\\begin{math}~a\\end{math}" m))))))
+
+;*---------------------------------------------------------------------*/
+;*    latex-title-engine ...                                           */
+;*---------------------------------------------------------------------*/
+(define latex-title-engine
+   (make-engine 'latex-title
+      :version 1.0
+      :format "latex-title"
+      :delegate latex-engine
+      :filter (make-string-replace latex-encoding)
+      :symbol-table (latex-symbol-table (lambda (m) (format #f "$~a$" m)))))
+
+;*---------------------------------------------------------------------*/
+;*    latex-color? ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (latex-color? e)
+   (engine-custom e 'color))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (LaTeX #!key (space #t))
+   (if (engine-format? "latex")
+       (! (if space "\\LaTeX\\ " "\\LaTeX"))
+       "LaTeX"))
+
+;*---------------------------------------------------------------------*/
+;*    TeX ...                                                          */
+;*---------------------------------------------------------------------*/
+(define-markup (TeX #!key (space #t))
+   (if (engine-format? "latex")
+       (! (if space "\\TeX\\ " "\\TeX"))
+       "TeX"))
+
+;*---------------------------------------------------------------------*/
+;*    latex ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (!latex fmt #!rest opt)
+   (if (engine-format? "latex")
+       (apply ! fmt opt)
+       #f))
+   
+;*---------------------------------------------------------------------*/
+;*    latex-width ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (latex-width width)
+   (if (and (number? width) (inexact? width))
+       (string-append (number->string (/ width 100.)) "\\linewidth")
+       (string-append (number->string width) "pt")))
+
+;*---------------------------------------------------------------------*/
+;*    latex-font-size ...                                              */
+;*---------------------------------------------------------------------*/
+(define (latex-font-size size)
+   (case size
+      ((4) "Huge")
+      ((3) "huge")
+      ((2) "Large")
+      ((1) "large")
+      ((0) "normalsize")
+      ((-1) "small")
+      ((-2) "footnotesize")
+      ((-3) "scriptsize")
+      ((-4) "tiny")
+      (else (if (number? size)
+		(if (< size 0) "tiny" "Huge")
+		"normalsize"))))
+
+;*---------------------------------------------------------------------*/
+;*    *skribe-latex-color-table* ...                                   */
+;*---------------------------------------------------------------------*/
+(define *skribe-latex-color-table* #f)
+
+;*---------------------------------------------------------------------*/
+;*    latex-declare-color ...                                          */
+;*---------------------------------------------------------------------*/
+(define (latex-declare-color name rgb)
+   (printf "\\definecolor{~a}{rgb}{~a}\n" name rgb))
+
+;*---------------------------------------------------------------------*/
+;*    skribe-get-latex-color ...                                       */
+;*---------------------------------------------------------------------*/
+(define (skribe-get-latex-color spec)
+   (let ((c (and (hashtable? *skribe-latex-color-table*)
+		 (hashtable-get *skribe-latex-color-table* spec))))
+      (if (not (string? c))
+	  (skribe-error 'latex "Can't find color" spec)
+	  c)))
+
+;*---------------------------------------------------------------------*/
+;*    skribe-color->latex-rgb ...                                      */
+;*---------------------------------------------------------------------*/
+(define (skribe-color->latex-rgb spec)
+   (receive (r g b)
+      (skribe-color->rgb spec)
+      (cond
+	 ((and (= r 0) (= g 0) (= b 0))
+	  "0.,0.,0.")
+	 ((and (= r #xff) (= g #xff) (= b #xff))
+	  "1.,1.,1.")
+	 (else
+	  (let ((ff (exact->inexact #xff)))
+	    (format #f "~a,~a,~a"
+		    (number->string (/ r ff))
+		    (number->string (/ g ff))
+		    (number->string (/ b ff))))))))
+
+;*---------------------------------------------------------------------*/
+;*    skribe-latex-declare-colors ...                                  */
+;*---------------------------------------------------------------------*/
+(define (skribe-latex-declare-colors colors)
+   (set! *skribe-latex-color-table* (make-hashtable))
+   (for-each (lambda (spec)
+		(let ((old (hashtable-get *skribe-latex-color-table* spec)))
+		   (if (not (string? old))
+		       (let ((name (symbol->string (gensym 'c))))
+			  ;; bind the color 
+			  (hashtable-put! *skribe-latex-color-table* spec name)
+			  ;; and emit a latex declaration
+			  (latex-declare-color 
+			   name 
+			   (skribe-color->latex-rgb spec))))))
+	     colors))
+
+;*---------------------------------------------------------------------*/
+;*    ~ ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer '~
+   :before "~"
+   :action #f)
+
+;*---------------------------------------------------------------------*/
+;*    &latex-table-start                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-start
+   :options '()
+   :action (lambda (n e)
+	      (let ((width (markup-option n 'width)))
+		 (if (number? width)
+		     (printf "\\begin{tabular*}{~a}" (latex-width width))
+		     (display "\\begin{tabular}")))))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-table-stop                                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-stop
+   :options '()
+   :action (lambda (n e)
+	      (let ((width (markup-option n 'width)))
+		 (if (number? width)
+		 (display "\\end{tabular*}\n")
+		 (display "\\end{tabular}\n")))))
+   
+;*---------------------------------------------------------------------*/
+;*    document ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+   :options '(:title :author :ending :env)
+   :before (lambda (n e)
+	      ;; documentclass
+	      (let ((dc (engine-custom e 'documentclass)))
+		 (if dc
+		     (begin (display dc) (newline))
+		     (display "\\documentclass{article}\n")))
+	      (if (latex-color? e)
+		  (display (engine-custom e 'color-usepackage)))
+	      (if (engine-custom e 'hyperref)
+		  (display (engine-custom e 'hyperref-usepackage)))
+	      ;; usepackage
+	      (let ((pa (engine-custom e 'usepackage)))
+		 (if pa (begin (display pa) (newline))))
+	      ;; colors
+	      (if (latex-color? e)
+		  (begin
+		     (skribe-use-color! (engine-custom e 'source-comment-color))
+		     (skribe-use-color! (engine-custom e 'source-define-color))
+		     (skribe-use-color! (engine-custom e 'source-module-color))
+		     (skribe-use-color! (engine-custom e 'source-markup-color))
+		     (skribe-use-color! (engine-custom e 'source-thread-color))
+		     (skribe-use-color! (engine-custom e 'source-string-color))
+		     (skribe-use-color! (engine-custom e 'source-bracket-color))
+		     (skribe-use-color! (engine-custom e 'source-type-color))
+		     (display "\n%% colors\n")
+		     (skribe-latex-declare-colors (skribe-get-used-colors))
+		     (display "\n\n")))
+	      ;; predocument
+	      (let ((pd (engine-custom e 'predocument)))
+		 (when pd (display pd) (newline)))
+	      ;; title
+	      (let ((t (markup-option n :title)))
+		 (when t
+		    (skribe-eval (new markup
+				    (markup '&latex-title)
+				    (body t))
+				 e
+				 :env `((parent ,n)))))
+	      ;; author
+	      (let ((a (markup-option n :author)))
+		 (when a
+		    (skribe-eval (new markup
+				    (markup '&latex-author)
+				    (body a))
+				 e
+				 :env `((parent ,n)))))
+	      ;; document
+	      (display "\\begin{document}\n")
+	      ;; postdocument
+	      (let ((pd (engine-custom e 'postdocument)))
+		 (if pd (begin (display pd) (newline))))
+	      ;; maketitle
+	      (let ((mt (engine-custom e 'maketitle)))
+		 (if mt (begin (display mt) (newline)))))
+   :action (lambda (n e)
+	      (output (markup-body n) e))
+   :after (lambda (n e)
+	     (display "\n\\end{document}\n")))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-title ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-title
+   :before "\\title{"
+   :after "}\n")
+
+;*---------------------------------------------------------------------*/
+;*    &latex-author ...                                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-author
+   :before "\\author{\\centerline{\n"
+   :action (lambda (n e)
+	      (let ((body (markup-body n)))
+		 (if (pair? body)
+		     (begin
+			(output (new markup
+				   (markup '&latex-table-start)
+				   (class "&latex-author-table"))
+				e)
+			(printf "{~a}\n" (make-string (length body) #\c))
+			(let loop ((as body))
+			   (output (car as) e)
+			   (if (pair? (cdr as))
+			       (begin
+				  (display " & ")
+				  (loop (cdr as)))))
+			(display "\\\\\n")
+			(output (new markup
+				   (markup '&latex-table-stop)
+				   (class "&latex-author-table"))
+				e))
+		     (output body e))))
+   :after "}}\n")
+		 
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :before (lambda (n e)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "author"))
+		      e)
+	      (printf "{~a}\n"
+		      (case (markup-option n :align)
+			 ((left) "l")
+			 ((right) "r")
+			 (else "c"))))
+   :action (lambda (n e)
+	      (let ((name (markup-option n :name))
+		    (title (markup-option n :title))
+		    (affiliation (markup-option n :affiliation))
+		    (email (markup-option n :email))
+		    (url (markup-option n :url))
+		    (address (markup-option n :address))
+		    (phone (markup-option n :phone)))
+		 (define (row n)
+		    (output n e)
+		    (display "\\\\\n"))
+		 ;; name
+		 (if name (row name))
+		 ;; title
+		 (if title (row title))
+		 ;; affiliation
+		 (if affiliation (row affiliation))
+		 ;; address
+		 (cond
+		    ((pair? address)
+		     (for-each row address))
+		    ((string? address)
+		     (row address)))
+		 ;; telephone
+		 (if phone (row phone))
+		 ;; email
+		 (if email (row email))
+		 ;; url
+		 (if url (row url))))
+   :after (lambda (n e)
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "author"))
+		     e)))
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+   :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+   :predicate (lambda (n e) (markup-option n :photo))
+   :before (lambda (n e)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "author"))
+		      e)
+	      (printf "{cc}\n"))
+   :action (lambda (n e)
+	      (let ((photo (markup-option n :photo)))
+		 (output photo e)
+		 (display " & ")
+		 (markup-option-add! n :photo #f)
+		 (output n e)
+		 (markup-option-add! n :photo photo)
+		 (display "\\\\\n")))
+   :after (lambda (n e)
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "author"))
+		     e)))
+
+;*---------------------------------------------------------------------*/
+;*    toc ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'toc
+   :options '()
+   :action (lambda (n e) (display "\\tableofcontents\n")))
+
+;*---------------------------------------------------------------------*/
+;*    latex-block-before ...                                           */
+;*---------------------------------------------------------------------*/
+(define (latex-block-before m)
+   (lambda (n e)
+      (let ((num (markup-option n :number)))
+	 (printf "\n\n%% ~a\n" (string-canonicalize (markup-ident n)))
+	 (printf "\\~a~a{" m (if (not num) "*" ""))
+	 (output (markup-option n :title) latex-title-engine)
+	 (display "}\n")
+	 (when num
+	    (printf "\\label{~a}\n" (string-canonicalize (markup-ident n)))))))
+
+;*---------------------------------------------------------------------*/
+;*    section ... .. @label chapter@                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'chapter
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'chapter))
+
+;*---------------------------------------------------------------------*/
+;*    section ... . @label section@                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'section
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'section))
+
+;*---------------------------------------------------------------------*/
+;*    subsection ... @label subsection@                                */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsection
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'subsection))
+
+;*---------------------------------------------------------------------*/
+;*    subsubsection ... @label subsubsection@                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsubsection
+   :options '(:title :number :toc :file :env)
+   :before (latex-block-before 'subsubsection))
+
+;*---------------------------------------------------------------------*/
+;*    paragraph ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'paragraph
+   :options '(:title :number :toc :env)
+   :before (lambda (n e)
+	      (when (and (>= (skribe-debug) 2) (location? (ast-loc n)))
+		 (printf "\n\\makebox[\\linewidth][l]{\\hspace{-1.5cm}\\footnotesize{$\\triangleright$\\textit{~a}}}\n" 
+			 (ast-location n)))
+	      (display "\\noindent "))
+   :after "\\par\n")
+
+;*---------------------------------------------------------------------*/
+;*    footnote ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'footnote
+   :before "\\footnote{"
+   :after "}")
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'linebreak
+   :action (lambda (n e)
+	      (display "\\makebox[\\linewidth]{}")))
+
+;*---------------------------------------------------------------------*/
+;*    hrule ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'hrule 
+   :options '()
+   :before "\\hrulefill"
+   :action #f)
+
+;*---------------------------------------------------------------------*/
+;*    latex-color-counter                                              */
+;*---------------------------------------------------------------------*/
+(define latex-color-counter 1)
+
+;*---------------------------------------------------------------------*/
+;*    latex-color ...                                                  */
+;*---------------------------------------------------------------------*/
+(define latex-color 
+   (lambda (bg fg n e)
+      (if (not (latex-color? e))
+	  (output n e)
+	  (begin
+	     (if bg
+		 (printf "\\setbox~a \\vbox \\bgroup " latex-color-counter))
+	     (set! latex-color-counter (+ latex-color-counter 1))
+	     (if fg
+		 (begin
+		    (printf "\\textcolor{~a}{" (skribe-get-latex-color fg))
+		    (output n e)
+		    (display "}"))
+		 (output n e))
+	     (set! latex-color-counter (- latex-color-counter 1))
+	     (if bg
+		 (printf "\\egroup\\colorbox{~a}{\\box~a}%\n"
+			 (skribe-get-latex-color bg) latex-color-counter))))))
+   
+;*---------------------------------------------------------------------*/
+;*    color ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'color
+   :options '(:bg :fg :width)
+   :action (lambda (n e) 
+	      (let* ((w (markup-option n :width))
+		     (bg (markup-option n :bg))
+		     (fg (markup-option n :fg))
+		     (m (markup-option n :margin))
+		     (tw (cond
+			    ((not w)
+			     #f)
+			    ((and (integer? w) (exact? w))
+			     w)
+			    ((real? w)
+			     (latex-width w)))))
+		 (when bg 
+		    (display "\\setlength{\\oldcolortabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n")
+		    (when m
+		       (printf "\\addtolength{\\tabcolsep}{~a}" 
+			       (latex-width m)))
+		    (output (new markup
+			       (markup '&latex-table-start)
+			       (class "color"))
+			    e)
+		    (if tw
+			(printf "{p{~a}}\n" tw)
+			(printf "{l}\n")))
+		 (latex-color bg fg (markup-body n) e)
+		 (when bg 
+		    (output (new markup
+			       (markup '&latex-table-stop)
+			       (class "color"))
+			    e)
+		    (display "\\setlength{\\tabcolsep}{\\oldcolortabcolsep}\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'frame
+   :options '(:width :border :margin)
+   :before (lambda (n e)
+	      (display "\\setlength{\\oldframetabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}")
+	      (let ((m (markup-option n :margin)))
+		 (when m
+		    (printf "\\addtolength{\\tabcolsep}{~a}" (latex-width m))))
+	      (newline))
+   :action (lambda (n e) 
+	      (let* ((b (markup-option n :border))
+		     (w (markup-option n :width))
+		     (tw (cond
+			    ((not w)
+			     ".96\\linewidth")
+			    ((and (integer? w) (exact? w))
+			     w)
+			    ((real? w)
+			     (latex-width w)))))
+		 (output (new markup
+			    (markup '&latex-table-start)
+			    (class "frame"))
+			 e)
+		 (if (and (integer? b) (> b 0))
+		     (begin
+			(printf "{|p{~a}|}\\hline\n" tw)
+			(output (markup-body n) e)
+			(display "\\\\\\hline\n"))
+		     (begin
+			(printf "{p{~a}}\n" tw)
+			(output (markup-body n) e)))
+		 (output (new markup
+			    (markup '&latex-table-stop)
+			    (class "author"))
+			 e)))
+   :after "\\setlength{\\tabcolsep}{\\oldframetabcolsep}\n")
+
+;*---------------------------------------------------------------------*/
+;*    font ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'font
+   :options '(:size)
+   :action (lambda (n e) 
+	      (let* ((size (markup-option n :size))
+		     (cs (let ((n (engine-custom e '%font-size)))
+			    (if (number? n)
+				n 
+				0)))
+		     (ns (cond
+			    ((and (integer? size) (exact? size))
+			     (if (> size 0)
+				 size
+				 (+ cs size)))
+			    ((and (number? size) (inexact? size))
+			     (+ cs (inexact->exact size)))
+			    ((string? size)
+			     (let ((nb (string->number size)))
+				(if (not (number? nb))
+				    (skribe-error 
+				     'font
+				     (format #f "Illegal font size ~s" size)
+				     nb)
+				    (+ cs nb))))))
+		     (ne (make-engine (gensym 'latex)
+				      :delegate e
+				      :filter (engine-filter e)
+				      :symbol-table (engine-symbol-table e)
+				      :custom `((%font-size ,ns)
+						,@(engine-customs e)))))
+		 (printf "{\\~a{" (latex-font-size ns))
+		 (output (markup-body n) ne)
+		 (display "}}"))))
+
+;*---------------------------------------------------------------------*/
+;*    flush ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'flush
+   :options '(:side)
+   :before (lambda (n e)
+	      (case (markup-option n :side)
+		 ((center)
+		  (display "\\begin{center}\n"))
+		 ((left)
+		  (display "\\begin{flushleft}"))
+		 ((right)
+		  (display "\\begin{flushright}"))))
+   :after (lambda (n e)
+	     (case (markup-option n :side)
+		((center)
+		 (display "\\end{center}\n"))
+		((left)
+		 (display "\\end{flushleft}\n"))
+		((right)
+		 (display "\\end{flushright}\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+   :before "\\begin{center}\n"
+   :after "\\end{center}\n")
+
+;*---------------------------------------------------------------------*/
+;*    pre ...                                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'pre
+   :before (lambda (n e)
+	      (printf "\\setlength{\\oldpretabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n{\\setbox~a \\vbox \n\\bgroup\n{\\noindent \\texttt{"
+		      latex-color-counter)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "pre"))
+		      e)
+	      (display "{l}\n")
+	      (set! latex-color-counter (+ latex-color-counter 1)))
+   :action (lambda (n e)
+	      (let ((ne (make-engine
+			   (gensym 'latex)
+			   :delegate e
+			   :filter (make-string-replace latex-pre-encoding)
+			   :symbol-table (engine-symbol-table e)
+			   :custom (engine-customs e))))
+		 (output (markup-body n) ne)))
+   :after (lambda (n e)
+	     (set! latex-color-counter (- latex-color-counter 1))
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "pre"))
+		     e)
+	     (printf "}}\n\\egroup{\\box~a}}%\n\\setlength{\\tabcolsep}{\\oldpretabcolsep}\n" latex-color-counter)))
+
+;*---------------------------------------------------------------------*/
+;*    prog ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'prog
+   :options '(:line :mark)
+   :before (lambda (n e)
+	      (printf "\\setlength{\\oldpretabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n{\\setbox~a \\vbox \\bgroup\n{\\noindent \\texttt{"
+		      latex-color-counter)
+	      (output (new markup
+			 (markup '&latex-table-start)
+			 (class "pre"))
+		      e)
+	      (display "{l}\n")
+	      (set! latex-color-counter (+ latex-color-counter 1)))
+   :action (lambda (n e)
+	      (let ((ne (make-engine
+			   (gensym 'latex)
+			   :delegate e
+			   :filter (make-string-replace latex-pre-encoding)
+			   :symbol-table (engine-symbol-table e)
+			   :custom (engine-customs e))))
+		 (output (markup-body n) ne)))
+   :after (lambda (n e)
+	     (set! latex-color-counter (- latex-color-counter 1))
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "prog"))
+		     e)
+	     (printf "}}\n\\egroup{\\box~a}}%\n\\setlength{\\tabcolsep}{\\oldpretabcolsep}\n" latex-color-counter)))
+
+;*---------------------------------------------------------------------*/
+;*    &prog-line ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&prog-line
+   :before (lambda (n e)
+	      (let ((n (markup-ident n)))
+		 (if n (skribe-eval (it (list n) ": ") e))))
+   :after "\\\\\n")
+
+;*---------------------------------------------------------------------*/
+;*    itemize ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'itemize
+   :options '(:symbol)	       
+   :before "\\begin{itemize}\n"
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display " \\item ")
+			   (output item e)
+			   (newline))
+			(markup-body n)))
+   :after "\\end{itemize} ")
+
+(markup-writer 'itemize
+   :predicate (lambda (n e) (markup-option n :symbol))
+   :options '(:symbol)	       
+   :before (lambda (n e)
+	      (display "\\begin{list}{")
+	      (output (markup-option n :symbol) e)
+	      (display "}{}")
+	      (newline))
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display " \\item ")
+			   (output item e)
+			   (newline))
+			(markup-body n)))
+   :after "\\end{list}\n")
+
+;*---------------------------------------------------------------------*/
+;*    enumerate ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'enumerate
+   :options '(:symbol)	       
+   :before "\\begin{enumerate}\n"
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (display " \\item ")
+			   (output item e)
+			   (newline))
+			(markup-body n)))
+   :after "\\end{enumerate}\n")
+
+;*---------------------------------------------------------------------*/
+;*    description ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'description
+   :options '(:symbol)	       
+   :before "\\begin{description}\n"
+   :action (lambda (n e)
+	      (for-each (lambda (item)
+			   (let ((k (markup-option item :key)))
+			      (for-each (lambda (i)
+					   (display " \\item[")
+					   (output i e)
+					   (display "]\n"))
+					(if (pair? k) k (list k)))
+			      (output (markup-body item) e)))
+			(markup-body n)))
+   :after "\\end{description}\n")
+
+;*---------------------------------------------------------------------*/
+;*    item ...                                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer 'item
+   :options '(:key)	       
+   :action (lambda (n e)
+	      (let ((k (markup-option n :key)))
+		 (if k
+		     (begin
+			(display "[")
+			(output k e)
+			(display "] "))))
+	      (output (markup-body n) e)))
+
+;*---------------------------------------------------------------------*/
+;*    blockquote ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer 'blockquote
+   :before "\n\\begin{quote}\n"
+   :after  "\n\\end{quote}")
+
+;*---------------------------------------------------------------------*/
+;*    figure ... @label figure@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'figure
+   :options '(:legend :number :multicolumns)
+   :action (lambda (n e)
+	      (let ((ident (markup-ident n))
+		    (number (markup-option n :number))
+		    (legend (markup-option n :legend))
+		    (mc (markup-option n :multicolumns)))
+		 (display (if mc
+			      "\\begin{figure*}[!th]\n"
+			      "\\begin{figure}[ht]\n"))
+		 (output (markup-body n) e)
+		 (printf "\\caption{\\label{~a}" (string-canonicalize ident))
+		 (output legend e)
+		 (display (if mc
+			      "}\\end{figure*}\n"
+			      "}\\end{figure}\n")))))
+
+;*---------------------------------------------------------------------*/
+;*    table-column-number ...                                          */
+;*    -------------------------------------------------------------    */
+;*    Computes how many columns are contained in a table.              */
+;*---------------------------------------------------------------------*/
+(define (table-column-number t)
+   (define (row-columns row)
+      (let luup ((cells (markup-body row))
+		 (nbcols 0))
+	 (cond
+	   ((null? cells)
+	     nbcols)
+	   ((pair? cells)
+	    (luup (cdr cells)
+		  (+ nbcols (markup-option (car cells) :colspan))))
+	   (else
+	    (skribe-type-error 'tr "Illegal tr body, " row "pair")))))
+   (let loop ((rows (markup-body t))
+	      (nbcols 0))
+      (if (null? rows)
+	  nbcols
+	  (loop (cdr rows)
+		(max (row-columns (car rows)) nbcols)))))
+
+;*---------------------------------------------------------------------*/
+;*    table ...                                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'table
+   :options '(:width :frame :rules :cellstyle)
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (frame (markup-option n :frame))
+		    (rules (markup-option n :rules))
+		    (cstyle (markup-option n :cellstyle))
+		    (nbcols (table-column-number n))
+		    (id (markup-ident n))
+		    (cla (markup-class n))
+		    (rows (markup-body n)))
+		 ;; the table header
+		 (output (new markup
+			    (markup '&latex-table-start)
+			    (class "table")
+			    (options `((width ,width))))
+			 e)
+		 ;; store the actual number of columns
+		 (markup-option-add! n '&nbcols nbcols)
+		 ;; compute the table header
+		 (let ((cols (cond
+				((= nbcols 0)
+				 (skribe-error 'table
+					       "Illegal empty table"
+					       n))
+				((or (not width) (= nbcols 1))
+				 (make-string nbcols #\c))
+				(else
+				 (let ((v (make-vector 
+					   (- nbcols 1)
+					   "@{\\extracolsep{\\fill}}c")))
+				    (apply string-append
+					   (cons "c" (vector->list v))))))))
+		    (case frame
+		       ((none)
+			(printf "{~a}\n" cols))
+		       ((border box)
+			(printf "{|~a|}" cols)
+			(markup-option-add! n '&lhs #t)
+			(markup-option-add! n '&rhs #t)
+			(output (new markup
+				   (markup '&latex-table-hline)
+				   (parent n)
+				   (ident (format #f "~a-above" id))
+				   (class "table-line-above"))
+				e))
+		       ((above hsides)
+			(printf "{~a}" cols)
+			(output (new markup
+				   (markup '&latex-table-hline)
+				   (parent n)
+				   (ident (format #f "~a-above" id))
+				   (class "table-line-above"))
+				e))
+		       ((vsides)
+			(markup-option-add! n '&lhs #t)
+			(markup-option-add! n '&rhs #t)
+			(printf "{|~a|}\n" cols))
+		       ((lhs)
+			(markup-option-add! n '&lhs #t)
+			(printf "{|~a}\n" cols))
+		       ((rhs)
+			(markup-option-add! n '&rhs #t)
+			(printf "{~a|}\n" cols))
+		       (else
+			(printf "{~a}\n" cols)))
+		    ;; mark each row with appropriate '&tl (top-line)
+		    ;; and &bl (bottom-line) options
+		    (when (pair? rows)
+		       (if (and (memq rules '(rows all))
+				(or (not (eq? cstyle 'collapse))
+				    (not (memq frame '(border box above hsides)))))
+			   (let ((frow (car rows)))
+			      (if (is-markup? frow 'tr)
+				  (markup-option-add! frow '&tl #t))))
+		       (if (eq? rules 'header)
+			   (let ((frow (car rows)))
+			      (if (is-markup? frow 'tr)
+				  (markup-option-add! frow '&bl #t))))
+		       (when (and (pair? (cdr rows))
+				  (memq rules '(rows all)))
+			  (for-each (lambda (row)
+				       (if (is-markup? row 'tr)
+					   (markup-option-add! row '&bl #t)))
+				    rows)
+			  (markup-option-add! (car (last-pair rows)) '&bl #f))
+		       (if (and (memq rules '(rows all))
+				(or (not (eq? cstyle 'collapse))
+				    (not (memq frame '(border box above hsides)))))
+			   (let ((lrow (car (last-pair rows))))
+			      (if (is-markup? lrow 'tr)
+				  (markup-option-add! lrow '&bl #t))))))))
+   :after (lambda (n e)
+	     (case (markup-option n :frame)
+		((hsides below box border)
+		 (output (new markup
+			    (markup '&latex-table-hline)
+			    (parent n)
+			    (ident (format #f "~a-below" (markup-ident n)))
+			    (class "table-hline-below"))
+			 e)))
+	     (output (new markup
+			(markup '&latex-table-stop)
+			(class "table")
+			(options `((width ,(markup-option n :width)))))
+		     e)))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-table-hline                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-hline
+   :action "\\hline\n")
+
+;*---------------------------------------------------------------------*/
+;*    tr ...                                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tr
+   :options '()
+   :action (lambda (n e)
+	      (let* ((parent (ast-parent n))
+		     (_ (if (not (is-markup? parent 'table))
+			    (skribe-type-error 'tr "Illegal parent, " parent
+					       "#<table>")))
+		     (nbcols (markup-option parent '&nbcols))
+		     (lhs (markup-option parent '&lhs))
+		     (rhs (markup-option parent '&rhs))
+		     (rules (markup-option parent :rules))
+		     (collapse (eq? (markup-option parent :cellstyle) 
+				    'collapse))
+		     (vrules (memq rules '(cols all)))
+		     (cells (markup-body n)))
+		 (if (markup-option n '&tl)
+		     (output (new markup
+				(markup '&latex-table-hline)
+				(parent n)
+				(ident (markup-ident n))
+				(class (markup-class n)))
+			     e))
+		 (if (> nbcols 0)
+		     (let laap ((nbc nbcols)
+				(cs cells))
+			(if (null? cs)
+			    (when (> nbc 1)
+			       (display " & ")
+			       (laap (- nbc 1) cs))
+			    (let* ((c (car cs))
+				   (nc (- nbc (markup-option c :colspan))))
+			       (when (= nbcols nbc)
+				  (cond
+				     ((and lhs vrules (not collapse))
+				      (markup-option-add! c '&lhs "||"))
+				     ((or lhs vrules)
+				      (markup-option-add! c '&lhs #\|))))
+			       (when (= nc 0)
+				  (cond
+				     ((and rhs vrules (not collapse))
+				      (markup-option-add! c '&rhs "||"))
+				     ((or rhs vrules)
+				      (markup-option-add! c '&rhs #\|))))
+			       (when (and vrules (> nc 0) (< nc nbcols))
+				  (markup-option-add! c '&rhs #\|))
+			       (output c e)
+			       (when (> nc 0)
+				  (display " & ")
+				  (laap nc (cdr cs)))))))))
+   :after (lambda (n e)
+	     (display "\\\\")
+	     (if (markup-option n '&bl)
+		 (output (new markup
+			    (markup '&latex-table-hline)
+			    (parent n)
+			    (ident (markup-ident n))
+			    (class (markup-class n)))
+			 e)
+		 (newline))))
+
+;*---------------------------------------------------------------------*/
+;*    tc                                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tc
+   :options '(:width :align :valign :colspan)
+   :action (lambda (n e)
+	      (let ((id (markup-ident n))
+		    (cla (markup-class n)))
+		 (let* ((o0 (markup-body n))
+			(o1 (if (eq? (markup-option n 'markup) 'th)
+				(new markup
+				   (markup '&latex-th)
+				   (parent n)
+				   (ident id)
+				   (class cla)
+				   (options (markup-options n))
+				   (body o0))
+				o0))
+			(o2 (if (markup-option n :width)
+				(new markup
+				   (markup '&latex-tc-parbox)
+				   (parent n)
+				   (ident id)
+				   (class cla)
+				   (options (markup-options n))
+				   (body o1))
+				o1))
+			(o3 (if (or (> (markup-option n :colspan) 1)
+				    (not (eq? (markup-option n :align) 
+					      'center))
+				    (markup-option n '&lhs)
+				    (markup-option n '&rhs))
+				(new markup
+				   (markup '&latex-tc-multicolumn)
+				   (parent n)
+				   (ident id)
+				   (class cla)
+				   (options (markup-options n))
+				   (body o2))
+				o2)))
+		    (output o3 e)))))
+
+;*---------------------------------------------------------------------*/
+;*    &latex-th ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-th
+   :before "\\textsf{"
+   :after "}")
+
+;*---------------------------------------------------------------------*/
+;*    &latex-tc-parbox ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-tc-parbox
+   :before (lambda (n e)
+	      (let ((width (markup-option n :width))
+		    (valign (markup-option n :valign)))
+		 (printf "\\parbox{~a}{" (latex-width width))))
+   :after "}")
+		 
+;*---------------------------------------------------------------------*/
+;*    &latex-tc-multicolumn ...                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-tc-multicolumn
+   :before (lambda (n e)
+	      (let ((colspan (markup-option n :colspan))
+		    (lhs (or (markup-option n '&lhs) ""))
+		    (rhs (or (markup-option n '&rhs) ""))
+		    (align (case (markup-option n :align)
+			      ((left) #\l)
+			      ((center) #\c)
+			      ((right) #\r)
+			      (else #\c))))
+		 (printf "\\multicolumn{~a}{~a~a~a}{" colspan lhs align rhs)))
+   :after "}")
+
+;*---------------------------------------------------------------------*/
+;*    image ... @label image@                                          */
+;*---------------------------------------------------------------------*/
+(markup-writer 'image
+   :options '(:file :url :width :height :zoom)
+   :action (lambda (n e)
+	      (let* ((file (markup-option n :file))
+		     (url (markup-option n :url))
+		     (width (markup-option n :width))
+		     (height (markup-option n :height))
+		     (zoom (markup-option n :zoom))
+		     (body (markup-body n))
+		     (efmt (engine-custom e 'image-format))
+		     (img (or url (convert-image file 
+						 (if (list? efmt) 
+						     efmt
+						     '("eps"))))))
+		 (if (not (string? img))
+		     (skribe-error 'latex "Illegal image" file)
+		     (begin
+			(printf "\\epsfig{file=~a" (strip-ref-base img))
+			(if width (printf ", width=~a" (latex-width width)))
+			(if height (printf ", height=~apt" height))
+			(if zoom (printf ", zoom=\"~a\"" zoom))
+			(display "}"))))))
+
+;*---------------------------------------------------------------------*/
+;*    Ornaments ...                                                    */
+;*---------------------------------------------------------------------*/
+(markup-writer 'roman :before "{\\textrm{" :after "}}")
+(markup-writer 'bold :before "{\\textbf{" :after "}}")
+(markup-writer 'underline :before  "{\\underline{" :after "}}")
+(markup-writer 'emph :before "{\\em{" :after "}}")
+(markup-writer 'it :before "{\\textit{" :after "}}")
+(markup-writer 'code :before "{\\texttt{" :after "}}")
+(markup-writer 'var :before "{\\texttt{" :after "}}")
+(markup-writer 'sc :before "{\\sc{" :after "}}")
+(markup-writer 'sf :before "{\\sf{" :after "}}")
+(markup-writer 'sub :before "\\begin{math}\\sb{\\mbox{" :after "}}\\end{math}")
+(markup-writer 'sup :before "\\begin{math}\\sp{\\mbox{" :after "}}\\end{math}")
+
+(markup-writer 'tt
+   :before "{\\texttt{"
+   :action (lambda (n e)
+	      (let ((ne (make-engine
+			   (gensym 'latex)
+			   :delegate e
+			   :filter (make-string-replace latex-tt-encoding)
+			   :custom (engine-customs e)
+			   :symbol-table (engine-symbol-table e))))
+		 (output (markup-body n) ne)))
+   :after "}}")
+
+;*---------------------------------------------------------------------*/
+;*    q ... @label q@                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer 'q
+   :before "``"
+   :after "''")
+
+;*---------------------------------------------------------------------*/
+;*    mailto ... @label mailto@                                        */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+   :options '(:text)
+   :before "{\\texttt{"
+   :action (lambda (n e)
+	      (let ((text (markup-option n :text)))
+		 (output (or text (markup-body n)) e)))
+   :after "}}")
+
+;*---------------------------------------------------------------------*/
+;*    mark ... @label mark@                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mark
+   :before (lambda (n e)
+	      (printf "\\label{~a}" (string-canonicalize (markup-ident n)))))
+
+;*---------------------------------------------------------------------*/
+;*    ref ... @label ref@                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer 'ref
+   :options '(:text :chapter :section :subsection :subsubsection :figure :mark :handle :page)
+   :action (lambda (n e)
+	      (let ((t (markup-option n :text)))
+		 (if t
+		     (begin
+			(output t e)
+			(output "~" e (markup-writer-get '~ e))))))
+   :after (lambda (n e)
+	     (let* ((c (handle-ast (markup-body n)))
+		    (id (markup-ident c)))
+		(if (markup-option n :page)
+		    (printf "\\begin{math}{\\pageref{~a}}\\end{math}" 
+			    (string-canonicalize id))
+		    (printf "\\ref{~a}" 
+			    (string-canonicalize id))))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e)
+	      (output (markup-option (handle-ast (markup-body n)) :title) e))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    bib-ref+ ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref+
+   :options '(:text :bib)
+   :before "["
+   :action (lambda (n e) 
+	      (let loop ((rs (markup-body n)))
+		 (cond
+		    ((null? rs)
+		     #f)
+		    (else
+		     (if (is-markup? (car rs) 'bib-ref)
+			 (invoke (writer-action (markup-writer-get 'bib-ref e))
+				 (car rs)
+				 e)
+			 (output (car rs) e))
+		     (if (pair? (cdr rs))
+			 (begin
+			    (display ",")
+			    (loop (cdr rs))))))))
+   :after "]")
+
+;*---------------------------------------------------------------------*/
+;*    url-ref ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :action (lambda (n e) 
+	      (let ((text (markup-option n :text))
+		    (url (markup-option n :url)))
+		 (if (not text)
+		     (output url e)
+		     (output text e)))))
+
+;*---------------------------------------------------------------------*/
+;*    url-ref hyperref ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+   :options '(:url :text)
+   :predicate (lambda (n e)
+		 (engine-custom e 'hyperref))
+   :action (lambda (n e) 
+	      (let ((body (markup-option n :text))
+		    (url (markup-option n :url)))
+		 (if (and body (not (equal? body url)))
+		     (begin
+			(display "\\href{")
+			(display url)
+			(display "}{")
+			(output body e)
+			(display "}"))
+		     (begin
+			(display "\\href{")
+			(display url)
+			(printf "}{~a}" url))))))
+
+;*---------------------------------------------------------------------*/
+;*    line-ref ...                                                     */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+   :options '(:offset)
+   :before "{\\textit{"
+   :action (lambda (n e)
+	      (let ((o (markup-option n :offset))
+		    (v (string->number (markup-option n :text))))
+		 (cond
+		    ((and (number? o) (number? v))
+		     (display (+ o v)))
+		    (else
+		     (display v)))))
+   :after "}}")
+
+;*---------------------------------------------------------------------*/
+;*    &the-bibliography ...                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-bibliography
+   :before (lambda (n e)
+	      (display "{%
+\\sloppy
+\\sfcode`\\.=1000\\relax
+\\newdimen\\bibindent
+\\bibindent=0em
+\\begin{list}{}{%
+        \\settowidth\\labelwidth{[21]}%
+        \\leftmargin\\labelwidth
+        \\advance\\leftmargin\\labelsep
+        \\advance\\leftmargin\\bibindent
+        \\itemindent -\\bibindent
+        \\listparindent \\itemindent
+        \\itemsep 0pt
+    }%\n"))
+   :after (lambda (n e)
+	     (display "\n\\end{list}}\n")))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry
+   :options '(:title)
+   :action (lambda (n e)
+	      (output n e (markup-writer-get '&bib-entry-label e))
+	      (output n e (markup-writer-get '&bib-entry-body e)))
+   :after "\n")
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-title ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+   :predicate (lambda (n e)
+		 (engine-custom e 'hyperref))
+   :action (lambda (n e)
+	      (let* ((t (bold (markup-body n)))
+		     (en (handle-ast (ast-parent n)))
+		     (url (markup-option en 'url))
+		     (ht (if url (ref :url (markup-body url) :text t) t)))
+		 (skribe-eval ht e))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-label ...                                             */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+   :options '(:title)
+   :before "\\item[{\\char91}"
+   :action (lambda (n e) (output (markup-option n :title) e))
+   :after "{\\char93}] ")
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-url ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-url
+   :action (lambda (n e)
+	      (let* ((en (handle-ast (ast-parent n)))
+		     (url (markup-option en 'url))
+		     (t (bold (markup-body url))))
+		 (skribe-eval (ref :url (markup-body url) :text t) e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-comment ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (it (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+	      
+;*---------------------------------------------------------------------*/
+;*    &source-line-comment ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-line-comment
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-comment-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+	      
+;*---------------------------------------------------------------------*/
+;*    &source-keyword ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-keyword
+   :action (lambda (n e)
+	      (skribe-eval (underline (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;*    &source-error ...                                                */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-error
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-error-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'error-color) cc)
+			     (color :fg cc (underline n1))
+			     (underline n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-define ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-define
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-define-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-module ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-module
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-module-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-markup ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-markup
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-markup-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-thread ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-thread
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-thread-color))
+		     (n1 (bold (markup-body n)))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-string ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-string
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-string-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     n1)))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-bracket ...                                              */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-bracket
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-bracket-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-type ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc n1)
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-key ...                                                  */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-key
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg cc (bold n1))
+			     (it n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    &source-type ...                                                 */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+   :action (lambda (n e)
+	      (let* ((cc (engine-custom e 'source-type-color))
+		     (n1 (markup-body n))
+		     (n2 (if (and (engine-custom e 'source-color) cc)
+			     (color :fg "red" (bold n1))
+			     (bold n1))))
+		 (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
new file mode 100644
index 0000000..893ab2e
--- /dev/null
+++ b/src/guile/skribilo/engine/lout.scm
@@ -0,0 +1,2891 @@
+;;; lout.scm  --  A Lout engine.
+;;;
+;;; Copyright 2004, 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+;;;    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)
+  :autoload (ice-9 popen)   (open-output-pipe)
+  :autoload (ice-9 rdelim)  (read-line))
+
+
+
+;*---------------------------------------------------------------------*/
+;*    lout-verbatim-encoding ...                                       */
+;*---------------------------------------------------------------------*/
+(define-public lout-verbatim-encoding
+   '((#\/ "\"/\"")
+     (#\\ "\"\\\\\"")
+     (#\| "\"|\"")
+     (#\& "\"&\"")
+     (#\@ "\"@\"")
+     (#\" "\"\\\"\"")
+     (#\{ "\"{\"")
+     (#\} "\"}\"")
+     (#\$ "\"$\"")
+     (#\# "\"#\"")
+     (#\_ "\"_\"")
+     (#\~ "\"~\"")))
+
+;*---------------------------------------------------------------------*/
+;*    lout-encoding ...                                                */
+;*---------------------------------------------------------------------*/
+(define-public 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 sym 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-public (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"
+
+	     "# @SkribiloLeaders is used in `toc'\n"
+	     "# (this is mostly copied from the expert's guide)\n"
+	     "def @SkribiloLeaders { "
+	     ,leader " |" ,leader-space " @SkribiloLeaders }\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? (> (engine-custom engine 'column-number) 1)))
+
+    (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 { cragged nohyphen 1.4fx } @Break { ")
+    (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
+  (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 doc)
+
+			 ;; 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.  This custom is deprecated,
+                         ;; use the `:keywords' option of `document' instead.
+			 (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)
+				;; We don't use `@Sym' because it doesn't
+				;; work within `@Eq'.
+				(string-append "{ { Symbol Base } @Font "
+					       "@Char \"" m "\" }"))
+			      (lambda (m)
+				(format #f "{ @Eq { ~a } }" m)))))
+
+
+;; So that calls to `markup-writer' automatically use `lout-engine'...
+(push-default-engine lout-engine)
+
+
+
+;; 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-public (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-public (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 (or (engine-custom engine 'pdf-keywords)
+                       (map ast->string
+                            (or (markup-option doc :keywords) '()))))
+	 (extra-fields (engine-custom engine 'pdf-extra-info)))
+
+    (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 (pair? keywords)
+		       (docinfo-field "Keywords"
+                                      (apply string-append
+                                             (keyword-list->comma-separated
+                                              keywords)))
+		       "")
+		   ;; 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-public (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 ((inexact? width) ;; a relative size (XXX: was `flonum?')
+	  ;; 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-public (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 :keywords :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', `doc' or `slides'"
+				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 work 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 " @SkribiloLeaders & @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-slides-markup-alist
+  '((slide . "Overhead")))
+
+(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))
+      ((slides)  (assoc-ref lout-slides-markup-alist skribe-markup))
+      (else
+       (skribe-error 'lout
+		     "`document-type' should be one of `book', `report', `doc' or `slides'"
+		     doc-type)))))
+
+(define-public (lout-structure-number-string markup)
+  ;; Return a structure number string such as "1.2".
+  ;; FIXME: External code has started to rely on this.  This should be
+  ;;        generalized and moved elsewhere.
+  (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 (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))
+
+	  ;; FIXME: We need to make sure that PARENT is a large-scale
+	  ;; structure, otherwise it won't have the `&substructs-started?'
+	  ;; option (e.g., if PARENT is a `color' markup).  I need to clarify
+	  ;; this.
+	  (if (memq (markup-markup parent)
+		    '(document chapter section subsection subsubsection))
+	      ;; 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 '(:label)
+   :before (lambda (n e)
+	     (let ((label (markup-option n :label))
+		   (use-number?
+		    (engine-custom e 'use-skribe-footnote-numbers?)))
+	       (if (or (and (number? label) use-number?) label)
+		   (printf "{ @FootNote @Label { ~a } { "
+			   (if label label ""))
+		   (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"
+			  (cond ((number? number) number)
+				((not number)     "")
+				(else             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.
+
+;; FIXME: See whether `@II' can be useful.  Use SRFI-39 parameters.
+
+(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-public (lout-illustration . args)
+  ;; FIXME: This should be a markup.
+
+  ;; 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
+	  (let* ((lout (find-engine 'lout))
+		 (output (string-append (or ident
+					    (symbol->string
+					     (gensym 'lout-illustration)))
+					".eps"))
+		 (port (open-output-pipe
+			(string-append (or (engine-custom lout
+							  'lout-program-name)
+					   "lout")
+				       " -o " output
+				       " -EPS"))))
+
+	    ;; send the illustration to Lout's standard input
+	    (display (illustration-header) port)
+	    (display contents port)
+	    (display (illustration-ending) port)
+
+	    (let ((exit-val (status:exit-val (close-pipe port))))
+	      (if (not (eqv? 0 exit-val))
+		  (skribe-error 'lout-illustration
+				"lout exited with error code" exit-val)))
+
+	    (if (not (file-exists? output))
+		(skribe-error 'lout-illustration "file not created"
+			      output))
+
+	    (let ((file-info (false-if-exception (stat output))))
+	      (if (or (not file-info)
+		      (= 0 (stat:size file-info)))
+		  (skribe-error 'lout-illustration
+				"empty output file" output)))
+
+	    ;; the image (FIXME: Should set its location)
+	    (image :file output alt))))))
+
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(pop-default-engine)
+
+
+;; Local Variables: --
+;; mode: Scheme --
+;; coding: latin-1 --
+;; scheme-program-name: "guile" --
+;; End: --
diff --git a/src/guile/skribilo/engine/xml.scm b/src/guile/skribilo/engine/xml.scm
new file mode 100644
index 0000000..81e9f27
--- /dev/null
+++ b/src/guile/skribilo/engine/xml.scm
@@ -0,0 +1,115 @@
+;;; xml.scm  --  Generic XML engine.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo engine xml))
+
+;*---------------------------------------------------------------------*/
+;*    xml-engine ...                                                   */
+;*---------------------------------------------------------------------*/
+(define xml-engine
+   ;; setup the xml engine
+   (default-engine-set!
+      (make-engine 'xml
+		   :version 1.0
+		   :format "html"
+		   :delegate (find-engine 'base)
+		   :filter (make-string-replace '((#\< "&lt;")
+						  (#\> "&gt;")
+						  (#\& "&amp;")
+						  (#\" "&quot;")
+						  (#\@ "&#x40;"))))))
+
+;*---------------------------------------------------------------------*/
+;*    markup ...                                                       */
+;*---------------------------------------------------------------------*/
+(let ((xml-margin 0))
+   (define (make-margin)
+      (make-string xml-margin #\space))
+   (define (xml-attribute? val)
+      (cond
+	 ((or (string? val) (number? val) (boolean? val))
+	  #t)
+	 ((list? val)
+	  (every? xml-attribute? val))
+	 (else
+	  #f)))
+   (define (xml-attribute att val)
+      (let ((s (keyword->string att)))
+	 (printf " ~a=\"" (substring s 1 (string-length s)))
+	 (let loop ((val val))
+	    (cond
+	       ((or (string? val) (number? val))
+		(display val))
+	       ((boolean? val)
+		(display (if val "true" "false")))
+	       ((pair? val)
+		(for-each loop val))
+	       (else
+		#f)))
+	 (display #\")))
+   (define (xml-option opt val e)
+      (let* ((m (make-margin))
+	     (ks (keyword->string opt))
+	     (s (substring ks 1 (string-length ks))))
+	 (printf "~a<~a>\n" m s)
+	 (output val e)
+	 (printf "~a</~a>\n" m s)))
+   (define (xml-options n e)
+      ;; display the true options
+      (let ((opts (filter (lambda (o)
+			     (and (keyword? (car o))
+				  (not (xml-attribute? (cadr o)))))
+			  (markup-options n))))
+	 (if (pair? opts)
+	     (let ((m (make-margin)))
+		(display m)
+		(display "<options>\n")
+		(set! xml-margin (+ xml-margin 1))
+		(for-each (lambda (o)
+			     (xml-option (car o) (cadr o) e))
+			  opts)
+		(set! xml-margin (- xml-margin 1))
+		(display m)
+		(display "</options>\n")))))
+   (markup-writer #t
+      :options 'all
+      :before (lambda (n e)
+		 (printf "~a<~a" (make-margin) (markup-markup n))
+		 ;; display the xml attributes
+		 (for-each (lambda (o)
+			      (if (and (keyword? (car o))
+				       (xml-attribute? (cadr o)))
+				  (xml-attribute (car o) (cadr o))))
+			   (markup-options n))
+		 (set! xml-margin (+ xml-margin 1))
+		 (display ">\n"))
+      :action (lambda (n e)
+		 ;; options
+		 (xml-options n e)
+		 ;; body
+		 (output (markup-body n) e))
+      :after (lambda (n e)
+		(printf "~a</~a>\n" (make-margin) (markup-markup n))
+		(set! xml-margin (- xml-margin 1)))))
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
new file mode 100644
index 0000000..8502d51
--- /dev/null
+++ b/src/guile/skribilo/evaluator.scm
@@ -0,0 +1,203 @@
+;;; eval.scm  --  Skribilo evaluator.
+;;;
+;;; Copyright 2003-2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2005,2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+(define-module (skribilo evaluator)
+  :export (evaluate-document evaluate-document-from-port
+	   load-document include-document *load-options*)
+  :autoload (skribilo parameters) (*verbose* *document-path*)
+  :autoload (skribilo location)   (<location>)
+  :autoload (skribilo ast)        (ast? markup?)
+  :autoload (skribilo engine)     (*current-engine*
+				   engine? find-engine engine-ident)
+  :autoload (skribilo reader)     (*document-reader*)
+
+  :autoload (skribilo verify)     (verify)
+  :autoload (skribilo resolve)    (resolve!)
+
+  :autoload (skribilo module)     (*skribilo-user-module*))
+
+
+(use-modules (skribilo utils syntax)
+	     (skribilo condition)
+	     (skribilo debug)
+	     (skribilo output)
+             (skribilo lib)
+
+	     (ice-9 optargs)
+	     (oop goops)
+	     (srfi srfi-1)
+	     (srfi srfi-13)
+	     (srfi srfi-34)
+	     (srfi srfi-35)
+	     (srfi srfi-39))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; %EVALUATE
+;;;
+(define (%evaluate expr)
+  ;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the
+  ;; markup functions defined in a markup package such as
+  ;; `(skribilo package base)', e.g., `(bold "hello")'.
+  (let ((result (eval expr (*skribilo-user-module*))))
+
+    (if (ast? result)
+	(let ((file (source-property expr 'filename))
+	      (line (source-property expr 'line))
+	      (column (source-property expr 'column)))
+	  (slot-set! result 'loc
+		     (make <location>
+		       :file file :line line :pos column))))
+
+    result))
+
+
+
+;;;
+;;; EVALUATE-DOCUMENT
+;;;
+(define* (evaluate-document a e :key (env '()))
+  ;; Argument A must denote an AST of something like that, not just an
+  ;; S-exp.
+  (with-debug 2 'evaluate-document
+     (debug-item "a=" a " e=" (engine-ident e))
+     (let ((a2 (resolve! a e env)))
+       (debug-item "resolved a=" a)
+       (let ((a3 (verify a2 e)))
+	 (debug-item "verified a=" a3)
+	 (output a3 e)))))
+
+;;;
+;;; EVALUATE-DOCUMENT-FROM-PORT
+;;;
+(define* (evaluate-document-from-port port engine
+				      :key (env '())
+				           (reader (*document-reader*)))
+  (with-debug 2 'evaluate-document-from-port
+     (debug-item "engine=" engine)
+     (debug-item "reader=" reader)
+
+     (let ((e (if (symbol? engine) (find-engine engine) engine)))
+       (debug-item "e=" e)
+       (if (not (engine? e))
+	   (skribe-error 'evaluate-document-from-port "cannot find engine" engine)
+	   (let loop ((exp (reader port)))
+	     (with-debug 10 'evaluate-document-from-port
+		(debug-item "exp=" exp))
+	     (unless (eof-object? exp)
+	       (evaluate-document (%evaluate exp) e :env env)
+	       (loop (reader port))))))))
+
+
+;;;
+;;; LOAD-DOCUMENT
+;;;
+
+;; Options that may make sense to a specific back-end or package.
+(define-public *load-options* (make-parameter '()))
+
+;; List of the names of files already loaded.
+(define *loaded-files* (make-parameter '()))
+
+(define* (load-document file :key (engine #f) (path #f) :allow-other-keys
+			:rest opt)
+  (with-debug 4 'skribe-load
+     (debug-item "  engine=" engine)
+     (debug-item "  path=" path)
+     (debug-item "  opt=" opt)
+
+     (let* ((ei  (*current-engine*))
+	    (path (append (cond
+			   ((not path) (*document-path*))
+			   ((string? path) (list path))
+			   ((not (and (list? path) (every? string? path)))
+			    (raise (condition (&invalid-argument-error
+					       (proc-name 'load-document)
+					       (argument  path)))))
+			   (else path))
+			  %load-path))
+            (filep (or (search-path path file)
+		       (search-path (append path %load-path) file)
+		       (search-path (append path %load-path)
+				    (let ((dot (string-rindex file #\.)))
+				      (if dot
+					  (string-append
+					   (string-take file dot)
+					   ".scm")
+					  file))))))
+
+       (unless (and (string? filep) (file-exists? filep))
+	 (raise (condition (&file-search-error
+			    (file-name file)
+			    (path path)))))
+
+       ;; Pass the additional options to the back-end and/or packages being
+       ;; used.
+       (parameterize ((*load-options* opt))
+
+	 ;; Load this file if not already done
+	 ;; FIXME: Shouldn't we remove this logic?  -- Ludo'.
+	 (unless (member filep (*loaded-files*))
+	   (cond
+	    ((> (*verbose*) 1)
+	     (format (current-error-port) "  [loading file: ~S ~S]\n" filep opt))
+	    ((> (*verbose*) 0)
+	     (format (current-error-port) "  [loading file: ~S]\n" filep)))
+
+	   ;; Load it
+	   (with-input-from-file filep
+	     (lambda ()
+	       (evaluate-document-from-port (current-input-port) ei)))
+
+	   (*loaded-files* (cons filep (*loaded-files*))))))))
+
+;;;
+;;; INCLUDE-DOCUMENT
+;;;
+(define* (include-document file :key (path (*document-path*))
+			             (reader (*document-reader*)))
+  (unless (every string? path)
+    (raise (condition (&invalid-argument-error (proc-name 'include-document)
+					       (argument  path)))))
+
+  (let ((full-path (search-path path file)))
+    (unless (and (string? full-path) (file-exists? full-path))
+      (raise (condition (&file-search-error
+			 (file-name file)
+			 (path path)))))
+
+    (when (> (*verbose*) 0)
+      (format (current-error-port) "  [including file: ~S]\n" full-path))
+
+    (with-input-from-file full-path
+      (lambda ()
+	(let Loop ((exp (reader (current-input-port)))
+		   (res '()))
+	  (if (eof-object? exp)
+	      (if (and (pair? res) (null? (cdr res)))
+		    (car res)
+		    (reverse! res))
+	      (Loop (reader (current-input-port))
+		    (cons (%evaluate exp) res))))))))
diff --git a/src/guile/skribilo/index.scm b/src/guile/skribilo/index.scm
new file mode 100644
index 0000000..33f8d15
--- /dev/null
+++ b/src/guile/skribilo/index.scm
@@ -0,0 +1,170 @@
+;;; index.scm
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2005, 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo index)
+  :use-syntax (skribilo utils syntax)
+  :use-syntax (skribilo lib)
+
+  :use-module (skribilo lib)
+  :use-module (skribilo ast)
+  :use-module (srfi srfi-39)
+
+  ;; XXX: The use of `mark' here introduces a cross-dependency between
+  ;; `index' and `package base'.  Thus, we require that each of these two
+  ;; modules autoloads the other one.
+  :autoload   (skribilo package base) (mark)
+
+  :export (index? make-index-table *index-table*
+           default-index resolve-the-index))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; Author:  Manuel Serrano
+;;; Commentary:
+;;;
+;;; A library of functions dealing with the creation of indices in
+;;; documents.
+;;;
+;;; Code:
+
+
+;;; The contents of the file below are (almost) unchanged compared to Skribe
+;;; 1.2d's `index.scm' file found in the `common' directory.
+
+
+;*---------------------------------------------------------------------*/
+;*    index? ...                                                       */
+;*---------------------------------------------------------------------*/
+(define (index? obj)
+   (hash-table? obj))
+
+;*---------------------------------------------------------------------*/
+;*    *index-table* ...                                                */
+;*---------------------------------------------------------------------*/
+(define *index-table* (make-parameter #f))
+
+;*---------------------------------------------------------------------*/
+;*    make-index-table ...                                             */
+;*---------------------------------------------------------------------*/
+(define (make-index-table ident)
+   (make-hash-table))
+
+;*---------------------------------------------------------------------*/
+;*    default-index ...                                                */
+;*---------------------------------------------------------------------*/
+(define (default-index)
+   (if (not (*index-table*))
+       (*index-table* (make-index-table "default-index")))
+   (*index-table*))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-the-index ...                                            */
+;*---------------------------------------------------------------------*/
+(define (resolve-the-index loc i c indexes split char-offset header-limit col)
+   ;; fetch the descriminating index name letter
+   (define (index-ref n)
+      (let ((name (markup-option n 'name)))
+	 (if (>= char-offset (string-length name))
+	     (skribe-error 'the-index "char-offset out of bound" char-offset)
+	     (string-ref name char-offset))))
+   ;; sort a bucket of entries (the entries in a bucket share there name)
+   (define (sort-entries-bucket ie)
+      (sort ie
+	    (lambda (i1 i2)
+	       (or (not (markup-option i1 :note))
+		   (markup-option i2 :note)))))
+   ;; accumulate all the entries starting with the same letter
+   (define (letter-references refs)
+      (let ((letter (index-ref (car (car refs)))))
+	 (let loop ((refs refs)
+		    (acc '()))
+	    (if (or (null? refs)
+		    (not (char-ci=? letter (index-ref (car (car refs))))))
+		(values (char-upcase letter) acc refs)
+		(loop (cdr refs) (cons (car refs) acc))))))
+   ;; merge the buckets that comes from different index tables
+   (define (merge-buckets buckets)
+      (if (null? buckets)
+	  '()
+	  (let loop ((buckets buckets)
+		     (res '()))
+	     (cond
+		((null? (cdr buckets))
+		 (reverse! (cons (car buckets) res)))
+		((string=? (markup-option (car (car buckets)) 'name)
+			   (markup-option (car (cadr buckets)) 'name))
+		 ;; we merge
+		 (loop (cons (append (car buckets) (cadr buckets))
+			     (cddr buckets))
+		       res))
+		(else
+		 (loop (cdr buckets)
+		       (cons (car buckets) res)))))))
+   (let* ((entries (apply append (map (lambda (t)
+                                        (hash-map->list
+                                         (lambda (key val) val) t))
+                                      indexes)))
+	  (sorted (map sort-entries-bucket
+		       (merge-buckets
+			(sort entries
+			      (lambda (e1 e2)
+				 (string-ci<?
+				  (markup-option (car e1) 'name)
+				  (markup-option (car e2) 'name))))))))
+      (if (and (not split) (< (apply + (map length sorted)) header-limit))
+	  (new markup
+	     (markup '&the-index)
+	     (loc loc)
+	     (ident i)
+	     (class c)
+	     (options `((:column ,col)))
+	     (body sorted))
+	  (let loop ((refs sorted)
+		     (lrefs '())
+		     (body '()))
+	     (if (null? refs)
+		 (new markup
+		    (markup '&the-index)
+		    (loc loc)
+		    (ident i)
+		    (class c)
+		    (options `((:column ,col)
+			       (header ,(new markup
+					   (markup '&the-index-header)
+					   (loc loc)
+					   (body (reverse! lrefs))))))
+		    (body (reverse! body)))
+		 (call-with-values
+		    (lambda () (letter-references refs))
+		    (lambda (l lr next-refs)
+		       (let* ((s (string l))
+			      (m (mark (symbol->string (gensym s)) :text s))
+			      (h (new handle (loc loc) (ast m)))
+			      (r (ref :handle h :text s)))
+			  (ast-loc-set! m loc)
+			  (ast-loc-set! r loc)
+			  (loop next-refs
+				(cons r lrefs)
+				(append lr (cons m body)))))))))))
+
+
+;;; index.scm ends here
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
new file mode 100644
index 0000000..21b2a4d
--- /dev/null
+++ b/src/guile/skribilo/lib.scm
@@ -0,0 +1,239 @@
+;;;
+;;; lib.scm	-- Utilities
+;;;
+;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright © 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo lib)
+  :use-module (skribilo utils syntax)
+  :export (skribe-eval-location skribe-ast-error skribe-error
+           skribe-type-error
+           skribe-warning skribe-warning/ast
+           skribe-message
+
+	   type-name %procedure-arity)
+
+  :export-syntax (new define-markup define-simple-markup
+                  define-simple-container define-processor-markup)
+
+  :use-module (skribilo config)
+  :use-module (skribilo ast)
+
+  ;; useful for `new' to work well with <language>
+  :autoload   (skribilo source)   (<language>)
+
+  :use-module (skribilo reader)
+  :use-module (skribilo parameters)
+  :use-module (skribilo location)
+
+  :use-module (srfi srfi-1)
+  :use-module (oop goops)
+  :use-module (ice-9 optargs))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; NEW
+;;;
+
+(define %types-module (current-module))
+
+(define-macro (new class . parameters)
+  ;; Thanks to the trick below, modules don't need to import `(oop goops)'
+  ;; and `(skribilo ast)' in order to make use of `new'.
+  (let* ((class-name (symbol-append '< class '>))
+	 (actual-class (module-ref %types-module class-name)))
+    `(let ((make ,make)
+	   (,class-name ,actual-class))
+       (make ,class-name
+	 ,@(apply append (map (lambda (x)
+				`(,(symbol->keyword (car x)) ,(cadr x)))
+			      parameters))))))
+
+;;;
+;;; DEFINE-MARKUP
+;;;
+(define-macro (define-markup bindings . body)
+  ;; This is just an `(ice-9 optargs)' kind of `lambda*', with DSSSL
+  ;; keyword-style conversion enabled.  However, using `(ice-9 optargs)', the
+  ;; `#:rest' argument can only appear last, which is not what Skribe/DSSSL
+  ;; expect, hence `fix-rest-arg'.
+  (define (fix-rest-arg args)
+    (let loop ((args args)
+	       (result '())
+	       (rest-arg #f))
+      (cond ((null? args)
+	     (if rest-arg
+		 (append (reverse result) rest-arg)
+		 (reverse result)))
+
+	    ((list? args)
+	     (let ((is-rest-arg? (eq? (car args) #:rest)))
+	       (loop (if is-rest-arg? (cddr args) (cdr args))
+		     (if is-rest-arg? result (cons (car args) result))
+		     (if is-rest-arg?
+			 (list (car args) (cadr args))
+			 rest-arg))))
+
+	    ((pair? args)
+	     (loop '()
+		   (cons (car args) result)
+		   (list #:rest (cdr args)))))))
+
+  (let ((name (car bindings))
+	(opts (cdr bindings)))
+    `(define*-public ,(cons name (fix-rest-arg opts)) ,@body)))
+
+
+;;;
+;;; DEFINE-SIMPLE-MARKUP
+;;;
+(define-macro (define-simple-markup markup)
+  `(define-markup (,markup :rest opts :key ident class loc)
+     (new markup
+	  (markup ',markup)
+	  (ident (or ident (symbol->string
+			    (gensym ',(symbol->string markup)))))
+	  (loc loc)
+	  (class class)
+	  (required-options '())
+	  (options (the-options opts :ident :class :loc))
+	  (body (the-body opts)))))
+
+
+;;;
+;;; DEFINE-SIMPLE-CONTAINER
+;;;
+(define-macro (define-simple-container markup)
+   `(define-markup (,markup :rest opts :key ident class loc)
+       (new container
+	  (markup ',markup)
+	  (ident (or ident (symbol->string
+			    (gensym ',(symbol->string markup)))))
+	  (loc loc)
+	  (class class)
+	  (required-options '())
+	  (options (the-options opts :ident :class :loc))
+	  (body (the-body opts)))))
+
+
+;;;
+;;; DEFINE-PROCESSOR-MARKUP
+;;;
+(define-macro (define-processor-markup proc)
+  `(define-markup (,proc #:rest opts)
+     (new processor
+	  (engine  (find-engine ',proc))
+	  (body    (the-body opts))
+	  (options (the-options opts)))))
+
+
+
+;;;
+;;; TYPE-NAME
+;;;
+(define (type-name obj)
+  (cond ((string? obj)  "string")
+	((ast? obj)     "ast")
+	((list? obj)    "list")
+	((pair? obj)    "pair")
+	((number? obj)  "number")
+	((char? obj)    "character")
+	((keyword? obj) "keyword")
+	(else           (with-output-to-string
+			  (lambda () (write obj))))))
+
+;;;
+;;; SKRIBE-EVAL-LOCATION ...
+;;;
+(define (skribe-eval-location)
+  (format (current-error-port)
+	  "FIXME: ...... SKRIBE-EVAL-LOCATION (should not appear)\n")
+  #f)
+
+;;;
+;;; SKRIBE-ERROR
+;;;
+(define (skribe-ast-error proc msg obj)
+  (let ((l     (ast-loc obj))
+	(shape (if (markup? obj) (markup-markup obj) obj)))
+    (if (location? l)
+	(error (format #f "~a:~a: ~a: ~a ~s" (location-file l)
+		       (location-line l) proc msg shape))
+	(error (format #f "~a: ~a ~s " proc msg shape)))))
+
+(define (skribe-error proc msg obj)
+  (if (ast? obj)
+      (skribe-ast-error proc msg obj)
+      (error (format #f "~a: ~a ~s" proc msg obj))))
+
+
+;;;
+;;; SKRIBE-TYPE-ERROR
+;;;
+(define (skribe-type-error proc msg obj etype)
+  (skribe-error proc (format "~a ~s (~a expected)" msg obj etype) #f))
+
+
+;;;
+;;; SKRIBE-WARNING  &  SKRIBE-WARNING/AST
+;;;
+(define (%skribe-warn level file line lst)
+  (let ((port (current-error-port)))
+    (if (or (not file) (not line))
+	(begin
+	  ;; XXX:  This is a bit hackish, but it proves to be quite useful.
+	  (set! file (port-filename (current-input-port)))
+	  (set! line (port-line (current-input-port)))))
+    (when (and file line)
+      (format port "~a:~a: " file line))
+    (format port "warning: ")
+    (for-each (lambda (x) (format port "~a " x)) lst)
+    (newline port)))
+
+
+(define (skribe-warning level . obj)
+  (if (>= (*warning*) level)
+      (%skribe-warn level #f #f obj)))
+
+
+(define (skribe-warning/ast level ast . obj)
+  (if (>= (*warning*) level)
+      (let ((l (ast-loc ast)))
+	(if (location? l)
+	    (%skribe-warn level (location-file l) (location-line l) obj)
+	    (%skribe-warn level #f #f obj)))))
+
+;;;
+;;; SKRIBE-MESSAGE
+;;;
+(define (skribe-message fmt . obj)
+  (when (> (*verbose*) 0)
+    (apply format (current-error-port) fmt obj)))
+
+
+;;;
+;;; %PROCEDURE-ARITY
+;;;
+(define (%procedure-arity proc)
+  (car (procedure-property proc 'arity)))
+
+;;; lib.scm ends here
diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm
new file mode 100644
index 0000000..7c870fa
--- /dev/null
+++ b/src/guile/skribilo/location.scm
@@ -0,0 +1,69 @@
+;;; location.scm -- Skribilo source location.
+;;;
+;;; Copyright 2003-2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo location)
+  :use-module (oop goops)
+  :use-module ((skribilo utils syntax) :select (%skribilo-module-reader))
+  :export (<location> location? ast-location
+	   location-file location-line location-pos))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; An abstract data type to keep track of source locations.
+;;;
+;;; Code:
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; Class definition.
+;;;
+
+(define-class <location> ()
+  (file :init-keyword :file :getter location-file)
+  (pos  :init-keyword :pos  :getter location-pos)
+  (line :init-keyword :line :getter location-line))
+
+(define (location? obj)
+  (is-a? obj <location>))
+
+(define (ast-location obj)
+  (let ((loc (slot-ref obj 'loc)))
+    (if (location? loc)
+	(let* ((fname (location-file loc))
+	       (line  (location-line loc))
+	       (pwd   (getcwd))
+	       (len   (string-length pwd))
+	       (lenf  (string-length fname))
+	       (file  (if (and (substring=? pwd fname len)
+			       (> lenf len))
+			  (substring fname len (+ 1 (string-length fname)))
+			  fname)))
+	  (format #f "~a, line ~a" file line))
+	"no source location")))
+
+
+;;; arch-tag: d68fa45d-a200-465e-a3c2-eb2861907f83
+
+;;; location.scm ends here.
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
new file mode 100644
index 0000000..ac8eee0
--- /dev/null
+++ b/src/guile/skribilo/module.scm
@@ -0,0 +1,153 @@
+;;; module.scm  --  Integration of Skribe code as Guile modules.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo module)
+  :autoload   (skribilo reader) (make-reader)
+  :use-module (skribilo debug)
+  :use-module (srfi srfi-1)
+  :use-module (ice-9 optargs)
+  :use-module (srfi srfi-39)
+  :use-module (skribilo utils syntax)
+  :export (make-run-time-module *skribilo-user-module*))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This (fake) module defines a macro called `define-skribe-module' which
+;;; allows to package Skribe code (which uses Skribe built-ins and most
+;;; importantly a Skribe syntax) as a Guile module.  This module
+;;; automatically exports the macro as a core binding so that future
+;;; `use-modules' referring to Skribe modules will work as expected.
+;;;
+;;; Code:
+
+(define %skribilo-user-imports
+  ;; List of modules that should be imported by any good Skribilo module.
+  '((srfi srfi-1)         ;; lists
+    (srfi srfi-13)        ;; strings
+    (ice-9 optargs)       ;; `define*'
+
+    (skribilo package base) ;; the core markups
+    (skribilo utils syntax) ;; `unless', `when', etc.
+    (skribilo utils compat) ;; `skribe-load-path', etc.
+    (skribilo utils keywords) ;; `the-body', `the-options'
+    (skribilo utils strings)  ;; `make-string-replace', etc.
+    (skribilo module)
+    (skribilo ast)        ;; `<document>', `document?', etc.
+    (skribilo config)
+    (skribilo biblio)
+    (skribilo lib)        ;; `define-markup', `unwind-protect', etc.
+    (skribilo resolve)
+    (skribilo engine)
+    (skribilo writer)
+    (skribilo output)
+    (skribilo evaluator)
+    (skribilo debug)
+    (skribilo location)
+    ))
+
+(define %skribilo-user-autoloads
+  ;; List of auxiliary modules that may be lazily autoloaded.
+  '(((skribilo engine lout)   . (!lout
+				 lout-illustration
+				 ;; FIXME: The following should eventually be
+				 ;;        removed from here.
+				 lout-structure-number-string))
+    ((skribilo engine latex)  . (!latex LaTeX TeX))
+    ((skribilo engine html)   . (html-markup-class html-class
+				 html-width))
+    ((skribilo utils images)  . (convert-image))
+    ((skribilo index)         . (index? make-index-table default-index
+                                 resolve-the-index))
+    ((skribilo source)        . (source-read-lines source-fontify
+				 language? language-extractor
+				 language-fontifier source-fontify))
+    ((skribilo coloring lisp) . (skribe scheme lisp))
+    ((skribilo coloring xml)  . (xml))
+    ((skribilo prog)          . (make-prog-body resolve-line))
+    ((skribilo color) .
+     (skribe-color->rgb skribe-get-used-colors skribe-use-color!))
+    ((skribilo sui)           . (load-sui))
+
+    ((ice-9 and-let-star)     . (and-let*))
+    ((ice-9 receive)          . (receive))))
+
+
+
+;; The very macro to turn a legacy Skribe file (which uses Skribe's syntax)
+;; into a Guile module.
+
+(define-macro (define-skribe-module name . options)
+  `(begin
+     (define-module ,name
+       :use-module ((skribilo reader) :select (%default-reader))
+       :use-module (srfi srfi-1)
+       ,@(append-map (lambda (mod)
+		       (list :autoload (car mod) (cdr mod)))
+		     %skribilo-user-autoloads)
+       ,@options)
+
+     ;; Pull all the bindings that Skribe code may expect, plus those needed
+     ;; to actually create and read the module.
+     ;; TODO: These should be auto-loaded.
+     ,(cons 'use-modules %skribilo-user-imports)
+
+     ;; Change the current reader to a Skribe-compatible reader.  If this
+     ;; primitive is not provided by Guile (i.e., version <= 1.7.2), then it
+     ;; should be provided by `guile-reader' (version >= 0.3) as a core
+     ;; binding and installed by `(skribilo utils syntax)'.
+     (fluid-set! current-reader %default-reader)))
+
+
+;; Make it available to the top-level module.
+(module-define! the-root-module
+                'define-skribe-module define-skribe-module)
+
+
+
+
+;;;
+;;; MAKE-RUN-TIME-MODULE
+;;;
+(define (make-run-time-module)
+  "Return a new module that imports all the necessary bindings required for
+execution of Skribilo/Skribe code."
+  (let* ((the-module (make-module))
+         (autoloads (map (lambda (name+bindings)
+                           (make-autoload-interface the-module
+                                                    (car name+bindings)
+                                                    (cdr name+bindings)))
+                         %skribilo-user-autoloads)))
+    (set-module-name! the-module '(skribilo-user))
+    (module-use-interfaces! the-module
+                            (cons the-root-module
+                                  (append (map resolve-interface
+                                               %skribilo-user-imports)
+                                          autoloads)))
+    the-module))
+
+;; The current module in which the document is evaluated.
+(define *skribilo-user-module* (make-parameter (make-run-time-module)))
+
+
+;;; module.scm ends here
diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm
new file mode 100644
index 0000000..a33c040
--- /dev/null
+++ b/src/guile/skribilo/output.scm
@@ -0,0 +1,228 @@
+;;; output.scm  --  Skribilo output stage.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+(define-module (skribilo output)
+  :autoload   (skribilo engine) (engine-ident processor-get-engine)
+  :autoload   (skribilo writer) (writer? writer-ident lookup-markup-writer)
+  :autoload   (skribilo location) (location?)
+  :use-module (skribilo ast)
+  :use-module (skribilo debug)
+  :use-module (skribilo utils syntax)
+  :use-module (oop goops)
+
+  :use-module (skribilo condition)
+  :use-module (srfi srfi-35)
+  :use-module (srfi srfi-34)
+  :use-module (srfi srfi-39)
+
+  :export     (output
+	       *document-being-output*
+	       &output-error &output-unresolved-error &output-writer-error
+	       output-error? output-unresolved-error? output-writer-error?))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; Error conditions.
+;;;
+
+(define-condition-type &output-error &skribilo-error
+  output-error?)
+
+(define-condition-type &output-unresolved-error &output-error
+  output-unresolved-error?
+  (ast output-unresolved-error:ast))
+
+(define-condition-type &output-writer-error &output-error
+  output-writer-error?
+  (writer output-writer-error:writer))
+
+
+(define (handle-output-error c)
+  ;; Issue a user-friendly error message for error condition C.
+  (cond ((output-unresolved-error? c)
+	 (let* ((node (output-unresolved-error:ast c))
+		(location (and (ast? node) (ast-loc node))))
+	   (format (current-error-port) "unresolved node: ~a~a~%"
+		   node
+		   (if (location? location)
+		       (string-append " "
+				      (location-file location) ":"
+				      (location-line location))
+		       ""))))
+	((output-writer-error? c)
+	 (format (current-error-port) "invalid writer: ~a~%"
+		 (output-writer-error:writer c)))
+	(else
+	 (format (current-error-port) "undefined output error: ~a~%"
+		 c))))
+
+(register-error-condition-handler! output-error?
+				   handle-output-error)
+
+
+
+;;;
+;;; Output method.
+;;;
+
+;; The document being output.  Note: This is only meant to be used by the
+;; compatibility layer in order to implement things like `find-markups'!
+(define *document-being-output* (make-parameter #f))
+
+(define-generic out)
+
+(define (%out/writer n e w)
+  (with-debug 5 'out/writer
+      (debug-item "n=" n " " (if (markup? n) (markup-markup n) ""))
+      (debug-item "e=" (engine-ident e))
+      (debug-item "w=" (writer-ident w))
+
+      (when (writer? w)
+	(invoke (slot-ref w 'before) n e)
+	(invoke (slot-ref w 'action) n e)
+	(invoke (slot-ref w 'after)  n e))))
+
+
+
+(define (output node e . writer)
+  (with-debug 3 'output
+    (debug-item "node=" node " " (if (markup? node) (markup-markup node) ""))
+    (debug-item "writer=" writer)
+    (if (null? writer)
+	(out node e)
+	(cond
+	  ((is-a? (car writer) <writer>)
+	   (%out/writer node e (car writer)))
+	  ((not (car writer))
+	   (raise (condition (&output-writer-error (writer writer)))))
+	  (else
+	   (raise (condition (&output-writer-error (writer writer)))))))))
+
+
+
+;;;
+;;; OUT implementations
+;;;
+(define-method (out node e)
+  #f)
+
+(define-method (out (node <document>) e)
+  ;; Only needed by the compatibility layer.
+  (parameterize ((*document-being-output* node))
+    (next-method)))
+
+(define-method (out (node <pair>) e)
+  (let loop ((n* node))
+    (cond
+      ((pair? n*)
+       (out (car n*) e)
+       (loop (cdr n*)))
+      ((not (null? n*))
+       (raise (condition (&invalid-argument-error
+			  (proc-name output)
+			  (argument  n*))))))))
+
+
+(define-method (out (node <string>) e)
+  (let ((f (slot-ref e 'filter)))
+    (if (procedure? f)
+	(display (f node))
+	(display node))))
+
+
+(define-method (out (node <number>) e)
+  (out (number->string node) e))
+
+
+(define-method (out (n <processor>) e)
+  (let ((combinator (slot-ref n 'combinator))
+	(engine     (slot-ref n 'engine))
+	(body	    (slot-ref n 'body))
+	(procedure  (slot-ref n 'procedure)))
+    (let ((newe (processor-get-engine combinator engine e)))
+      (out (procedure body newe) newe))))
+
+
+(define-method (out (n <command>) e)
+  (let* ((fmt  (slot-ref n 'fmt))
+	 (body (slot-ref n 'body))
+	 (lb   (length body))
+	 (lf   (string-length fmt)))
+    (define (loops i n)
+      (if (= i lf)
+	  (begin
+	    (if (> n 0)
+		(if (<= n lb)
+		    (output (list-ref body (- n 1)) e)
+		    (raise (condition (&too-few-arguments-error
+				       (proc-name "output<command>")
+				       (arguments n))))))
+	    lf)
+	  (let ((c (string-ref fmt i)))
+	    (cond
+	      ((char=? c #\$)
+	       (display "$")
+	       (+ 1 i))
+	      ((not (char-numeric? c))
+	       (cond
+		 ((= n 0)
+		    i)
+		 ((<= n lb)
+		    (output (list-ref body (- n 1)) e)
+		    i)
+		 (else
+		  (raise (condition (&too-few-arguments-error
+				       (proc-name "output<command>")
+				       (arguments n)))))))
+	      (else
+	       (loops (+ i 1)
+		      (+ (- (char->integer c)
+			    (char->integer #\0))
+			 (* 10 n))))))))
+
+    (let loop ((i 0))
+      (cond
+	((= i lf)
+	 #f)
+	((not (char=? (string-ref fmt i) #\$))
+	 (display (string-ref fmt i))
+	 (loop (+ i 1)))
+	(else
+	 (loop (loops (+ i 1) 0)))))))
+
+
+(define-method (out (n <handle>) e)
+  'unspecified)
+
+
+(define-method (out (n <unresolved>) e)
+  (raise (condition (&output-unresolved-error (ast n)))))
+
+
+(define-method (out (node <markup>) e)
+  (let ((w (lookup-markup-writer node e)))
+    (if (writer? w)
+	(%out/writer node e w)
+	(output (slot-ref node 'body) e))))
diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am
new file mode 100644
index 0000000..693f088
--- /dev/null
+++ b/src/guile/skribilo/package/Makefile.am
@@ -0,0 +1,7 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package
+dist_guilemodule_DATA = acmproc.scm french.scm jfp.scm letter.scm	\
+			lncs.scm scribe.scm sigplan.scm skribe.scm	\
+			slide.scm web-article.scm web-book.scm		\
+			eq.scm pie.scm base.scm
+
+SUBDIRS = slide eq pie
diff --git a/src/guile/skribilo/package/acmproc.scm b/src/guile/skribilo/package/acmproc.scm
new file mode 100644
index 0000000..61eafd5
--- /dev/null
+++ b/src/guile/skribilo/package/acmproc.scm
@@ -0,0 +1,164 @@
+;;; acmproc.scm  --  The Skribe style for ACMPROC articles.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le
+		       'documentclass
+		       "\\documentclass[letterpaper]{acmproc}")
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :before (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (printf "\\numberofauthors{~a}\n\\author{\n"
+			    (if (pair? body) (length body) 1))))
+      :action (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (for-each (lambda (a)
+				 (display "\\alignauthor\n")
+				 (output a e))
+			      (if (pair? body) body (list body)))))
+      :after "}\n")
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (writer-action old-author)))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category le
+      :options '(:index :section :subsection)
+      :before (lambda (n e)
+		 (display "\\category{")
+		 (display (markup-option n :index))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :section))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :subsection))
+		 (display "}\n["))
+      :after "]\n")
+   (markup-writer '&acm-terms le
+      :before "\\terms{"
+      :after "}")
+   (markup-writer '&acm-keywords le
+      :before "\\keywords{"
+      :after "}")
+   (markup-writer '&acm-copyright le
+      :action (lambda (n e)
+		 (display "\\conferenceinfo{")
+		 (output (markup-option n :conference) e)
+		 (display ",} {")
+		 (output (markup-option n :location) e)
+		 (display "}\n")
+		 (display "\\CopyrightYear{")
+		 (output (markup-option n :year) e)
+		 (display "}\n")
+		 (display "\\crdata{")
+		 (output (markup-option n :crdata) e)
+		 (display "}\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-acmproc-abstract he
+      :action (lambda (n e)
+		 (let* ((ebg (engine-custom e 'abstract-background))
+			(bg (or (and (string? ebg) 
+				     (> (string-length ebg) 0))
+				ebg
+				"#cccccc"))
+			(exp (p (center (color :bg bg :width 90. 
+					   (markup-body n))))))
+		    (skribe-eval exp e))))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category :action #f)
+   (markup-writer '&acm-terms :action #f)
+   (markup-writer '&acm-keywords :action #f)
+   (markup-writer '&acm-copyright :action #f))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key (class "abstract") postscript)
+   (if (engine-format? "latex")
+       (section :number #f :title "ABSTRACT" (p (the-body opt)))
+       (let ((a (new markup
+		   (markup '&html-acmproc-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+		       postscript))
+		(section :number #f :toc #f :class class :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+		   (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-category ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-category #!rest opt #!key index section subsection)
+   (new markup
+      (markup '&acm-category)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-terms ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-terms #!rest opt)
+   (new markup
+      (markup '&acm-terms)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-keywords ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-keywords #!rest opt)
+   (new markup
+      (markup '&acm-keywords)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-copyright ...                                                */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-copyright #!rest opt #!key conference location year crdata)
+   (let* ((le (find-engine 'latex))
+	  (cop (format "\\conferenceinfo{~a,} {~a}
+\\CopyrightYear{~a}
+\\crdata{~a}\n" conference location year crdata))
+	  (old (engine-custom le 'predocument)))
+      (if (string? old)
+	  (engine-custom-set! le 'predocument (string-append cop old))
+	  (engine-custom-set! le 'predocument cop))))
+   
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (if (engine-format? "latex")
+	     (font :size -1 (flush :side 'left (the-bibliography)))
+	     (section :title "References"
+                      (font :size -1 (the-bibliography))))))
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
new file mode 100644
index 0000000..bbb2a62
--- /dev/null
+++ b/src/guile/skribilo/package/base.scm
@@ -0,0 +1,1410 @@
+;;; base.scm -- The base markup package of Skribe/Skribilo.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2005, 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo package base)
+  :use-syntax (skribilo lib)
+  :use-syntax (skribilo reader)
+  :use-syntax (skribilo utils syntax)
+  :use-syntax (ice-9 optargs)
+
+  :use-module (skribilo ast)
+  :use-module (skribilo resolve)
+  :use-module (skribilo utils keywords)
+  :autoload   (srfi srfi-1)        (every any filter)
+  :autoload   (skribilo evaluator) (include-document)
+  :autoload   (skribilo engine)    (engine?)
+
+  ;; optional ``sub-packages''
+  :autoload   (skribilo biblio)    (default-bib-table resolve-bib
+                                    bib-load! bib-add!)
+  :autoload   (skribilo color)     (skribe-use-color!)
+  :autoload   (skribilo source)    (language? source-read-lines source-fontify)
+  :autoload   (skribilo prog)      (make-prog-body resolve-line)
+  :autoload   (skribilo index)     (make-index-table)
+
+  :replace (symbol))
+
+(fluid-set! current-reader (make-reader 'skribe))
+
+;;; Author: Manuel Serrano
+;;; Commentary:
+;;;
+;;; This module contains all the core markups of Skribe/Skribilo.
+;;;
+;;; Code:
+
+
+;;; The contents of the file below are (almost) unchanged compared to Skribe
+;;; 1.2d's `api.scm' file found in the `common' directory.
+
+
+
+;*---------------------------------------------------------------------*/
+;*    include ...                                                      */
+;*---------------------------------------------------------------------*/
+(define-markup (include file)
+   (if (not (string? file))
+       (skribe-error 'include "Illegal file (string expected)" file)
+       (include-document file)))
+
+;*---------------------------------------------------------------------*/
+;*    document ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (document #!rest
+			 opts
+			 #!key
+			 (ident #f) (class "document")
+			 (title #f) (html-title #f) (author #f)
+			 (ending #f) (keywords '()) (env '()))
+   (new document
+      (markup 'document)
+      (ident (or ident
+		 (ast->string title)
+		 (symbol->string (gensym "document"))))
+      (class class)
+      (required-options '(:title :author :ending))
+      (options (the-options opts :ident :class :env))
+      (body (the-body opts))
+      (env (append env
+		   (list (list 'chapter-counter 0) (list 'chapter-env '())
+			 (list 'section-counter 0) (list 'section-env '())
+			 (list 'footnote-counter 0) (list 'footnote-env '())
+			 (list 'figure-counter 0) (list 'figure-env '()))))))
+
+;*---------------------------------------------------------------------*/
+;*    keyword-list->comma-separated ...                                */
+;*---------------------------------------------------------------------*/
+(define-public (keyword-list->comma-separated kw*)
+  ;; Turn the the list of keywords (which may be strings or other markups)
+  ;; KW* into a markup where the elements of KW* are comma-separated.  This
+  ;; may commonly be used in handling the `:keywords' option of `document'.
+  (let loop ((kw* kw*) (result '()))
+    (if (null? kw*)
+        (reverse! result)
+        (loop (cdr kw*)
+              (cons* (if (pair? (cdr kw*)) ", " "")
+                     (car kw*) result)))))
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-markup (author #!rest
+		       opts
+		       #!key
+		       (ident #f) (class "author")
+		       name
+		       (title #f)
+		       (affiliation #f)
+		       (email #f)
+		       (url #f)
+		       (address #f)
+		       (phone #f)
+		       (photo #f)
+		       (align 'center))
+   (if (not (memq align '(center left right)))
+       (skribe-error 'author "Illegal align value" align)
+       (new container
+	  (markup 'author)
+	  (ident (or ident (symbol->string (gensym "author"))))
+	  (class class)
+	  (required-options '(:name :title :affiliation :email :url :address :phone :photo :align))
+	  (options `((:name ,name)
+		     (:align ,align)
+		     ,@(the-options opts :ident :class)))
+	  (body #f))))
+
+;*---------------------------------------------------------------------*/
+;*    toc ...                                                          */
+;*---------------------------------------------------------------------*/
+(define-markup (toc #!rest
+		    opts
+		    #!key
+		    (ident #f) (class "toc")
+		    (chapter #t) (section #t) (subsection #f)
+		    (subsubsection #f))
+   (let ((body (the-body opts)))
+      (new container
+	 (markup 'toc)
+	 (ident (or ident (symbol->string (gensym "toc"))))
+	 (class class)
+	 (required-options '())
+	 (options `((:chapter ,chapter)
+		    (:section ,section)
+		    (:subsection ,subsection)
+		    (:subsubsection ,subsubsection)
+		    ,@(the-options opts :ident :class)))
+	 (body (cond
+		  ((null? body)
+		   (new unresolved
+		      (proc (lambda (n e env)
+			       (handle
+				(resolve-search-parent n env document?))))))
+		  ((null? (cdr body))
+		   (if (handle? (car body))
+		       (car body)
+		       (skribe-error 'toc
+				     "Illegal argument (handle expected)"
+				     (if (markup? (car body))
+					 (markup-markup (car body))
+					 "???"))))
+		  (else
+		   (skribe-error 'toc "Illegal argument" body)))))))
+
+;*---------------------------------------------------------------------*/
+;*    chapter ... ...                                                  */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:chapter@                   */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:chapter@                        */
+;*---------------------------------------------------------------------*/
+(define-markup (chapter #!rest
+			opts
+			#!key
+			(ident #f) (class "chapter")
+			title (html-title #f) (file #f) (toc #t) (number #t))
+   (new container
+      (markup 'chapter)
+      (ident (or ident (symbol->string (gensym "chapter"))))
+      (class class)
+      (required-options '(:title :file :toc :number))
+      (options `((:toc ,toc)
+		 (:number ,(and number
+				(new unresolved
+				   (proc (lambda (n e env)
+					    (resolve-counter n
+							     env
+							     'chapter
+							     number))))))
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))
+      (env (list (list 'section-counter 0) (list 'section-env '())
+		 (list 'footnote-counter 0) (list 'footnote-env '())))))
+
+;*---------------------------------------------------------------------*/
+;*    section-number ...                                               */
+;*---------------------------------------------------------------------*/
+(define (section-number number markup)
+   (and number
+	(new unresolved
+	   (proc (lambda (n e env)
+		    (resolve-counter n env markup number))))))
+
+;*---------------------------------------------------------------------*/
+;*    section ...                                                      */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:section@                   */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:sectionr@                       */
+;*---------------------------------------------------------------------*/
+(define-markup (section #!rest
+			opts
+			#!key
+			(ident #f) (class "section")
+			title (file #f) (toc #t) (number #t))
+   (new container
+      (markup 'section)
+      (ident (or ident (symbol->string (gensym "section"))))
+      (class class)
+      (required-options '(:title :toc :file :toc :number))
+      (options `((:number ,(section-number number 'section))
+		 (:toc ,toc)
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))
+      (env (if file
+	       (list (list 'subsection-counter 0) (list 'subsection-env '())
+		     (list 'footnote-counter 0) (list 'footnote-env '()))
+	       (list (list 'subsection-counter 0) (list 'subsection-env '()))))))
+
+;*---------------------------------------------------------------------*/
+;*    subsection ...                                                   */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:subsection@                */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:subsectionr@                    */
+;*---------------------------------------------------------------------*/
+(define-markup (subsection #!rest
+			   opts
+			   #!key
+			   (ident #f) (class "subsection")
+			   title (file #f) (toc #t) (number #t))
+   (new container
+      (markup 'subsection)
+      (ident (or ident (symbol->string (gensym "subsection"))))
+      (class class)
+      (required-options '(:title :toc :file :number))
+      (options `((:number ,(section-number number 'subsection))
+		 (:toc ,toc)
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))
+      (env (list (list 'subsubsection-counter 0) (list 'subsubsection-env '())))))
+
+;*---------------------------------------------------------------------*/
+;*    subsubsection ...                                                */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:subsubsection@             */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:subsubsectionr@                 */
+;*---------------------------------------------------------------------*/
+(define-markup (subsubsection #!rest
+			      opts
+			      #!key
+			      (ident #f) (class "subsubsection")
+			      title (file #f) (toc #f) (number #t))
+   (new container
+      (markup 'subsubsection)
+      (ident (or ident (symbol->string (gensym "subsubsection"))))
+      (class class)
+      (required-options '(:title :toc :number :file))
+      (options `((:number ,(section-number number 'subsubsection))
+		 (:toc ,toc)
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    paragraph ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-simple-markup paragraph)
+
+
+;*---------------------------------------------------------------------*/
+;*    ~ (unbreakable space) ...                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (~ #!rest opts #!key (class #f))
+  (new markup
+     (markup '~)
+     (ident (symbol->string (gensym "~")))
+     (class class)
+     (required-options '())
+     (options (the-options opts :class))
+     (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    footnote ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (footnote #!rest opts
+			 #!key (ident #f) (class "footnote") (label #t))
+   ;; The `:label' option used to be called `:number'.
+   (new container
+      (markup 'footnote)
+      (ident (symbol->string (gensym "footnote")))
+      (class class)
+      (required-options '())
+      (options `((:label
+		  ,(cond ((string? label) label)
+			 ((number? label) label)
+			 ((not label)     label)
+			 (else
+			  (new unresolved
+			       (proc (lambda (n e env)
+					(resolve-counter n env
+							 'footnote #t))))))
+		  ,@(the-options opts :ident :class))))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (linebreak #!rest opts #!key (ident #f) (class #f))
+   (let ((ln (new markup
+		(ident (or ident (symbol->string (gensym "linebreak"))))
+		(class class)
+		(markup 'linebreak)))
+	 (num (the-body opts)))
+      (cond
+	 ((null? num)
+	  ln)
+	 ((not (null? (cdr num)))
+	  (skribe-error 'linebreak "Illegal arguments" num))
+	 ((not (and (integer? (car num)) (positive? (car num))))
+	  (skribe-error 'linebreak "Illegal argument" (car num)))
+	 (else
+	  (vector->list (make-vector (car num) ln))))))
+
+;*---------------------------------------------------------------------*/
+;*    hrule ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (hrule #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      (width 100.) (height 1))
+   (new markup
+      (markup 'hrule)
+      (ident (or ident (symbol->string (gensym "hrule"))))
+      (class class)
+      (required-options '())
+      (options `((:width ,width)
+		 (:height ,height)
+		 ,@(the-options opts :ident :class)))
+      (body #f)))
+
+;*---------------------------------------------------------------------*/
+;*    color ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (color #!rest
+		      opts
+		      #!key
+		      (ident #f) (class "color")
+		      (bg #f) (fg #f) (width #f) (margin #f))
+   (new container
+      (markup 'color)
+      (ident (or ident (symbol->string (gensym "color"))))
+      (class class)
+      (required-options '(:bg :fg :width))
+      (options `((:bg ,(if bg (skribe-use-color! bg) bg))
+		 (:fg ,(if fg (skribe-use-color! fg) fg))
+		 ,@(the-options opts :ident :class :bg :fg)))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (frame #!rest
+		      opts
+		      #!key
+		      (ident #f) (class "frame")
+		      (width #f) (margin 2) (border 1))
+   (new container
+      (markup 'frame)
+      (ident (or ident (symbol->string (gensym "frame"))))
+      (class class)
+      (required-options '(:width :border :margin))
+      (options `((:margin ,margin)
+		 (:border ,(cond
+			      ((integer? border) border)
+			      (border 1)
+			      (else #f)))
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    font ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (font #!rest
+		     opts
+		     #!key
+		     (ident #f) (class #f)
+		     (size #f) (face #f))
+   (new container
+      (markup 'font)
+      (ident (or ident (symbol->string (gensym "font"))))
+      (class class)
+      (required-options '(:size))
+      (options (the-options opts :ident :class))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    flush ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (flush #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      side)
+   (case side
+      ((center left right)
+       (new container
+	  (markup 'flush)
+	  (ident (or ident (symbol->string (gensym "flush"))))
+	  (class class)
+	  (required-options '(:side))
+	  (options (the-options opts :ident :class))
+	  (body (the-body opts))))
+      (else
+       (skribe-error 'flush "Illegal side" side))))
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-simple-container center)
+
+;*---------------------------------------------------------------------*/
+;*    pre ...                                                          */
+;*---------------------------------------------------------------------*/
+(define-simple-container pre)
+
+;*---------------------------------------------------------------------*/
+;*    prog ...                                                         */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/prgm.skb:prog@                            */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:prog@                           */
+;*---------------------------------------------------------------------*/
+(define-markup (prog #!rest
+		     opts
+		     #!key
+		     (ident #f) (class "prog")
+		     (line 1) (linedigit #f) (mark ";!"))
+   (if (not (or (string? mark) (eq? mark #f)))
+       (skribe-error 'prog "Illegal mark" mark)
+       (new container
+	  (markup 'prog)
+	  (ident (or ident (symbol->string (gensym "prog"))))
+	  (class class)
+	  (required-options '(:line :mark))
+	  (options (the-options opts :ident :class :linedigit))
+	  (body (make-prog-body (the-body opts) line linedigit mark)))))
+
+;*---------------------------------------------------------------------*/
+;*    source ...                                                       */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/prgm.skb:source@                          */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:source@                         */
+;*---------------------------------------------------------------------*/
+(define-markup (source #!rest
+		       opts
+		       #!key
+		       language
+		       (file #f) (start #f) (stop #f)
+		       (definition #f) (tab 8))
+   (let ((body (the-body opts)))
+      (cond
+	 ((and (not (null? body)) (or file start stop definition))
+	  (skribe-error 'source
+			"file, start/stop, and definition are exclusive with body"
+			body))
+	 ((and start stop definition)
+	  (skribe-error 'source
+			"start/stop are exclusive with a definition"
+			body))
+	 ((and (or start stop definition) (not file))
+	  (skribe-error 'source
+			"start/stop and definition require a file specification"
+			file))
+	 ((and definition (not language))
+	  (skribe-error 'source
+			"definition requires a language specification"
+			definition))
+	 ((and file (not (string? file)))
+	  (skribe-error 'source "Illegal file" file))
+	 ((and start (not (or (integer? start) (string? start))))
+	  (skribe-error 'source "Illegal start" start))
+	 ((and stop (not (or (integer? stop) (string? stop))))
+	  (skribe-error 'source "Illegal start" stop))
+	 ((and (integer? start) (integer? stop) (> start stop))
+	  (skribe-error 'source
+			"start line > stop line"
+			(format #f "~a/~a" start stop)))
+	 ((and language (not (language? language)))
+	  (skribe-error 'source "illegal language" language))
+	 ((and tab (not (integer? tab)))
+	  (skribe-error 'source "illegal tab" tab))
+	 (file
+	  (let ((s (if (not definition)
+		       (source-read-lines file start stop tab)
+		       (source-read-definition file definition tab language))))
+	     (if language
+		 (source-fontify s language)
+		 s)))
+	 (language
+	  (source-fontify body language))
+	 (else
+	  body))))
+
+;*---------------------------------------------------------------------*/
+;*    language ...                                                     */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/prgm.skb:language@                        */
+;*---------------------------------------------------------------------*/
+(define-markup (language #!key name (fontifier #f) (extractor #f))
+   (if (not (string? name))
+       (skribe-type-error 'language "illegal name" name "string")
+       (new language
+	  (name name)
+	  (fontifier fontifier)
+	  (extractor extractor))))
+
+;*---------------------------------------------------------------------*/
+;*    figure ...                                                       */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/figure.skb:figure@                        */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:figure@                         */
+;*---------------------------------------------------------------------*/
+(define-markup (figure #!rest
+		       opts
+		       #!key
+		       (ident #f) (class "figure")
+		       (legend #f) (number #t) (multicolumns #f))
+   (new container
+      (markup 'figure)
+      (ident (or ident
+		 (let ((s (ast->string legend)))
+		    (if (not (string=? s ""))
+			s
+			(symbol->string (gensym "figure"))))))
+      (class class)
+      (required-options '(:legend :number :multicolumns))
+      (options `((:number
+		  ,(new unresolved
+		      (proc (lambda (n e env)
+			       (resolve-counter n env 'figure number)))))
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    parse-list-of ...                                                */
+;*    -------------------------------------------------------------    */
+;*    The function table accepts two different prototypes. It          */
+;*    may receive its N elements in a list of N elements or in         */
+;*    a list of one element which is a list of N elements. This        */
+;*    gets rid of APPLY when calling container markup such as ITEMIZE  */
+;*    or TABLE.                                                        */
+;*---------------------------------------------------------------------*/
+(define (parse-list-of for markup lst)
+   (cond
+      ((null? lst)
+       '())
+      ((and (pair? lst)
+	    (or (pair? (car lst)) (null? (car lst)))
+	    (null? (cdr lst)))
+       (parse-list-of for markup (car lst)))
+      (else
+       (let loop ((lst lst)
+		  (result '()))
+	  (cond
+	     ((null? lst)
+	      (reverse! result))
+	     ((pair? (car lst))
+	      (loop (car lst) result))
+	     (else
+	      (let ((r (car lst)))
+		 (if (not (is-markup? r markup))
+		     (skribe-warning 2
+				     for
+				     (format #f "illegal `~a' element, `~a' expected"
+					     (if (markup? r)
+						 (markup-markup r)
+						 (type-name r))
+					     markup)))
+		 (loop (cdr lst) (cons r result)))))))))
+
+;*---------------------------------------------------------------------*/
+;*    itemize ...                                                      */
+;*---------------------------------------------------------------------*/
+(define-markup (itemize #!rest opts #!key (ident #f) (class "itemize") symbol)
+   (new container
+      (markup 'itemize)
+      (ident (or ident (symbol->string (gensym "itemize"))))
+      (class class)
+      (required-options '(:symbol))
+      (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+      (body (parse-list-of 'itemize 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    enumerate ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (enumerate #!rest opts #!key (ident #f) (class "enumerate") symbol)
+   (new container
+      (markup 'enumerate)
+      (ident (or ident (symbol->string (gensym "enumerate"))))
+      (class class)
+      (required-options '(:symbol))
+      (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+      (body (parse-list-of 'enumerate 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    description ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (description #!rest opts #!key (ident #f) (class "description") symbol)
+   (new container
+      (markup 'description)
+      (ident (or ident (symbol->string (gensym "description"))))
+      (class class)
+      (required-options '(:symbol))
+      (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+      (body (parse-list-of 'description 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    item ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (item #!rest opts #!key (ident #f) (class #f) key)
+   (if (and key (not (or (string? key)
+			 (number? key)
+			 (markup? key)
+			 (pair? key))))
+       (skribe-type-error 'item "Illegal key:" key "node")
+       (new container
+	  (markup 'item)
+	  (ident (or ident (symbol->string (gensym "item"))))
+	  (class class)
+	  (required-options '(:key))
+	  (options `((:key ,key) ,@(the-options opts :ident :class :key)))
+	  (body (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    table                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (table #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      (border #f) (width #f)
+		      (frame 'none) (rules 'none)
+		      (cellstyle 'collapse) (cellpadding #f) (cellspacing #f))
+   (let ((frame (cond
+		   ((string? frame)
+		    (string->symbol frame))
+		   ((not frame)
+		    #f)
+		   (else
+		    frame)))
+	 (rules (cond
+		   ((string? rules)
+		    (string->symbol rules))
+		   ((not rules)
+		    #f)
+		   (else
+		    rules)))
+	 (frame-vals '(none above below hsides vsides lhs rhs box border))
+	 (rules-vals '(none rows cols all header))
+	 (cells-vals '(collapse separate)))
+      (cond
+	 ((and frame (not (memq frame frame-vals)))
+	  (skribe-error 'table
+			(format #f "frame should be one of \"~a\"" frame-vals)
+			frame))
+	 ((and rules (not (memq rules rules-vals)))
+	  (skribe-error 'table
+			(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 #f "cellstyle should be one of \"~a\", or a number, or a string" cells-vals)
+			cellstyle))
+	 (else
+	  (new container
+	     (markup 'table)
+	     (ident (or ident (symbol->string (gensym "table"))))
+	     (class class)
+	     (required-options '(:width :frame :rules))
+	     (options `((:frame ,frame)
+			(:rules ,rules)
+			(:cellstyle ,cellstyle)
+			,@(the-options opts :ident :class)))
+	     (body (parse-list-of 'table 'tr (the-body opts))))))))
+
+;*---------------------------------------------------------------------*/
+;*    tr ...                                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (tr #!rest opts #!key (ident #f) (class #f) (bg #f))
+   (new container
+      (markup 'tr)
+      (ident (or ident (symbol->string (gensym "tr"))))
+      (class class)
+      (required-options '())
+      (options `(,@(if bg `((:bg ,(if bg (skribe-use-color! bg) bg))) '())
+		 ,@(the-options opts :ident :class :bg)))
+      (body (parse-list-of 'tr 'tc (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    tc...                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (tc m
+		   #!rest
+		   opts
+		   #!key
+		   (ident #f) (class #f)
+		   (width #f) (align 'center) (valign #f)
+		   (colspan 1) (rowspan 1) (bg #f))
+   (let ((align (if (string? align)
+		    (string->symbol align)
+		    align))
+	 (valign (if (string? valign)
+		     (string->symbol valign)
+		     valign)))
+      (cond
+	 ((not (integer? colspan))
+	  (skribe-type-error 'tc "Illegal colspan, " colspan "integer"))
+	 ((not (symbol? align))
+	  (skribe-type-error 'tc "Illegal align, " align "align"))
+	 ((not (memq align '(#f center left right)))
+	  (skribe-error
+	   'tc
+	   "align should be one of 'left', `center', or `right'"
+	   align))
+	 ((not (memq valign '(#f top middle center bottom)))
+	  (skribe-error
+	   'tc
+	   "valign should be one of 'top', `middle', `center', or `bottom'"
+	   valign))
+	 (else
+	  (new container
+	     (markup 'tc)
+	     (ident (or ident (symbol->string (gensym "tc"))))
+	     (class class)
+	     (required-options '(:width :align :valign :colspan))
+	     (options `((markup ,m)
+			(:align ,align)
+			(:valign ,valign)
+			(:colspan ,colspan)
+			,@(if bg
+			      `((:bg ,(if bg (skribe-use-color! bg) bg)))
+			      '())
+			,@(the-options opts :ident :class :bg :align :valign)))
+	     (body (the-body opts)))))))
+
+;*---------------------------------------------------------------------*/
+;*    th ...                                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (th #!rest
+		   opts
+		   #!key
+		   (ident #f) (class #f)
+		   (width #f) (align 'center) (valign #f)
+		   (colspan 1) (rowspan 1) (bg #f))
+   (apply tc 'th opts))
+
+;*---------------------------------------------------------------------*/
+;*    td ...                                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (td #!rest
+		   opts
+		   #!key
+		   (ident #f) (class #f)
+		   (width #f) (align 'center) (valign #f)
+		   (colspan 1) (rowspan 1) (bg #f))
+   (apply tc 'td opts))
+
+;*---------------------------------------------------------------------*/
+;*    image ...                                                        */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/image.skb:image@                          */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:image@                          */
+;*       latex: @ref ../../skr/latex.skr:image@                        */
+;*---------------------------------------------------------------------*/
+(define-markup (image #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      file (url #f) (width #f) (height #f) (zoom #f))
+   (cond
+      ((not (or (string? file) (string? url)))
+       (skribe-error 'image "No file or url provided" file))
+      ((and (string? file) (string? url))
+       (skribe-error 'image "Both file and url provided" (list file url)))
+      (else
+       (new markup
+	  (markup 'image)
+	  (ident (or ident (symbol->string (gensym "image"))))
+	  (class class)
+	  (required-options '(:file :url :width :height))
+	  (options (the-options opts :ident :class))
+	  (body (the-body opts))))))
+
+;*---------------------------------------------------------------------*/
+;*    blockquote                                                       */
+;*---------------------------------------------------------------------*/
+(define-simple-markup blockquote)
+
+;*---------------------------------------------------------------------*/
+;*    Ornaments ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-simple-markup roman)
+(define-simple-markup bold)
+(define-simple-markup underline)
+(define-simple-markup strike)
+(define-simple-markup emph)
+(define-simple-markup kbd)
+(define-simple-markup it)
+(define-simple-markup tt)
+(define-simple-markup code)
+(define-simple-markup var)
+(define-simple-markup samp)
+(define-simple-markup sf)
+(define-simple-markup sc)
+(define-simple-markup sub)
+(define-simple-markup sup)
+
+;*---------------------------------------------------------------------*/
+;*    char ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (char char)
+   (cond
+      ((char? char)
+       (string char))
+      ((integer? char)
+       (string (integer->char char)))
+      ((and (string? char) (= (string-length char) 1))
+       char)
+      (else
+       (skribe-error 'char "Illegal char" char))))
+
+;*---------------------------------------------------------------------*/
+;*    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))))
+
+;*---------------------------------------------------------------------*/
+;*    ! ...                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (! format #!rest node)
+   (if (not (string? format))
+       (skribe-type-error '! "Illegal format:" format "string")
+       (new command
+	  (fmt format)
+	  (body node))))
+
+;*---------------------------------------------------------------------*/
+;*    processor ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (processor #!rest opts
+			  #!key (combinator #f) (engine #f) (procedure #f))
+   (cond
+      ((and combinator (not (procedure? combinator)))
+       (skribe-error 'processor "Combinator not a procedure" combinator))
+      ((and engine (not (engine? engine)))
+       (skribe-error 'processor "Illegal engine" engine))
+      ((and procedure
+	    (or (not (procedure? procedure))
+		(not (let ((a (procedure-property procedure 'arity)))
+                       (and (pair? a)
+                            (let ((compulsory (car a))
+                                  (optional   (cadr a))
+                                  (rest?      (caddr a)))
+                              (or rest?
+                                  (>= (+ compulsory optional) 2))))))))
+       (skribe-error 'processor "Illegal procedure" procedure))
+      (else
+       (new processor
+	  (combinator combinator)
+	  (engine engine)
+	  (procedure (or procedure (lambda (n e) n)))
+	  (body (the-body opts))))))
+
+;*---------------------------------------------------------------------*/
+;*    Processors ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-processor-markup html-processor)
+(define-processor-markup tex-processor)
+
+;*---------------------------------------------------------------------*/
+;*    handle ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-markup (handle #!rest opts
+		       #!key (ident #f) (class "handle") value section)
+   (let ((body (the-body opts)))
+      (cond
+	 (section
+	  (error 'handle "Illegal handle `section' option" section)
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (let ((s (resolve-ident section 'section n env)))
+			 (new handle
+			    (ast s)))))))
+	 ((and (pair? body)
+	       (null? (cdr body))
+	       (markup? (car body)))
+	  (new handle
+	     (ast (car body))))
+	 (else
+	  (skribe-error 'handle "Illegal handle" opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    mailto ...                                                       */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/links.skb:mailto@                         */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:mailto@                         */
+;*---------------------------------------------------------------------*/
+(define-markup (mailto #!rest opts #!key (ident #f) (class "mailto") text)
+   (new markup
+      (markup 'mailto)
+      (ident (or ident (symbol->string (gensym "ident"))))
+      (class class)
+      (required-options '(:text))
+      (options (the-options opts :ident :class))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    *mark-table* ...                                                 */
+;*---------------------------------------------------------------------*/
+(define *mark-table* (make-hash-table))
+
+;*---------------------------------------------------------------------*/
+;*    mark ...                                                         */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/links.skb:mark@                           */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:mark@                           */
+;*---------------------------------------------------------------------*/
+(define-markup (mark #!rest opts #!key (ident #f) (class "mark") (text #f))
+   (let ((bd (the-body opts)))
+      (cond
+	 ((and (pair? bd) (not (null? (cdr bd))))
+	  (skribe-error 'mark "Too many argument provided" bd))
+	 ((null? bd)
+	  (skribe-error 'mark "Missing argument" '()))
+	 ((not (string? (car bd)))
+	  (skribe-type-error 'mark "Illegal ident:" (car bd) "string"))
+	 (ident
+	  (skribe-error 'mark "Illegal `ident:' option" ident))
+	 (else
+	  (let* ((bs (ast->string bd))
+		 (n (new markup
+		       (markup 'mark)
+		       (ident (symbol->string (gensym bs)))
+		       (class class)
+		       (options (the-options opts :ident :class :text))
+		       (body text))))
+	     (hash-set! *mark-table* bs n)
+	     n)))))
+
+;*---------------------------------------------------------------------*/
+;*    ref ...                                                          */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/links.skb:ref@                            */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:ref@                            */
+;*       latex: @ref ../../skr/latex.skr:ref@                          */
+;*---------------------------------------------------------------------*/
+(define-markup (ref #!rest
+		    opts
+		    #!key
+		    (class #f)
+		    (ident #f)
+		    (text #f)
+		    (chapter #f)
+		    (section #f)
+		    (subsection #f)
+		    (subsubsection #f)
+		    (bib #f)
+		    (bib-table (default-bib-table))
+		    (url #f)
+		    (figure #f)
+		    (mark #f)
+		    (handle #f)
+		    (line #f)
+		    (skribe #f)
+		    (page #f))
+   (define (unref ast text kind)
+      (let ((msg (format #f "can't find `~a': " kind)))
+	 (if (ast? ast)
+	     (begin
+		(skribe-warning/ast 1 ast 'ref msg text)
+		(new markup
+		   (markup 'unref)
+		   (ident (symbol->string (gensym "unref")))
+		   (class class)
+		   (required-options '(:text))
+		   (options `((kind ,kind) ,@(the-options opts :ident :class)))
+		   (body (list text ": " (ast->file-location ast)))))
+	     (begin
+		(skribe-warning 1 'ref msg text)
+		(new markup
+		   (markup 'unref)
+		   (ident (symbol->string (gensym "unref")))
+		   (class class)
+		   (required-options '(:text))
+		   (options `((kind ,kind) ,@(the-options opts :ident :class)))
+		   (body text))))))
+   (define (skribe-ref skribe)
+      (let ((path (find-file/path skribe (skribe-path))))
+	 (if (not path)
+	     (unref #f skribe 'sui-file)
+	     (let* ((sui (load-sui path))
+		    (os (the-options opts :skribe :class :text))
+		    (u (sui-ref->url (dirname path) sui ident os)))
+		(if (not u)
+		    (unref #f os 'sui-ref)
+		    (ref :url u :text text :ident ident :class class))))))
+   (define (handle-ref text)
+      (new markup
+	 (markup 'ref)
+	 (ident (symbol->string (gensym "handle-ref")))
+	 (class class)
+	 (required-options '(:text))
+	 (options `((kind handle) ,@(the-options opts :ident :class)))
+	 (body text)))
+   (define (do-title-ref title kind)
+      (if (not (string? title))
+	  (skribe-type-error 'ref "illegal reference" title "string")
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (let* ((doc (ast-document n))
+                             (s (find1-down
+                                 (lambda (n)
+                                   (and (is-markup? n kind)
+                                        (equal? (markup-option n :title)
+                                                title)))
+                                 doc)))
+			 (if s
+			     (new markup
+				(markup 'ref)
+				(ident (symbol->string (gensym "title-ref")))
+				(class class)
+				(required-options '(:text))
+				(options `((kind ,kind)
+					   (mark ,title)
+					   ,@(the-options opts :ident :class)))
+				(body (new handle
+					 (ast s))))
+			     (unref n title (or kind 'title)))))))))
+   (define (do-ident-ref text kind)
+      (if (not (string? text))
+	  (skribe-type-error 'ref "Illegal reference" text "string")
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (let ((s (resolve-ident text kind n env)))
+			 (if s
+			     (new markup
+				(markup 'ref)
+				(ident (symbol->string (gensym "ident-ref")))
+				(class class)
+				(required-options '(:text))
+				(options `((kind ,kind)
+					   (mark ,text)
+					   ,@(the-options opts :ident :class)))
+				(body (new handle
+					 (ast s))))
+			     (unref n text (or kind 'ident)))))))))
+   (define (mark-ref mark)
+      (if (not (string? mark))
+	  (skribe-type-error 'mark "Illegal mark, " mark "string")
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (let ((s (hash-ref *mark-table* mark)))
+			 (if s
+			     (new markup
+				(markup 'ref)
+				(ident (symbol->string (gensym "mark-ref")))
+				(class class)
+				(required-options '(:text))
+				(options `((kind mark)
+					   (mark ,mark)
+					   ,@(the-options opts :ident :class)))
+				(body (new handle
+					 (ast s))))
+			     (unref n mark 'mark))))))))
+   (define (make-bib-ref v)
+      (let ((s (resolve-bib bib-table v)))
+	 (if s
+	     (let* ((n (new markup
+			  (markup 'bib-ref)
+			  (ident (symbol->string (gensym "bib-ref")))
+			  (class class)
+			  (required-options '(:text))
+			  (options (the-options opts :ident :class))
+			  (body (new handle
+				   (ast s)))))
+		    (h (new handle (ast n)))
+		    (o (markup-option s 'used)))
+		(markup-option-add! s 'used (if (pair? o) (cons h o) (list h)))
+		n)
+	     (unref #f v 'bib)))) ; FIXME: This prevents source location
+				  ; info to be provided in the warning msg
+   (define (bib-ref text)
+      (if (pair? text)
+	  (new markup
+	     (markup 'bib-ref+)
+	     (ident (symbol->string (gensym "bib-ref+")))
+	     (class class)
+	     (options (the-options opts :ident :class))
+	     (body (map make-bib-ref text)))
+	  (make-bib-ref text)))
+   (define (url-ref)
+      (new markup
+	 (markup 'url-ref)
+	 (ident (symbol->string (gensym "url-ref")))
+	 (class class)
+	 (required-options '(:url :text))
+	 (options (the-options opts :ident :class))))
+   (define (line-ref line)
+      (new unresolved
+	 (proc  (lambda (n e env)
+		   (let ((l (resolve-line line)))
+		      (if (pair? l)
+			  (new markup
+			     (markup 'line-ref)
+			     (ident (symbol->string (gensym "line-ref")))
+			     (class class)
+			     (options `((:text ,(markup-ident (car l)))
+					,@(the-options opts :ident :class)))
+			     (body (new handle
+				      (ast (car l)))))
+			  (unref n line 'line)))))))
+   (let ((b (the-body opts)))
+      (if (not (null? b))
+	  (skribe-warning 1 'ref "Arguments ignored " b))
+      (cond
+	 (skribe (skribe-ref skribe))
+	 (handle (handle-ref handle))
+	 (ident (do-ident-ref ident #f))
+	 (chapter (do-title-ref chapter 'chapter))
+	 (section (do-title-ref section 'section))
+	 (subsection (do-title-ref subsection 'subsection))
+	 (subsubsection (do-title-ref subsubsection 'subsubsection))
+	 (figure (do-ident-ref figure 'figure))
+	 (mark (mark-ref mark))
+	 (bib (bib-ref bib))
+	 (url (url-ref))
+	 (line (line-ref line))
+	 (else (skribe-error 'ref "illegal reference" opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve ...                                                      */
+;*---------------------------------------------------------------------*/
+(define-markup (resolve fun)
+   (new unresolved
+      (proc fun)))
+
+;*---------------------------------------------------------------------*/
+;*    bibliography ...                                                 */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/bib.skb:bibliography@                     */
+;*---------------------------------------------------------------------*/
+(define-markup (bibliography #!rest files
+			     #!key
+			     (command #f) (bib-table (default-bib-table)))
+   (for-each (lambda (f)
+		(cond
+		   ((string? f)
+		    (bib-load! bib-table f command))
+		   ((pair? f)
+		    (bib-add! bib-table f))
+		   (else
+		    (skribe-error "bibliography" "Illegal entry" f))))
+	     (the-body files)))
+
+;*---------------------------------------------------------------------*/
+;*    the-bibliography ...                                             */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/bib.skb:the-bibliography@                 */
+;*    writer:                                                          */
+;*       base: @ref ../../skr/base.skr:the-bibliography@               */
+;*---------------------------------------------------------------------*/
+(define-markup (the-bibliography #!rest opts
+				 #!key
+				 pred
+				 (bib-table (default-bib-table))
+				 (sort bib-sort/authors)
+				 (count 'partial))
+   (if (not (memq count '(partial full)))
+       (skribe-error 'the-bibliography
+		     "Cound must be either `partial' or `full'"
+		     count)
+       (new unresolved
+	  (proc (lambda (n e env)
+		   (resolve-the-bib bib-table
+				    (new handle (ast n))
+				    sort
+				    pred
+				    count
+				    (the-options opts)))))))
+
+;*---------------------------------------------------------------------*/
+;*    make-index ...                                                   */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/index.skb:make-index@                     */
+;*---------------------------------------------------------------------*/
+(define-markup (make-index ident)
+   (make-index-table ident))
+
+;*---------------------------------------------------------------------*/
+;*    index ...                                                        */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/index.skb:index@                          */
+;*---------------------------------------------------------------------*/
+(define-markup (index #!rest
+		      opts
+		      #!key
+		      (ident #f) (class "index")
+		      (note #f) (index #f) (shape #f)
+		      (url #f))
+   (let* ((entry-name (the-body opts))
+	  (ename (cond
+		    ((string? entry-name)
+		     entry-name)
+		    ((and (pair? entry-name) (every string? entry-name))
+		     (apply string-append entry-name))
+		    (else
+		     (skribe-error
+		      'index
+		      "entry-name must be either a string or a list of strings"
+		      entry-name))))
+	  (table (cond
+		    ((not index) (default-index))
+		    ((index? index) index)
+		    (else (skribe-type-error 'index
+					     "Illegal index table, "
+					     index
+					     "index"))))
+	  (m (mark (symbol->string (gensym "mark"))))
+	  (h (new handle (ast m)))
+	  (new (new markup
+		  (markup '&index-entry)
+		  (ident (or ident (symbol->string (gensym "index"))))
+		  (class class)
+		  (options `((name ,ename) ,@(the-options opts :ident :class)))
+		  (body (if url
+			    (ref :url url :text (or shape ename))
+			    (ref :handle h :text (or shape ename)))))))
+      ;; New is bound to a dummy option of the mark in order
+      ;; to make new options verified.
+      (markup-option-add! m 'to-verify new)
+
+      (let ((handle (hash-get-handle table ename)))
+        (if (not handle)
+            (hash-set! table ename (list new))
+            (set-cdr! handle (cons new (cdr handle)))))
+
+      m))
+
+;*---------------------------------------------------------------------*/
+;*    the-index ...                                                    */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/index.skb:the-index@                      */
+;*    writer:                                                          */
+;*       base: @ref ../../skr/base.skr:the-index@                      */
+;*       html: @ref ../../skr/html.skr:the-index-header@               */
+;*---------------------------------------------------------------------*/
+(define-markup (the-index #!rest
+			  opts
+			  #!key
+			  (ident #f)
+			  (class "the-index")
+			  (split #f)
+			  (char-offset 0)
+			  (header-limit 50)
+			  (column 1))
+   (let ((bd (the-body opts)))
+      (cond
+	 ((not (and (integer? char-offset) (>= char-offset 0)))
+	  (skribe-error 'the-index "Illegal char offset" char-offset))
+	 ((not (integer? column))
+	  (skribe-error 'the-index "Illegal column number" column))
+	 ((not (every index? bd))
+	  (skribe-error 'the-index
+			"Illegal indexes"
+			(filter (lambda (o) (not (index? o))) bd)))
+	 (else
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (resolve-the-index (ast-loc n)
+					 ident class
+					 bd
+					 split
+					 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/package/eq.scm b/src/guile/skribilo/package/eq.scm
new file mode 100644
index 0000000..4f5020e
--- /dev/null
+++ b/src/guile/skribilo/package/eq.scm
@@ -0,0 +1,439 @@
+;;; eq.scm  --  An equation formatting package.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo package eq)
+  :autoload   (skribilo ast)    (markup?)
+  :autoload   (skribilo output) (output)
+  :use-module (skribilo writer)
+  :use-module (skribilo engine)
+  :use-module (skribilo lib)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo module)
+  :use-module (skribilo utils keywords) ;; `the-options', etc.
+  :autoload   (skribilo package base) (it symbol sub sup)
+  :autoload   (skribilo engine lout) (lout-illustration)
+  :use-module (ice-9 optargs))
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This package defines a set of markups for formatting equations.  The user
+;;; may either use the standard Scheme prefix notation to represent
+;;; equations, or directly use the specific markups (which looks more
+;;; verbose).
+;;;
+;;; FIXME: This is incomplete.
+;;;
+;;; Code:
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Utilities.
+;;;
+
+(define %operators
+  '(/ * + - = != ~= < > <= >= sqrt expt sum product script
+    in notin apply))
+
+(define %symbols
+  ;; A set of symbols that are automatically recognized within an `eq' quoted
+  ;; list.
+  '(;; lower-case Greek
+    alpha beta gamma delta epsilon zeta eta theta iota kappa
+    lambda mu nu xi omicron pi rho sigma tau upsilon phi chi omega
+
+    ;; upper-case Greek
+    Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa
+    Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Omega
+
+    ;; Hebrew
+    alef
+
+    ;; mathematics
+    ellipsis weierp image real forall partial exists
+    emptyset infinity in notin nabla nipropto angle and or cap cup
+    sim cong approx neq equiv le ge subset supset subseteq supseteq
+    oplus otimes perp mid lceil rceil lfloor rfloor langle rangle))
+
+
+(define (make-fast-member-predicate lst)
+  (let ((h (make-hash-table)))
+    ;; initialize a hash table equivalent to LST
+    (for-each (lambda (s) (hashq-set! h s #t)) lst)
+
+    ;; the run-time, fast, definition
+    (lambda (sym)
+      (hashq-ref h sym #f))))
+
+(define-public known-operator? (make-fast-member-predicate %operators))
+(define-public known-symbol? (make-fast-member-predicate %symbols))
+
+(define-public equation-markup-name?
+  (make-fast-member-predicate (map (lambda (s)
+				     (symbol-append 'eq: s))
+				   %operators)))
+
+(define-public (equation-markup? m)
+  "Return true if @var{m} is an instance of one of the equation sub-markups."
+  (and (markup? m)
+       (equation-markup-name? (markup-markup m))))
+
+(define-public (equation-markup-name->operator m)
+  "Given symbol @var{m} (an equation markup name, e.g., @code{eq:+}), return
+a symbol representing the mathematical operator denoted by @var{m} (e.g.,
+@code{+})."
+  (if (equation-markup-name? m)
+      (string->symbol (let ((str (symbol->string m)))
+			(substring str
+				   (+ 1 (string-index str #\:))
+				   (string-length str))))
+      #f))
+
+
+;;;
+;;; Operator precedence.
+;;;
+
+(define %operator-precedence
+  ;; FIXME: This needs to be augmented.
+  '((+ . 1)
+    (- . 1)
+    (* . 2)
+    (/ . 2)
+    (sum . 3)
+    (product . 3)
+    (= . 0)
+    (< . 0)
+    (> . 0)
+    (<= . 0)
+    (>= . 0)))
+
+(define-public (operator-precedence op)
+  (let ((p (assq op %operator-precedence)))
+    (if (pair? p) (cdr p) 0)))
+
+
+
+;;;
+;;; Turning an S-exp into an `eq' markup.
+;;;
+
+(define %rebindings
+  (map (lambda (sym)
+	 (list sym (symbol-append 'eq: sym)))
+       %operators))
+
+(define (eq:symbols->strings equation)
+  "Turn symbols located in non-@code{car} positions into strings."
+  (cond ((list? equation)
+	 (if (or (null? equation) (null? (cdr equation)))
+	     equation
+	     (cons (car equation) ;; XXX: not tail-recursive
+		   (map eq:symbols->strings (cdr equation)))))
+	((symbol? equation)
+	 (if (known-symbol? equation)
+	     `(symbol ,(symbol->string equation))
+	     (symbol->string equation)))
+	(else equation)))
+
+(define-public (eq-evaluate equation)
+  "Evaluate @var{equation}, an sexp (list) representing an equation, e.g.
+@code{'(+ a (/ b 3))}."
+  (eval `(let ,%rebindings ,(eq:symbols->strings equation))
+	(current-module)))
+
+
+
+;;;
+;;; Markup.
+;;;
+
+(define-markup (eq :rest opts :key (ident #f) (inline? #f)
+		                   (renderer #f) (class "eq"))
+  (new markup
+       (markup 'eq)
+       (ident (or ident (symbol->string (gensym "eq"))))
+       (options (the-options opts))
+       (body (let loop ((body (the-body opts))
+			(result '()))
+	       (if (null? body)
+		   result
+		   (loop (cdr body)
+			 (if (markup? (car body))
+			     (car body)  ;; the `eq:*' markups were used
+					 ;; directly
+			     (eq-evaluate (car body))) ;; a quoted list was
+						       ;; passed
+			     ))))))
+
+(define-simple-markup eq:/)
+(define-simple-markup eq:*)
+(define-simple-markup eq:+)
+(define-simple-markup eq:-)
+
+(define-simple-markup eq:=)
+(define-simple-markup eq:!=)
+(define-simple-markup eq:~=)
+(define-simple-markup eq:<)
+(define-simple-markup eq:>)
+(define-simple-markup eq:>=)
+(define-simple-markup eq:<=)
+
+(define-simple-markup eq:sqrt)
+(define-simple-markup eq:expt)
+
+(define-markup (eq:sum :rest opts :key (ident #f) (class "eq:sum")
+		                       (from #f) (to #f))
+  (new markup
+       (markup 'eq:sum)
+       (ident (or ident (symbol->string (gensym "eq:sum"))))
+       (options (the-options opts))
+       (body (the-body opts))))
+
+(define-markup (eq:product :rest opts :key (ident #f) (class "eq:product")
+			                   (from #f) (to #f))
+  (new markup
+       (markup 'eq:product)
+       (ident (or ident (symbol->string (gensym "eq:product"))))
+       (options (the-options opts))
+       (body (the-body opts))))
+
+(define-markup (eq:script :rest opts :key (ident #f) (class "eq:script")
+			                  (sub #f) (sup #f))
+  (new markup
+       (markup 'eq:script)
+       (ident (or ident (symbol->string (gensym "eq:script"))))
+       (options (the-options opts))
+       (body (the-body opts))))
+
+(define-simple-markup eq:in)
+(define-simple-markup eq:notin)
+
+(define-markup (eq:apply :rest opts :key (ident #f) (class "eq:apply"))
+  ;; This markup may receive either a list of arguments or arguments
+  ;; compatible with the real `apply'.  Note: the real `apply' can take N
+  ;; non-list arguments but the last one has to be a list.
+  (new markup
+       (markup 'eq:apply)
+       (ident (or ident (symbol->string (gensym "eq:apply"))))
+       (options (the-options opts))
+       (body (let loop ((body (the-body opts))
+			(result '()))
+	       (if (null? body)
+		   (reverse! result)
+		   (let ((first (car body)))
+		     (if (list? first)
+			 (if (null? (cdr body))
+			     (append (reverse! result) first)
+			     (skribe-error 'eq:apply
+					   "wrong argument type"
+					   body))
+			 (loop (cdr body) (cons first result)))))))))
+
+
+
+;;;
+;;; Text-based rendering.
+;;;
+
+
+(markup-writer 'eq (find-engine 'base)
+   :action (lambda (node engine)
+	     ;; The `:renderer' option should be a symbol (naming an engine
+	     ;; class) or an engine or engine class.  This allows the use of
+	     ;; another engine to render equations.  For instance, equations
+	     ;; may be rendered using the Lout engine within an HTML
+	     ;; document.
+	     (let ((renderer (markup-option node :renderer)))
+	       (cond ((not renderer) ;; default: use the current engine
+		      (output (it (markup-body node)) engine))
+		     ((symbol? renderer)
+		      (case renderer
+			;; FIXME: We should have an `embed' slot for each
+			;; engine class similar to `lout-illustration'.
+			((lout)
+			 (let ((lout-code
+				(with-output-to-string
+				  (lambda ()
+				    (output node (find-engine 'lout))))))
+			   (output (lout-illustration
+				    :ident (markup-ident node)
+				    lout-code)
+				   engine)))
+			(else
+			 (skribe-error 'eq "invalid renderer" renderer))))
+		     ;; FIXME: `engine?' and `engine-class?'
+		     (else
+		      (skribe-error 'eq "`:renderer' -- wrong argument type"
+				    renderer))))))
+
+(define-macro (simple-markup-writer op . obj)
+  ;; Note: The text-only rendering is less ambiguous if we parenthesize
+  ;; without taking operator precedence into account.
+  (let ((precedence (operator-precedence op)))
+    `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
+       :action (lambda (node engine)
+		  (let loop ((operands (markup-body node)))
+		   (if (null? operands)
+		       #t
+		       (let* ((o (car operands))
+			      (nested-eq? (equation-markup? o))
+			      (need-paren?
+			       (and nested-eq?
+; 				    (< (operator-precedence
+; 					(equation-markup-name->operator
+; 					 (markup-markup o)))
+; 				       ,precedence)
+				    )
+			       ))
+
+			 (display (if need-paren? "(" ""))
+			 (output o engine)
+			 (display (if need-paren? ")" ""))
+			 (if (pair? (cdr operands))
+			     (begin
+			       (display " ")
+			       (output ,(if (null? obj)
+					    (symbol->string op)
+					    (car obj))
+				       engine)
+			       (display " ")))
+			 (loop (cdr operands)))))))))
+
+(simple-markup-writer +)
+(simple-markup-writer -)
+(simple-markup-writer /)
+(simple-markup-writer * (symbol "times"))
+
+(simple-markup-writer =)
+(simple-markup-writer != (symbol "neq"))
+(simple-markup-writer ~= (symbol "approx"))
+(simple-markup-writer <)
+(simple-markup-writer >)
+(simple-markup-writer >= (symbol "ge"))
+(simple-markup-writer <= (symbol "le"))
+
+(markup-writer 'eq:sqrt (find-engine 'base)
+   :action (lambda (node engine)
+	     (display "sqrt(")
+	     (output (markup-body node) engine)
+	     (display ")")))
+
+(define-macro (simple-binary-markup-writer op obj)
+  `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
+     :action (lambda (node engine)
+	       (let ((body (markup-body node)))
+		 (if (= (length body) 2)
+		     (let ((first (car body))
+			   (second (cadr body)))
+		       (display (if (equation-markup? first) "(" " "))
+		       (output first engine)
+		       (display (if (equation-markup? first) ")" " "))
+		       (output ,obj engine)
+		       (display (if (equation-markup? second) "(" ""))
+		       (output second engine)
+		       (display (if (equation-markup? second) ")" "")))
+		     (skribe-error ',(symbol-append 'eq: op)
+				   "wrong argument type"
+				   body))))))
+
+(markup-writer 'eq:expt (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((body (markup-body node)))
+		 (if (= (length body) 2)
+		     (let ((first (car body))
+			   (second (cadr body)))
+		       (display (if (equation-markup? first) "(" ""))
+		       (output first engine)
+		       (display (if (equation-markup? first) ")" ""))
+		       (output (sup second) engine))))))
+
+(simple-binary-markup-writer in    (symbol "in"))
+(simple-binary-markup-writer notin (symbol "notin"))
+
+(markup-writer 'eq:apply (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((func (car (markup-body node))))
+	       (output func engine)
+	       (display "(")
+	       (let loop ((operands (cdr (markup-body node))))
+		 (if (null? operands)
+		     #t
+		     (begin
+		       (output (car operands) engine)
+		       (if (not (null? (cdr operands)))
+			   (display ", "))
+		       (loop (cdr operands)))))
+	       (display ")"))))
+
+(markup-writer 'eq:sum (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((from (markup-option node :from))
+		   (to (markup-option node :to)))
+	       (output (symbol "Sigma") engine)
+	       (display "(")
+	       (output from engine)
+	       (display ", ")
+	       (output to engine)
+	       (display ", ")
+	       (output (markup-body node) engine)
+	       (display ")"))))
+
+(markup-writer 'eq:prod (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((from (markup-option node :from))
+		   (to (markup-option node :to)))
+	       (output (symbol "Pi") engine)
+	       (display "(")
+	       (output from engine)
+	       (display ", ")
+	       (output to engine)
+	       (display ", ")
+	       (output (markup-body node) engine)
+	       (display ")"))))
+
+(markup-writer 'eq:script (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((body (markup-body node))
+		   (sup* (markup-option node :sup))
+		   (sub* (markup-option node :sub)))
+	       (output body engine)
+	       (output (sup sup*) engine)
+	       (output (sub sub*) engine))))
+
+
+
+
+;;;
+;;; Initialization.
+;;;
+
+(when-engine-is-loaded 'lout
+  (lambda ()
+    (resolve-module '(skribilo package eq lout))))
+
+
+;;; arch-tag: 58764650-2684-47a6-8cc7-6288f2b474da
+
+;;; eq.scm ends here
diff --git a/src/guile/skribilo/package/eq/Makefile.am b/src/guile/skribilo/package/eq/Makefile.am
new file mode 100644
index 0000000..c7b4f93
--- /dev/null
+++ b/src/guile/skribilo/package/eq/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package/eq
+dist_guilemodule_DATA = lout.scm
+
+## arch-tag: 3e816c9a-7989-4baa-b38b-a095a5428ba1
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
new file mode 100644
index 0000000..c487b85
--- /dev/null
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -0,0 +1,217 @@
+;;; lout.scm  --  Lout implementation of the `eq' package.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo package eq lout)
+  :use-module (skribilo package eq)
+  :use-module (skribilo ast)
+  :autoload   (skribilo output) (output)
+  :use-module (skribilo writer)
+  :use-module (skribilo engine)
+  :use-module (skribilo lib)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo utils keywords) ;; `the-options', etc.
+  :use-module (ice-9 optargs))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Initialization.
+;;;
+
+(let ((lout (find-engine 'lout)))
+  (if (not lout)
+      (skribe-error 'eq "Lout engine not found" lout)
+      (let ((includes (engine-custom lout 'includes)))
+	;; Append the `eq' include file
+	(engine-custom-set! lout 'includes
+			    (string-append includes "\n"
+					   "@SysInclude { eq }\n")))))
+
+
+;;;
+;;; Simple markup writers.
+;;;
+
+
+(markup-writer 'eq (find-engine 'lout)
+   :options '(:inline?)
+   :before "{ "
+   :action (lambda (node engine)
+	     (display (if (markup-option node :inline?)
+			  "@E { "
+			  "@Eq { "))
+	     (let ((eq (markup-body node)))
+	       ;;(fprint (current-error-port) "eq=" eq)
+	       (output eq engine)))
+   :after  " } }")
+
+
+
+(define-macro (simple-lout-markup-writer sym . args)
+  (let* ((lout-name (if (null? args)
+			(symbol->string sym)
+			(car args)))
+	 (parentheses? (if (or (null? args) (null? (cdr args)))
+			   #t
+			   (cadr args)))
+	 (precedence (operator-precedence sym))
+
+	 ;; Note: We could use `pmatrix' here but it precludes line-breaking
+	 ;; within equations.
+	 (open-par `(if need-paren? "{ @VScale ( }" ""))
+	 (close-par `(if need-paren? "{ @VScale ) }" "")))
+
+    `(markup-writer ',(symbol-append 'eq: sym)
+		    (find-engine 'lout)
+		    :action (lambda (node engine)
+			      (let loop ((operands (markup-body node)))
+				(if (null? operands)
+				    #t
+				    (let* ((op (car operands))
+					   (eq-op? (equation-markup? op))
+					   (need-paren?
+					    (and eq-op?
+						 (< (operator-precedence
+						     (equation-markup-name->operator
+						      (markup-markup op)))
+						    ,precedence)))
+					   (column (port-column
+						    (current-output-port))))
+
+				      ;; Work around Lout's limitations...
+				      (if (> column 1000) (display "\n"))
+
+				      (display (string-append " { "
+							      ,(if parentheses?
+								   open-par
+								   "")))
+				      (output op engine)
+				      (display (string-append ,(if parentheses?
+								   close-par
+								   "")
+							      " }"))
+				      (if (pair? (cdr operands))
+					  (display ,(string-append " "
+								   lout-name
+								   " ")))
+				      (loop (cdr operands)))))))))
+
+
+;; `+' and `*' have higher precedence than `-', `/', `=', etc., so their
+;; operands do not need to be enclosed in parentheses.  OTOH, since we use a
+;; horizontal bar of `/', we don't need to parenthesize its arguments.
+
+
+(simple-lout-markup-writer +)
+(simple-lout-markup-writer * "times")
+(simple-lout-markup-writer - "-")
+(simple-lout-markup-writer / "over" #f)
+(simple-lout-markup-writer =)
+(simple-lout-markup-writer <)
+(simple-lout-markup-writer >)
+(simple-lout-markup-writer <=)
+(simple-lout-markup-writer >=)
+
+(define-macro (binary-lout-markup-writer sym lout-name)
+  `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+     :action (lambda (node engine)
+	       (let ((body (markup-body node)))
+		 (if (= (length body) 2)
+		     (let* ((first (car body))
+			    (second (cadr body))
+			    (parentheses? (equation-markup? first)))
+		       (display " { { ")
+		       (if parentheses? (display "("))
+		       (output first engine)
+		       (if parentheses? (display ")"))
+		       (display ,(string-append " } " lout-name " { "))
+		       (output second engine)
+		       (display " } } "))
+		     (skribe-error ,(symbol-append 'eq: sym)
+				   "wrong number of arguments"
+				   body))))))
+
+(binary-lout-markup-writer expt "sup")
+(binary-lout-markup-writer in "element")
+(binary-lout-markup-writer notin "notelement")
+
+(markup-writer 'eq:apply (find-engine 'lout)
+   :action (lambda (node engine)
+	     (let ((func (car (markup-body node))))
+	       (output func engine)
+	       (display "(")
+	       (let loop ((operands (cdr (markup-body node))))
+		 (if (null? operands)
+		     #t
+		     (begin
+		       (output (car operands) engine)
+		       (if (not (null? (cdr operands)))
+			   (display ", "))
+		       (loop (cdr operands)))))
+	       (display ")"))))
+
+
+
+;;;
+;;; Sums, products, integrals, etc.
+;;;
+
+(define-macro (range-lout-markup-writer sym lout-name)
+  `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+      :action (lambda (node engine)
+		(let ((from (markup-option node :from))
+		      (to (markup-option node :to))
+		      (body (markup-body node)))
+		  (display ,(string-append " { big " lout-name
+					   " from { "))
+		  (output from engine)
+		  (display " } to { ")
+		  (output to engine)
+		  (display " } { ")
+		  (output body engine)
+		  (display " } } ")))))
+
+(range-lout-markup-writer sum "sum")
+(range-lout-markup-writer product "prod")
+
+(markup-writer 'eq:script (find-engine 'lout)
+   :action (lambda (node engine)
+	     (let ((body (markup-body node))
+		   (sup (markup-option node :sup))
+		   (sub (markup-option node :sub)))
+	       (display " { { ")
+	       (output body engine)
+	       (display " } ")
+	       (if sup
+		   (begin
+		     (display (if sub " supp { " " sup { "))
+		     (output sup engine)
+		     (display " } ")))
+	       (if sub
+		   (begin
+		     (display " on { ")
+		     (output sub engine)
+		     (display " } ")))
+	       (display " } "))))
+
+
+;;; arch-tag: 2a1410e5-977e-4600-b781-3d57f4409b35
diff --git a/src/guile/skribilo/package/french.scm b/src/guile/skribilo/package/french.scm
new file mode 100644
index 0000000..a23d1da
--- /dev/null
+++ b/src/guile/skribilo/package/french.scm
@@ -0,0 +1,30 @@
+;;; french.scm  --  French Skribe style
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package french))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX configuration                                              */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'usepackage
+		       (string-append (engine-custom le 'usepackage)
+				      "\\usepackage[french]{babel}
+\\usepackage{a4}")))
diff --git a/src/guile/skribilo/package/jfp.scm b/src/guile/skribilo/package/jfp.scm
new file mode 100644
index 0000000..913b3e3
--- /dev/null
+++ b/src/guile/skribilo/package/jfp.scm
@@ -0,0 +1,328 @@
+;;; jfp.scm  --  The Skribe style for JFP articles.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package jfp))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'documentclass "\\documentclass{jfp}")
+   (engine-custom-set! le 'hyperref #f)
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :action (lambda (n e)
+		 (define (&latex-subauthor)
+		    (let* ((d (ast-document n))
+			   (sa (and (is-markup? d 'document)
+				    (markup-option d :head-author))))
+		       (if sa
+			   (begin
+			      (display "[")
+			      (output sa e)
+			      (display "]")))))
+		 (define (&latex-author-1 n)
+		    (display "\\author")
+		    (&latex-subauthor)
+		    (display "{\n")
+		    (output n e)
+		    (display "}\n"))
+		 (define (&latex-author-n n)
+		    (display "\\author")
+		    (&latex-subauthor)
+		    (display "{\n")
+		    (output (car n) e)
+		    (for-each (lambda (a)
+				 (display "\\and ")
+				 (output a e))
+			      (cdr n))
+		    (display "}\n"))
+		 (let ((body (markup-body n)))
+		    (cond
+		       ((is-markup? body 'author)
+			(&latex-author-1 body))
+		       ((and (list? body)
+			     (every? (lambda (b) (is-markup? b 'author))
+				     body))
+			(&latex-author-n body))
+		       (else
+			(skribe-error 'author
+				      "Illegal `jfp' author"
+				      body))))))
+   ;; title
+   (markup-writer '&latex-title le
+      :before (lambda (n e)
+		 (let* ((d (ast-document n))
+			(st (and (is-markup? d 'document)
+				 (markup-option d :head-title))))
+		    (if st
+			(begin
+			   (display "\\title[")
+			   (output st e)
+			   (display "]{"))
+			(display "\\title{"))))
+      :after "}\n")
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (lambda (n e)
+		    (let ((name (markup-option n :name))
+			  (aff (markup-option n :affiliation))
+			  (addr (markup-option n :address))
+			  (email (markup-option n :email)))
+		       (if name
+			   (begin
+			      (output name e)
+			      (display "\\\\\n")))
+		       (if aff
+			   (begin
+			      (output aff e)
+			      (display "\\\\\n")))
+		       (if addr
+			   (begin
+			      (if (pair? addr)
+				  (for-each (lambda (a)
+					       (output a e)
+					       (display "\\\\\n"))
+					    addr)
+				  (begin
+				     (output addr e)
+				     (display "\\\\\n")))))
+		       (if email
+			   (begin
+			      (display "\\email{")
+			      (output email e)
+			      (display "}\\\\\n")))))))
+   ;; bib-ref
+   (markup-writer 'bib-ref le
+      :options '(:bib :text :key)
+      :before "("
+      :action (lambda (n e)
+		 (let ((be (handle-ast (markup-body n))))
+		    (if (is-markup? be '&bib-entry)
+			(let ((a (markup-option be 'author))
+			      (y (markup-option be 'year)))
+			   (cond
+			      ((and (is-markup? a '&bib-entry-author)
+				    (is-markup? y '&bib-entry-year))
+			       (let ((ba (markup-body a)))
+				  (if (not (string? ba))
+				      (output ba e)
+				      (let* ((s1 (pregexp-replace* " and "
+								   ba
+								   " \\& "))
+					     (s2 (pregexp-replace* ", [^ ]+"
+								   s1
+								   "")))
+					 (output s2 e)
+					 (display ", ")
+					 (output y e)))))
+			      ((is-markup? y '&bib-entry-year)
+			       (skribe-error 'bib-ref
+					     "Missing `name' entry"
+					     (markup-ident be)))
+			      (else
+			       (let ((ba (markup-body a)))
+				  (if (not (string? ba))
+				      (output ba e)
+				      (let* ((s1 (pregexp-replace* " and "
+								   ba
+								   " \\& "))
+					     (s2 (pregexp-replace* ", [^ ]+"
+								   s1
+								   "")))
+					 (output s2 e)))))))
+			(skribe-error 'bib-ref
+				      "Illegal bib-ref"
+				      (markup-ident be)))))
+      :after ")")
+      ;; bib-ref/text
+   (markup-writer 'bib-ref le
+      :options '(:bib :text :key)
+      :predicate (lambda (n e)
+		    (markup-option n :key))
+      :action (lambda (n e)
+		 (output (markup-option n :key) e)))
+   ;; &the-bibliography
+   (markup-writer '&the-bibliography le
+      :before (lambda (n e)
+		 (display "{%
+\\sloppy
+\\sfcode`\\.=1000\\relax
+\\newdimen\\bibindent
+\\bibindent=0em
+\\begin{list}{}{%
+        \\settowidth\\labelwidth{[]}%
+        \\leftmargin\\labelwidth
+        \\advance\\leftmargin\\labelsep
+        \\advance\\leftmargin\\bibindent
+        \\itemindent -\\bibindent
+        \\listparindent \\itemindent
+    }%\n"))
+      :after (lambda (n e)
+		(display "\n\\end{list}}\n")))
+   ;; bib-entry
+   (markup-writer '&bib-entry le
+      :options '(:title)
+      :action (lambda (n e)
+		 (output n e (markup-writer-get '&bib-entry-body e)))
+      :after "\n")
+   ;; %bib-entry-title
+   (markup-writer '&bib-entry-title le
+      :action (lambda (n e)
+		 (output (markup-body n) e)))
+   ;; %bib-entry-body
+   (markup-writer '&bib-entry-body le
+      :action (lambda (n e)
+		 (define (output-fields descr)
+		    (display "\\item[")
+		    (let loop ((descr descr)
+			       (pending #f)
+			       (armed #f)
+			       (first #t))
+		       (cond
+			  ((null? descr)
+			   'done)
+			  ((pair? (car descr))
+			   (if (eq? (caar descr) 'or)
+			       (let ((o1 (cadr (car descr))))
+				  (if (markup-option n o1)
+				      (loop (cons o1 (cdr descr)) 
+					    pending 
+					    #t
+					    #f)
+				      (let ((o2 (caddr (car descr))))
+					 (loop (cons o2 (cdr descr)) 
+					       pending
+					       armed
+					       #f))))
+			       (let ((o (markup-option n (cadr (car descr)))))
+				  (if o
+				      (begin
+					 (if (and pending armed)
+					     (output pending e))
+					 (output (caar descr) e)
+					 (output o e)
+					 (if (pair? (cddr (car descr)))
+					     (output (caddr (car descr)) e))
+					 (loop (cdr descr) #f #t #f))
+				      (loop (cdr descr) pending armed #f)))))
+			  ((symbol? (car descr))
+			   (let ((o (markup-option n (car descr))))
+			      (if o 
+				  (begin
+				     (if (and armed pending)
+					 (output pending e))
+				     (output o e)
+				     (if first
+					 (display "]"))
+				     (loop (cdr descr) #f #t #f))
+				  (loop (cdr descr) pending armed #f))))
+			  ((null? (cdr descr))
+			   (output (car descr) e))
+			  ((string? (car descr))
+			   (loop (cdr descr) 
+				 (if pending pending (car descr))
+				 armed
+				 #f))
+			  (else
+			   (skribe-error 'output-bib-fields
+					 "Illegal description"
+					 (car descr))))))
+		 (output-fields
+		  (case (markup-option n 'kind)
+		     ((techreport)
+		      `(author (" (" year ")") " " (or title url) ". " 
+			       number ", " institution ", "
+			       address ", " month ", "
+			       ("pp. " pages) "."))
+		     ((article)
+		      `(author (" (" year ")") " " (or title url) ". "
+			       journal ", " volume ", " ("(" number ")") ", "
+			       address ", " month ", " 
+			       ("pp. " pages) "."))
+		     ((inproceedings)
+		      `(author (" (" year ")") " " (or title url) ". " 
+			       book(or title url) ", " series ", " ("(" number ")") ", "
+			       address ", " month ", " 
+			       ("pp. " pages) "."))
+		     ((book)
+		      '(author (" (" year ")") " " (or title url) ". " 
+			       publisher ", " address
+			       ", " month ", " ("pp. " pages) "."))
+		     ((phdthesis)
+		      '(author (" (" year ")") " " (or title url) ". " type ", " 
+			       school ", " address
+			       ", " month "."))
+		     ((misc)
+		      '(author (" (" year ")") " " (or title url) ". "
+			       publisher ", " address
+			       ", " month "."))
+		     (else
+		      '(author (" (" year ")") " " (or title url) ". "
+			       publisher ", " address
+			       ", " month ", " ("pp. " pages) "."))))))
+   ;; abstract
+   (markup-writer 'jfp-abstract le
+       :options '(postscript)
+       :before "\\begin{abstract}\n"
+       :after "\\end{abstract}\n"))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-jfp-abstract he
+      :action (lambda (n e)
+		 (let* ((bg (engine-custom e 'abstract-background))
+                        (exp (p (if bg
+				    (center (color :bg bg :width 90. 
+					       (it (markup-body n))))
+				    (it (markup-body n))))))
+                    (skribe-eval exp e)))))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key postscript)
+   (if (engine-format? "latex")
+       (new markup
+	  (markup 'jfp-abstract)
+	  (body (p (the-body opt))))
+       (let ((a (new markup
+		   (markup '&html-jfp-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+                             postscript))
+		(section :number #f :toc #f :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+                         (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (section :title "References" :class "references"
+	    :number (not (engine-format? "latex"))
+	    (font :size -1 (the-bibliography)))))
+
diff --git a/src/guile/skribilo/package/letter.scm b/src/guile/skribilo/package/letter.scm
new file mode 100644
index 0000000..91d45be
--- /dev/null
+++ b/src/guile/skribilo/package/letter.scm
@@ -0,0 +1,157 @@
+;;; letter.scm  --  Skribe style for letters
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package letter))
+
+;*---------------------------------------------------------------------*/
+;*    document                                                         */
+;*---------------------------------------------------------------------*/
+(define %letter-document document)
+
+(define-markup (document #!rest opt 
+		  #!key (ident #f) (class "letter") 
+		  where date author
+		  &skribe-eval-location)
+   (let* ((ubody (the-body opt))
+	  (body (list (new markup
+			 (markup '&letter-where)
+			 (loc &skribe-eval-location)
+			 (options `((:where ,where)
+				    (:date ,date)
+				    (:author ,author))))
+		      ubody)))
+      (apply %letter-document
+	     :author #f :title #f 
+	     (append (apply append 
+			    (the-options opt :where :date :author :title))
+		     body))))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX configuration                                              */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'documentclass "\\documentclass[12pt]{letter}\n")
+   (engine-custom-set! le 'maketitle #f)
+   ;; &letter-where
+   (markup-writer '&letter-where le
+      :before "\\begin{raggedright}\n"
+      :action (lambda (n e)
+		 (let* ((w (markup-option n :where))
+			(d (markup-option n :date))
+			(a (markup-option n :author))
+			(hd (if (and w d)
+				(list w ", " d)
+				(or w d)))
+			(ne (copy-engine 'author e)))
+		    ;; author
+		    (markup-writer 'author ne
+		       :options '(:name :title :affiliation :email :url :address :phone :photo :align :header)
+		       :action (lambda (n e)
+				  (let ((name (markup-option n :name))
+					(title (markup-option n :title))
+					(affiliation (markup-option n :affiliation))
+					(email (markup-option n :email))
+					(url (markup-option n :url))
+					(address (markup-option n :address))
+					(phone (markup-option n :phone)))
+				     (define (row n)
+					(output n e)
+					(when hd
+					   (display "\\hfill ")
+					   (output hd e)
+					   (set! hd #f))
+					(display "\\\\\n"))
+				     ;; name
+				     (if name (row name))
+				     ;; title
+				     (if title (row title))
+				     ;; affiliation
+				     (if affiliation (row affiliation))
+				     ;; address
+				     (if (pair? address)
+					 (for-each row address))
+				     ;; telephone
+				     (if phone (row phone))
+				     ;; email
+				     (if email (row email))
+				     ;; url
+				     (if url (row url)))))
+		    ;; emit the author
+		    (if a 
+			(output a ne)
+			(output hd e))))
+      :after "\\end{raggedright}\n\\vspace{1cm}\n\n"))
+		 
+;*---------------------------------------------------------------------*/
+;*    HTML configuration                                               */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   ;; &letter-where
+   (markup-writer '&letter-where he
+      :before "<table width=\"100%\">\n"
+      :action (lambda (n e)
+		 (let* ((w (markup-option n :where))
+			(d (markup-option n :date))
+			(a (markup-option n :author))
+			(hd (if (and w d)
+				(list w ", " d)
+				(or w d)))
+			(ne (copy-engine 'author e)))
+		    ;; author
+		    (markup-writer 'author ne
+		       :options '(:name :title :affiliation :email :url :address :phone :photo :align :header)
+		       :action (lambda (n e)
+				  (let ((name (markup-option n :name))
+					(title (markup-option n :title))
+					(affiliation (markup-option n :affiliation))
+					(email (markup-option n :email))
+					(url (markup-option n :url))
+					(address (markup-option n :address))
+					(phone (markup-option n :phone)))
+				     (define (row n)
+					(display "<tr><td align='left'>")
+					(output n e)
+					(when hd
+					   (display "</td><td align='right'>")
+					   (output hd e)
+					   (set! hd #f))
+					(display "</td></tr>\n"))
+				     ;; name
+				     (if name (row name))
+				     ;; title
+				     (if title (row title))
+				     ;; affiliation
+				     (if affiliation (row affiliation))
+				     ;; address
+				     (if (pair? address)
+					 (for-each row address))
+				     ;; telephone
+				     (if phone (row phone))
+				     ;; email
+				     (if email (row email))
+				     ;; url
+				     (if url (row url)))))
+		    ;; emit the author
+		    (if a 
+			(output a ne)
+			(output hd e))))
+      :after "</table>\n<hr>\n\n"))
+		 
+
diff --git a/src/guile/skribilo/package/lncs.scm b/src/guile/skribilo/package/lncs.scm
new file mode 100644
index 0000000..8ffa7da
--- /dev/null
+++ b/src/guile/skribilo/package/lncs.scm
@@ -0,0 +1,158 @@
+;;; lncs.scm  --  The Skribe style for LNCS articles.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package lncs))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'documentclass "\\documentclass{llncs}")
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :action (lambda (n e)
+		 (define (&latex-inst-body n)
+		    (let ((affiliation (markup-option n :affiliation))
+			  (address (markup-option n :address)))
+		       (when affiliation (output affiliation e) (display ", "))
+		       (when address
+			  (for-each (lambda (a) (output a e) (display " "))
+				    address)
+			  (newline))))
+		 (define (&latex-inst-n i)
+		    (display "\\institute{\n")
+		    (&latex-inst-body (car i))
+		    (for-each (lambda (n)
+				 (display "\\and\n")
+				 (&latex-inst-body n))
+			      (cdr i))
+		    (display "}\n"))
+		 (define (&latex-author-1 n)
+		    (display "\\author{\n")
+		    (output n e)
+		    (display "}\n"))
+		 (define (&latex-author-n n)
+		    (display "\\author{\n")
+		    (output (car n) e)
+		    (for-each (lambda (a)
+				 (display " and ")
+				 (output a e))
+			      (cdr n))
+		    (display "}\n"))
+		 (let ((body (markup-body n)))
+		    (cond
+		       ((is-markup? body 'author)
+			(markup-option-add! n 'inst 1)
+			(&latex-author-1 body)
+			(&latex-inst-n (list body)))
+		       ((and (list? body)
+			     (every? (lambda (b) (is-markup? b 'author))
+				     body))
+			(define (institute=? n1 n2)
+			   (let ((aff1 (markup-option n1 :affiliation))
+				 (add1 (markup-option n1 :address))
+				 (aff2 (markup-option n2 :affiliation))
+				 (add2 (markup-option n2 :address)))
+			      (and (equal? aff1 aff2) (equal? add1 add2))))
+			(define (search-institute n i j)
+			   (cond
+			      ((null? i)
+			       #f)
+			      ((institute=? n (car i))
+			       j)
+			      (else
+			       (search-institute n (cdr i) (- j 1)))))
+			(if (null? (cdr body))
+			    (begin
+			       (markup-option-add! (car body) 'inst 1)
+			       (&latex-author-1 (car body))
+			       (&latex-inst-n body))
+			    ;; collect the institutes
+			    (let loop ((ns body)
+				       (is '())
+				       (j 1))
+			       (if (null? ns)
+				   (begin
+				      (&latex-author-n body)
+				      (&latex-inst-n (reverse! is)))
+				   (let* ((n (car ns))
+					  (si (search-institute n is (- j 1))))
+				      (if (integer? si)
+					  (begin
+					     (markup-option-add! n 'inst si)
+					     (loop (cdr ns) is j))
+					  (begin
+					     (markup-option-add! n 'inst j)
+					     (loop (cdr ns)
+						   (cons n is)
+						   (+ 1 j)))))))))
+		       (else
+			(skribe-error 'author
+				      "Illegal `lncs' author"
+				      body))))))
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (lambda (n e)
+		    (let ((name (markup-option n :name))
+			  (title (markup-option n :title))
+			  (inst (markup-option n 'inst)))
+		       (if name (output name e))
+		       (if title (output title e))
+		       (if inst (printf "\\inst{~a}\n" inst)))))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-lncs-abstract he
+      :action (lambda (n e)
+		 (let* ((bg (or (engine-custom e 'abstract-background)
+				"#cccccc"))
+			(exp (p (center (color :bg bg :width 90. 
+					   (markup-body n))))))
+		    (skribe-eval exp e)))))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key postscript)
+   (if (engine-format? "latex")
+       (section :number #f :title "ABSTRACT" (p (the-body opt)))
+       (let ((a (new markup
+		   (markup '&html-lncs-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+		       postscript))
+		(section :number #f :toc #f :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+		   (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (if (engine-format? "latex")
+	     (font :size -1 (flush :side 'left (the-bibliography)))
+	     (section :title "References"
+                      (font :size -1 (the-bibliography))))))
diff --git a/src/guile/skribilo/package/pie.scm b/src/guile/skribilo/package/pie.scm
new file mode 100644
index 0000000..8ccf858
--- /dev/null
+++ b/src/guile/skribilo/package/pie.scm
@@ -0,0 +1,314 @@
+;;; pie.scm  --  An pie-chart formatting package.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo package pie)
+  :autoload   (skribilo ast)    (markup? markup-ident ast-parent)
+  :autoload   (skribilo output) (output)
+  :use-module (skribilo writer)
+  :use-module (skribilo engine)
+  :use-module (skribilo lib)            ;; `skribe-error' et al.
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo utils keywords) ;; `the-options', etc.
+  :use-module (skribilo utils strings)  ;; `make-string-replace'
+  :use-module (skribilo module)
+  :autoload   (skribilo color)        (skribe-color->rgb)
+  :autoload   (skribilo package base) (bold)
+  :autoload   (skribilo engine lout)  (lout-illustration)
+  :autoload   (ice-9 popen)           (open-output-pipe)
+  :use-module (ice-9 optargs)
+  :export     (%ploticus-program %ploticus-debug?
+               pie-sliceweight-value pie-remove-markup))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Markup.
+;;;
+
+(define-markup (pie :rest opts
+		    :key (ident #f) (title "Pie Chart")
+		    (initial-angle 0) (total #f) (radius 3)
+		    (fingers? #t) (labels 'outside)
+		    (class "pie"))
+   (new container
+	(markup 'pie)
+	(ident (or ident (symbol->string (gensym "pie"))))
+	(options (the-options opts))
+	(body (the-body opts))))
+
+(define-markup (slice :rest opts
+		      :key (ident #f) (weight 1) (color "white") (detach? #f))
+   (new container
+	(markup 'slice)
+	(ident (or ident (symbol->string (gensym "slice"))))
+	(weight weight)
+	(color color)
+	(detach? detach?)
+	(options (the-options opts))
+	(body (the-body opts))))
+
+(define-markup (sliceweight :rest opts
+			    :key (ident #f) (percentage? #f))
+   (new markup
+	(markup 'sliceweight)
+	(ident (or ident (symbol->string (gensym "sliceweight"))))
+	(percentage? percentage?)
+	(options (the-options opts))
+	(body '())))
+
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(define (make-rounder pow10)
+  ;; Return a procedure that round to 10 to the -POW10.
+  (let ((times (expt 10.0 pow10)))
+    (lambda (x)
+      (/ (round (* x times)) times))))
+
+(define (pie-sliceweight-value sw-node pct?)
+   "Return the value that should be displayed by `sw-node', a
+   `sliceweight' markup node.  If `pct?' is true, then this value
+   should be a percentage."
+   (let* ((the-slice (ast-parent sw-node))
+	  (weight (and the-slice (markup-option the-slice :weight))))
+      (if (not the-slice)
+	  (skribe-error 'lout
+			"`sliceweight' node not within a `slice' body"
+			sw-node)
+	  (if pct?
+	      (let* ((the-pie (ast-parent the-slice))
+		     (total (and the-pie
+				 (markup-option the-pie
+						'&total-weight))))
+		 (if (not the-pie)
+		     (skribe-error 'lout
+				   "`slice' not within a `pie' body"
+				   the-slice)
+		     (* 100.0 (/ weight total)))) ;; flonum (FIXME: precision)
+
+	      weight))))
+
+(define (pie-remove-markup node)
+  "Remove markup from `node', ie. turn something like `(it \"hello\")' into
+the string \"hello\".  Implement `sliceweight' markups too."
+  (define percentage-round (make-rounder 2))
+
+  (if (markup? node)
+      (if (and node (is-markup? node 'sliceweight))
+	  (let* ((pct? (markup-option node :percentage?))
+		 (value (pie-sliceweight-value node pct?)))
+	     (number->string (percentage-round value)))
+	  (pie-remove-markup (markup-body node)))
+      (if (list? node)
+	  (apply string-append (map pie-remove-markup node))
+	  node)))
+
+(define strip-newlines (make-string-replace '((#\newline " "))))
+
+(define (select-output-format engine)
+  ;; Choose an ouptut format suitable for ENGINE.
+  (define %supported-formats '("png" "ps" "eps" "svg" "svgz"))
+  (define %default-format    "png")
+
+  (let ((fmt (engine-custom engine 'image-format)))
+    (cond ((string? fmt) fmt)
+	  ((and (list?   fmt) (not (null? fmt)))
+	   (let ((f (car fmt)))
+	     (if (member f %supported-formats)
+		 f
+		 %default-format)))
+	  (else %default-format))))
+
+
+;;;
+;;; Default implementation (`base' engine).
+;;;
+
+;; Ploticus-based implementation of pie charts, suitable for most engines.
+;; See http://ploticus.sf.net for info about Ploticus.
+
+(define %ploticus-program "ploticus")
+(define %ploticus-debug? #f)
+
+(define (color-spec->ploticus color-spec)
+  (define round (make-rounder 2))
+
+  (call-with-values (lambda () (skribe-color->rgb color-spec))
+    (lambda (r g b)
+      (format #f "rgb(~a,~a,~a)"
+	      (round (/ r 255.0))
+	      (round (/ g 255.0))
+	      (round (/ b 255.0))))))
+
+(define (ploticus-script pie)
+  (let* ((weights (map (lambda (slice)
+			 (markup-option slice :weight))
+		       (markup-body pie)))
+	 (colors (map (lambda (slice)
+			(let ((c (markup-option slice :color)))
+			  (string-append (color-spec->ploticus c)
+					 " ")))
+		      (markup-body pie)))
+	 (total-weight (or (if (number? (markup-option pie
+						       :total))
+			       (markup-option pie :total)
+			       #f)
+			   (apply + weights)))
+
+	 ;; Attach useful information to the pie and its slices
+	 (-/- (markup-option-add! pie '&total-weight total-weight))
+
+	 ;; One slice label per line -- so we need to remove
+	 ;; newlines from labels.
+	 (labels (map (lambda (b)
+			(strip-newlines (pie-remove-markup b)))
+		      (markup-body pie)))
+
+; 		     (flat-title (map pie-remove-markup
+; 				      (markup-option pie :title)))
+	 (detached (map (lambda (slice)
+			  (let ((d (markup-option slice
+						  :detach?)))
+			    (cond ((number? d) d)
+				  (d           0.5) ;; default
+				  (#t          0))))
+			(markup-body pie)))
+
+	 (initial-angle (or (markup-option pie :initial-angle)
+			    0))
+	 (radius (or ;;FIXME
+		  (markup-option pie :radius) 3))
+	 (max-radius (+ radius (apply max detached)))
+
+	 ;; center coordinates must take into account (i) the
+	 ;; maxium radius when detached slices are considered and
+	 ;; (ii) the fact that labels may get displayed to the
+	 ;; left of the pie.
+	 ;; FIXME: labels to the left (ii) end up being truncated
+	 ;; when the radius is e.g. < 2.
+	 (center `(,(+ max-radius
+		       (* max-radius max-radius)) .
+		       ,(* max-radius max-radius))))
+
+    (apply string-append
+	   (append (list "#proc getdata\n" "data: ")
+		   (map (lambda (weight)
+			  (string-append (number->string weight)
+					 "\n"))
+			weights)
+		   `("\n"
+;					      "#proc page\n"
+;					      "title " ,@flat-title
+;					      "\n"
+		     "#proc pie\n"
+		     "total: "
+		     ,(number->string total-weight)
+		     "\n"
+		     "datafield: " "1" "\n")
+		   `("firstslice: " ,(number->string initial-angle) "\n")
+		   `("radius: " ,(number->string radius) "\n")
+		   `("center: " ,(number->string (car center))
+		     " " ,(number->string (cdr center)) "\n")
+		   `("labelmode: "
+		     ,(case (markup-option
+			     pie :labels)
+			((outside) "line+label")
+			((inside)  "labelonly")
+			((legend)  "legend")
+			(else      "legend"))
+		     "\n"
+		     "labels: " ,@(map (lambda (label)
+					 (string-append label "\n"))
+				       labels)
+		     "\n")
+		   `("explode: "
+		     ,@(map (lambda (number)
+			      (string-append (number->string number)
+					     " "))
+			    detached)
+		     "\n")
+		   `("colors: " ,@colors "\n")))))
+
+(markup-writer 'pie (find-engine 'base)
+  :action (lambda (node engine)
+	    (let* ((fmt (select-output-format engine))
+		   (pie-file (string-append (markup-ident node) "."
+					    fmt))
+		   (port (open-output-pipe
+			  (string-append %ploticus-program
+					 " -o " pie-file
+					 " -cm -" fmt " -stdin")))
+		   (script (ploticus-script node)))
+
+
+		(if %ploticus-debug?
+		    (format (current-error-port) "** Ploticus script: ~a"
+			    script))
+
+		(display script port)
+
+		(let ((exit-val (status:exit-val (close-pipe port))))
+		  (if (not (eqv? 0 exit-val))
+		      (skribe-error 'pie/ploticus
+				    "ploticus exited with error code"
+				    exit-val)))
+
+		(if (not (file-exists? pie-file))
+		    (skribe-error 'ploticus
+				  "Ploticus did not create the image file"
+				  script))
+
+		(if (markup-option node :title)
+		    (output (list (bold (markup-option node :title))
+				  (linebreak))
+			    engine))
+
+		(output (image :file pie-file
+			       :class (markup-option node :class)
+			       (or (markup-option node :title)
+				   "A Pie Chart"))
+			engine))))
+
+(markup-writer 'slice (find-engine 'base)
+  :action (lambda (node engine)
+	    ;; Nothing to do here
+	    (error "slice: this writer should never be invoked")))
+
+(markup-writer 'sliceweight (find-engine 'base)
+  :action (lambda (node engine)
+	    ;; Nothing to do here.
+	    (error "sliceweight: this writer should never be invoked")))
+
+
+;;;
+;;; Initialization.
+;;;
+
+(when-engine-is-loaded 'lout
+  (lambda ()
+    (resolve-module '(skribilo package pie lout))))
+
+
+;;; arch-tag: 8095d8f6-b810-4619-9fdb-23fb94a77ee3
diff --git a/src/guile/skribilo/package/pie/Makefile.am b/src/guile/skribilo/package/pie/Makefile.am
new file mode 100644
index 0000000..3b4fafd
--- /dev/null
+++ b/src/guile/skribilo/package/pie/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package/pie
+dist_guilemodule_DATA = lout.scm
+
+## arch-tag: e6a03451-14c9-4331-8b96-71bde92ac142
diff --git a/src/guile/skribilo/package/pie/lout.scm b/src/guile/skribilo/package/pie/lout.scm
new file mode 100644
index 0000000..61dbcb7
--- /dev/null
+++ b/src/guile/skribilo/package/pie/lout.scm
@@ -0,0 +1,132 @@
+;;; lout.scm  --  Lout implementation of the `pie' package.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo package pie lout)
+  :use-module (skribilo package pie)
+  :use-module (skribilo ast)
+  :autoload   (skribilo output) (output)
+  :use-module (skribilo writer)
+  :use-module (skribilo engine)
+  :use-module (skribilo lib)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo utils keywords) ;; `the-options', etc.
+  :autoload   (skribilo engine lout) (lout-color-specification)
+  :use-module (ice-9 optargs))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(let ((lout (find-engine 'lout)))
+   (if lout
+       (engine-custom-set! lout 'includes
+	  (string-append (engine-custom lout 'includes)
+			 "\n@SysInclude { pie } # Pie Charts\n"))))
+
+
+
+;;;
+;;; Writers.
+;;;
+
+(markup-writer 'pie (find-engine 'lout)
+   :before (lambda (node engine)
+	      (let* ((weights (map (lambda (slice)
+				     (markup-option slice :weight))
+				   (markup-body node)))
+		     (total-weight (or (if (number? (markup-option node
+								   :total))
+					   (markup-option node :total)
+					   #f)
+				       (apply + weights))))
+
+		 (if (= 0 total-weight)
+		     (skribe-error 'lout
+				   "Slices weight sum should not be zero"
+				   total-weight))
+
+		 ;; Attach useful information to the pie and its slices
+		 (markup-option-add! node '&total-weight total-weight)
+
+		 (display "\n@Pie\n")
+		 (display "  abovecaption { ")
+		 (if (markup-option node :title)
+		     (output (markup-option node :title) engine))
+		 (display " }\n")
+		 (format #t "  totalweight { ~a }\n" total-weight)
+		 (format #t "  initialangle { ~a }\n"
+			  (or (markup-option node :initial-angle) 0))
+		 (format #t "  finger { ~a }\n"
+			 (case (markup-option node :labels)
+			   ((outside) (if (markup-option node :fingers?)
+					  "yes" "no"))
+			   (else "no")))
+
+		 ;; We assume `:radius' to be centimeters
+		 (if (markup-option node :radius)
+		     (format #t "  radius { ~ac }\n"
+			     (markup-option node :radius)))
+
+		 (format #t "  labelradius { ~a }\n"
+			 (case (markup-option node :labels)
+			   ((outside #f) "external")  ; FIXME: options are
+						  ; not availble within
+						  ; :before? (hence the #f)
+
+			   ((inside)  "internal")
+			   (else
+			    (skribe-error 'lout
+					  "`:labels' should be one of 'inside or 'outside."
+					  (markup-option node :labels)))))
+		 (display "{\n")))
+   :after "\n} # @Pie\n")
+
+(markup-writer 'slice (find-engine 'lout)
+   :options '(:weight :detach? :color)
+   :action (lambda (node engine)
+	     (display "  @Slice\n")
+	     (format #t "    detach { ~a }\n"
+		     (if (markup-option node :detach?)
+			 "yes"
+			 "no"))
+	     (format #t "     paint { ~a }\n"
+		     (lout-color-specification (markup-option node
+							      :color)))
+	     (format #t "     weight { ~a }\n"
+		     (markup-option node :weight))
+
+	     (display "    label { ")
+	     (output (markup-body node) engine)
+	     (display " }\n")))
+
+(markup-writer 'sliceweight (find-engine 'base)
+   ;; This writer should work for every engine, provided the `pie' markup has
+   ;; a proper `&total-weight' option.
+   :action (lambda (node engine)
+	      (let ((pct? (markup-option node :percentage?)))
+		 (output (number->string
+			  (pie-sliceweight-value node pct?))
+			 engine))))
+
+;;; arch-tag: b5221e30-f80e-4b72-a281-83ce19ddb755
diff --git a/src/guile/skribilo/package/scribe.scm b/src/guile/skribilo/package/scribe.scm
new file mode 100644
index 0000000..902cdb5
--- /dev/null
+++ b/src/guile/skribilo/package/scribe.scm
@@ -0,0 +1,240 @@
+;;; scribe.scm  --  Scribe Compatibility kit
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package scribe))
+
+;*---------------------------------------------------------------------*/
+;*    style ...                                                        */
+;*---------------------------------------------------------------------*/
+(define (style . styles)
+   (define (load-style style)
+      (let ((name (cond
+		     ((string? style)
+		      style)
+		     ((symbol? style)
+		      (string-append (symbol->string style) ".scr")))))
+	 (skribe-load name :engine *skribe-engine*)))
+   (for-each load-style styles))
+
+;*---------------------------------------------------------------------*/
+;*    chapter ...                                                      */
+;*---------------------------------------------------------------------*/
+(define skribe-chapter chapter)
+
+(define-markup (chapter #!rest opt #!key title subtitle split number toc file)
+   (apply skribe-chapter 
+	  :title (or title subtitle)
+	  :number number
+	  :toc toc
+	  :file file
+	  (the-body opt)))
+
+;*---------------------------------------------------------------------*/
+;*    table-of-contents ...                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (table-of-contents #!rest opts #!key chapter section subsection)
+   (apply toc opts))
+
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(define skribe-frame frame)
+
+(define-markup (frame #!rest opt #!key width margin)
+   (apply skribe-frame 
+	  :width (if (real? width) (* 100 width) width)
+	  :margin margin
+	  (the-body opt)))
+
+;*---------------------------------------------------------------------*/
+;*    copyright ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (copyright)
+   (symbol 'copyright))
+
+;*---------------------------------------------------------------------*/
+;*    sect ...                                                         */
+;*---------------------------------------------------------------------*/
+(define (sect)
+   (symbol 'section))
+
+;*---------------------------------------------------------------------*/
+;*    euro ...                                                         */
+;*---------------------------------------------------------------------*/
+(define (euro)
+   (symbol 'euro))
+
+;*---------------------------------------------------------------------*/
+;*    tab ...                                                          */
+;*---------------------------------------------------------------------*/
+(define (tab)
+   (char #\tab))
+
+;*---------------------------------------------------------------------*/
+;*    space ...                                                        */
+;*---------------------------------------------------------------------*/
+(define (space)
+   (char #\space))
+
+;*---------------------------------------------------------------------*/
+;*    print-bibliography ...                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (print-bibliography #!rest opts 
+				   #!key all (sort bib-sort/authors))
+   (the-bibliography all sort))
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(define skribe-linebreak linebreak)
+
+(define-markup (linebreak . lnum)
+   (cond
+      ((null? lnum)
+       (skribe-linebreak))
+      ((string? (car lnum))
+       (skribe-linebreak (string->number (car lnum))))
+      (else
+       (skribe-linebreak (car lnum)))))
+
+;*---------------------------------------------------------------------*/
+;*    ref ...                                                          */
+;*---------------------------------------------------------------------*/
+(define skribe-ref ref)
+
+(define-markup (ref #!rest opts 
+		    #!key scribe url id page figure mark 
+		    chapter section subsection subsubsection subsubsection
+		    bib bib+ number)
+   (let ((bd (the-body opts))
+	 (args (apply append (the-options opts :id))))
+      (if id (set! args (cons* :mark id args)))
+      (if (pair? bd) (set! args (cons* :text bd args)))
+      (apply skribe-ref args)))
+
+;*---------------------------------------------------------------------*/
+;*    indexes ...                                                      */
+;*---------------------------------------------------------------------*/
+(define *scribe-indexes*
+   (list (cons "theindex" (make-index "theindex"))))
+
+(define skribe-index index)
+(define skribe-make-index make-index)
+
+(define-markup (make-index index)
+   (let ((i (skribe-make-index index)))
+      (set! *scribe-indexes* (cons (cons index i) *scribe-indexes*))
+      i))
+
+(define-markup (index #!rest opts #!key note index shape)
+   (let ((i (if (not index)
+		"theindex"
+		(let ((i (assoc index *scribe-indexes*)))
+		   (if (pair? i)
+		       (cdr i)
+		       (make-index index))))))
+      (apply skribe-index :note note :index i :shape shape (the-body opts))))
+
+(define-markup (print-index #!rest opts 
+			    #!key split (char-offset 0) (header-limit 100))
+   (apply the-index 
+	  :split split 
+	  :char-offset char-offset
+	  :header-limit header-limit
+	  (map (lambda (i)
+		(let ((c (assoc i *scribe-indexes*)))
+		   (if (pair? c)
+		       (cdr c)
+		       (skribe-error 'the-index "Unknown index" i))))
+	       (the-body opts))))
+	      
+;*---------------------------------------------------------------------*/
+;*    format?                                                          */
+;*---------------------------------------------------------------------*/
+(define (scribe-format? fmt) #f)
+
+;*---------------------------------------------------------------------*/
+;*    scribe-url ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (scribe-url) (skribe-url))
+
+;*---------------------------------------------------------------------*/
+;*    Various configurations                                           */
+;*---------------------------------------------------------------------*/
+(define *scribe-background* #f)
+(define *scribe-foreground* #f)
+(define *scribe-tbackground* #f)
+(define *scribe-tforeground* #f)
+(define *scribe-title-font* #f)
+(define *scribe-author-font* #f)
+(define *scribe-chapter-numbering* #f)
+(define *scribe-footer* #f)
+(define *scribe-prgm-color* #f)
+
+;*---------------------------------------------------------------------*/
+;*    prgm ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (prgm #!rest opts
+		     #!key lnum lnumwidth language bg frame (width 1.)
+		     colors (monospace #t))
+   (let* ((w (cond
+		((real? width) (* width 100.))
+		((number? width) width)
+		(else 100.)))
+	  (body (if language 
+		    (source :language language (the-body opts))
+		    (the-body opts)))
+	  (body (if monospace
+		    (prog :line lnum body)
+		    body))
+	  (body (if bg
+		    (color :width 100. :bg bg body)
+		    body)))
+      (skribe-frame :width w
+		    :border (if frame 1 #f)
+		    body)))
+   
+;*---------------------------------------------------------------------*/
+;*    latex configuration                                              */
+;*---------------------------------------------------------------------*/
+(define *scribe-tex-predocument* #f)
+
+;*---------------------------------------------------------------------*/
+;*    latex-prelude ...                                                */
+;*---------------------------------------------------------------------*/
+(define (latex-prelude e)
+   (if (engine-format? "latex" e)
+       (begin
+	  (if *scribe-tex-predocument*
+	      (engine-custom-set! e 'predocument *scribe-tex-predocument*)))))
+      
+;*---------------------------------------------------------------------*/
+;*    html-prelude ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (html-prelude e)
+   (if (engine-format? "html" e)
+       (begin
+	  #f)))
+      
+;*---------------------------------------------------------------------*/
+;*    prelude                                                          */
+;*---------------------------------------------------------------------*/
+(let ((p (user-prelude)))
+   (user-prelude-set! (lambda (e) (p e) (latex-prelude e))))
diff --git a/src/guile/skribilo/package/sigplan.scm b/src/guile/skribilo/package/sigplan.scm
new file mode 100644
index 0000000..28d4e83
--- /dev/null
+++ b/src/guile/skribilo/package/sigplan.scm
@@ -0,0 +1,166 @@
+;;; sigplan.scm  --  The Skribe style for ACMPROC articles.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package sigplan))
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le
+		       'documentclass
+		       "\\documentclass[twocolumns]{sigplanconf}")
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :before (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (printf "\\authorinfo{\n"
+			    (if (pair? body) (length body) 1))))
+      :action (lambda (n e)
+		 (let ((body (markup-body n)))
+		    (for-each (lambda (a)
+				 (display "}\n\\authorinfo{")
+				 (output a e))
+			      (if (pair? body) body (list body)))))
+      :after "}\n")
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (writer-action old-author)))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category le
+      :options '(:index :section :subsection)
+      :before (lambda (n e)
+		 (display "\\category{")
+		 (display (markup-option n :index))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :section))
+		 (display "}")
+		 (display "{")
+		 (display (markup-option n :subsection))
+		 (display "}\n["))
+      :after "]\n")
+   (markup-writer '&acm-terms le
+      :before "\\terms{"
+      :after "}")
+   (markup-writer '&acm-keywords le
+      :before "\\keywords{"
+      :after "}")
+   (markup-writer '&acm-copyright le
+      :action (lambda (n e)
+		 (display "\\conferenceinfo{")
+		 (output (markup-option n :conference) e)
+		 (display ",} {")
+		 (output (markup-option n :location) e)
+		 (display "}\n")
+		 (display "\\copyrightyear{")
+		 (output (markup-option n :year) e)
+		 (display "}\n")
+		 (display "\\copyrightdata{")
+		 (output (markup-option n :crdata) e)
+		 (display "}\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-acmproc-abstract he
+      :action (lambda (n e)
+		 (let* ((ebg (engine-custom e 'abstract-background))
+			(bg (or (and (string? ebg) 
+				     (> (string-length ebg) 0))
+				ebg
+				"#cccccc"))
+			(exp (p (center (color :bg bg :width 90. 
+					   (markup-body n))))))
+		    (skribe-eval exp e))))
+   ;; ACM category, terms, and keywords
+   (markup-writer '&acm-category :action #f)
+   (markup-writer '&acm-terms :action #f)
+   (markup-writer '&acm-keywords :action #f)
+   (markup-writer '&acm-copyright :action #f))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key postscript)
+   (if (engine-format? "latex")
+       (section :number #f :title "ABSTRACT" (p (the-body opt)))
+       (let ((a (new markup
+		   (markup '&html-acmproc-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+		       postscript))
+		(section :number #f :toc #f :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+		   (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-category ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-category #!rest opt #!key index section subsection)
+   (new markup
+      (markup '&acm-category)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-terms ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-terms #!rest opt)
+   (new markup
+      (markup '&acm-terms)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-keywords ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-keywords #!rest opt)
+   (new markup
+      (markup '&acm-keywords)
+      (options (the-options opt))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    acm-copyright ...                                                */
+;*---------------------------------------------------------------------*/
+(define-markup (acm-copyright #!rest opt #!key conference location year crdata)
+   (let* ((le (find-engine 'latex))
+	  (cop (format "\\conferenceinfo{~a,} {~a}
+\\CopyrightYear{~a}
+\\crdata{~a}\n" conference location year crdata))
+	  (old (engine-custom le 'predocument)))
+      (if (string? old)
+	  (engine-custom-set! le 'predocument (string-append cop old))
+	  (engine-custom-set! le 'predocument cop))))
+   
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (if (engine-format? "latex")
+	     (font :size -1 (flush :side 'left (the-bibliography)))
+	     (section :title "References"
+                      (font :size -1 (the-bibliography))))))
diff --git a/src/guile/skribilo/package/skribe.scm b/src/guile/skribilo/package/skribe.scm
new file mode 100644
index 0000000..86969aa
--- /dev/null
+++ b/src/guile/skribilo/package/skribe.scm
@@ -0,0 +1,85 @@
+;;; skribe.scm  --  The standard Skribe style (always loaded).
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+;*---------------------------------------------------------------------*/
+;*    p ...                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (p #!rest opt #!key ident (class #f) &skribe-eval-location)
+   (paragraph :ident ident :class class :loc &skribe-eval-location
+      (the-body opt)))
+
+;*---------------------------------------------------------------------*/
+;*    fg ...                                                           */
+;*---------------------------------------------------------------------*/
+(define (fg c . body)
+   (color :fg c body))
+
+;*---------------------------------------------------------------------*/
+;*    bg ...                                                           */
+;*---------------------------------------------------------------------*/
+(define (bg c . body)
+   (color :bg c body))
+
+;*---------------------------------------------------------------------*/
+;*    counter ...                                                      */
+;*    -------------------------------------------------------------    */
+;*    This produces a kind of "local enumeration" that is:             */
+;*       (counting "toto," "tutu," "titi.")                            */
+;*    produces:                                                        */
+;*       i) toto, ii) tutu, iii) titi.                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (counter #!rest opts #!key (numbering 'roman))
+   (define items (if (eq? (car opts) :numbering) (cddr opts) opts))
+   (define vroman '#(- "i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix" "x"))
+   (define (the-roman-number num)
+      (if (< num (vector-length vroman))
+	  (list (list "(" (it (vector-ref vroman num)) ") "))
+	  (skribe-error 'counter
+			"too many items for roman numbering"
+			(length items))))
+   (define (the-arabic-number num)
+      (list (list "(" (it (integer->string num)) ") ")))
+   (define (the-alpha-number num)
+      (list (list "(" (it (+ (integer->char #\a) num -1)) ") ")))
+   (let ((the-number (case numbering
+			((roman) the-roman-number)
+			((arabic) the-arabic-number)
+			((alpha) the-alpha-number)
+			(else (skribe-error 'counter
+					    "Illegal numbering"
+					    numbering)))))
+      (let loop ((num 1)
+		 (items items)
+		 (res '()))
+	   (if (null? items)
+	       (reverse! res)
+	       (loop (+ num 1)
+		     (cdr items)
+		     (cons (list (the-number num) (car items)) res))))))
+
+;*---------------------------------------------------------------------*/
+;*    q                                                                */
+;*---------------------------------------------------------------------*/
+(define-markup (q #!rest opt)
+   (new markup
+      (markup 'q)
+      (options (the-options opt))
+      (body (the-body opt))))
+
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
new file mode 100644
index 0000000..7f731e3
--- /dev/null
+++ b/src/guile/skribilo/package/slide.scm
@@ -0,0 +1,274 @@
+;;; slide.scm  --  Overhead transparencies.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+(define-skribe-module (skribilo package slide))
+
+
+;*---------------------------------------------------------------------*/
+;*    slide-options                                                    */
+;*---------------------------------------------------------------------*/
+(define-public &slide-load-options (skribe-load-options))
+
+
+;*---------------------------------------------------------------------*/
+;*    %slide-the-slides ...                                            */
+;*---------------------------------------------------------------------*/
+(define %slide-the-slides '())
+(define %slide-the-counter 0)
+
+;*---------------------------------------------------------------------*/
+;*    slide ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (slide #!rest opt
+		      #!key
+		      (ident #f) (class #f)
+		      (toc #t)
+		      title (number #t)
+		      (vspace #f) (vfill #f)
+		      (transition #f)
+		      (bg #f) (image #f))
+   (let ((s (new container
+	       (markup 'slide)
+	       (ident (if (not ident)
+			  (symbol->string (gensym 'slide))
+			  ident))
+	       (class class)
+	       (required-options '(:title :number :toc))
+	       (options `((:number
+			   ,(cond
+			       ((number? number)
+				(set! %slide-the-counter number)
+				number)
+			       (number
+				(set! %slide-the-counter
+				      (+ 1 %slide-the-counter))
+				%slide-the-counter)
+			       (else
+				#f)))
+			  (:toc ,toc)
+			  ,@(the-options opt :ident :class :vspace :toc)))
+	       (body (if vspace
+			 (list (slide-vspace vspace) (the-body opt))
+			 (the-body opt))))))
+      (set! %slide-the-slides (cons s %slide-the-slides))
+      s))
+
+;*---------------------------------------------------------------------*/
+;*    ref ...                                                          */
+;*---------------------------------------------------------------------*/
+(define %slide-old-ref ref)
+
+;; Extend the definition of `ref'.
+;; FIXME: This technique breaks `ref' for some reason.
+; (set! ref
+;       (lambda args
+; 	;; Filter out ARGS and look for a `:slide' keyword argument.
+; 	(let loop ((slide #f)
+; 		   (opt '())
+; 		   (args args))
+; 	  (if (null? args)
+; 	      (set! opt (reverse! opt))
+; 	      (let ((s? (eq? (car args) :slide)))
+; 		(loop (if s? (cadr args) #f)
+; 		      (if s? opt (cons (car args) opt))
+; 		      (if s? (cddr args) (cdr args)))))
+
+; 	  (format (current-error-port)
+; 		  "slide.scm:ref: slide=~a opt=~a~%" slide opt)
+
+; 	  (if (not slide)
+; 	      (apply %slide-old-ref opt)
+; 	      (new unresolved
+; 		   (proc (lambda (n e env)
+; 			   (cond
+; 			    ((eq? slide 'next)
+; 			     (let ((c (assq n %slide-the-slides)))
+; 			       (if (pair? c)
+; 				   (handle (cadr c))
+; 				   #f)))
+; 			    ((eq? slide 'prev)
+; 			     (let ((c (assq n (reverse %slide-the-slides))))
+; 			       (if (pair? c)
+; 				   (handle (cadr c))
+; 				   #f)))
+; 			    ((number? slide)
+; 			     (let loop ((s %slide-the-slides))
+; 			       (cond
+; 				((null? s)
+; 				 #f)
+; 				((= slide (markup-option
+; 					   (car s) :number))
+; 				 (handle (car s)))
+; 				(else
+; 				 (loop (cdr s))))))
+; 			    (else
+; 			     #f)))))))))
+
+
+;*---------------------------------------------------------------------*/
+;*    slide-pause ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-pause)
+   (new markup
+      (markup 'slide-pause)))
+
+;*---------------------------------------------------------------------*/
+;*    slide-vspace ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-vspace #!rest opt #!key (unit 'cm))
+   (new markup
+      (markup 'slide-vspace)
+      (options `((:unit ,unit) ,@(the-options opt :unit)))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-embed ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-embed #!rest opt
+			    #!key
+			    command
+			    (geometry-opt "-geometry")
+			    (geometry #f) (rgeometry #f)
+			    (transient #f) (transient-opt #f)
+			    (alt #f)
+			    &skribe-eval-location)
+   (if (not (string? command))
+       (skribe-error 'slide-embed
+		     "No command provided"
+		     command)
+       (new markup
+	  (markup 'slide-embed)
+	  (loc &skribe-eval-location)
+	  (required-options '(:alt))
+	  (options `((:geometry-opt ,geometry-opt)
+		     (:alt ,alt)
+		     ,@(the-options opt :geometry-opt :alt)))
+	  (body (the-body opt)))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-record ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-record #!rest opt #!key ident class tag (play #t))
+   (if (not tag)
+       (skribe-error 'slide-record "Tag missing" tag)
+       (new markup
+	  (markup 'slide-record)
+	  (ident ident)
+	  (class class)
+	  (options `((:play ,play) ,@(the-options opt)))
+	  (body (the-body opt)))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-play ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-play #!rest opt #!key ident class tag color)
+   (if (not tag)
+       (skribe-error 'slide-play "Tag missing" tag)
+       (new markup
+	  (markup 'slide-play)
+	  (ident ident)
+	  (class class)
+	  (options `((:color ,(if color (skribe-use-color! color) #f))
+		     ,@(the-options opt :color)))
+	  (body (the-body opt)))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-play* ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-play* #!rest opt
+			    #!key ident class color (scolor "#000000"))
+   (let ((body (the-body opt)))
+      (for-each (lambda (lbl)
+		   (match-case lbl
+		      ((?id ?col)
+		       (skribe-use-color! col))))
+		body)
+      (new markup
+	 (markup 'slide-play*)
+	 (ident ident)
+	 (class class)
+	 (options `((:color ,(if color (skribe-use-color! color) #f))
+		    (:scolor ,(if color (skribe-use-color! scolor) #f))
+		    ,@(the-options opt :color :scolor)))
+	 (body body))))
+
+
+
+;*---------------------------------------------------------------------*/
+;*    slide-number ...                                                 */
+;*---------------------------------------------------------------------*/
+(define-public (slide-number)
+   (length (filter (lambda (n)
+		      (and (is-markup? n 'slide)
+			   (markup-option n :number)))
+		   %slide-the-slides)))
+
+;*---------------------------------------------------------------------*/
+;*    slide-topic ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-topic #!rest opt
+			    #!key title (outline? #t)
+                            (ident #f) (class "slide-topic"))
+   (new container
+      (markup 'slide-topic)
+      (required-options '(:title :outline?))
+      (ident (or ident (symbol->string (gensym 'slide-topic))))
+      (options `((:outline? ,outline?)
+                 ,@(the-options opt :outline?)))
+      (body (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;*    slide-subtopic ...                                               */
+;*---------------------------------------------------------------------*/
+(define-markup (slide-subtopic #!rest opt
+			       #!key title (outline? #f)
+                               (ident #f) (class "slide-subtopic"))
+   (new container
+      (markup 'slide-subtopic)
+      (required-options '(:title :outline?))
+      (ident (or ident (symbol->string (gensym 'slide-subtopic))))
+      (options `((:outline? ,outline?)
+                 ,@(the-options opt :outline?)))
+      (body (the-body opt))))
+
+
+
+;;;
+;;; Initialization.
+;;;
+
+(format (current-error-port) "Slides initializing...~%")
+
+;; Register specific implementations for lazy loading.
+(when-engine-is-loaded 'base
+  (lambda ()
+    (resolve-module '(skribilo package slide base))))
+(when-engine-is-loaded 'latex
+  (lambda ()
+    (resolve-module '(skribilo package slide latex))))
+(when-engine-is-loaded 'html
+  (lambda ()
+    (resolve-module '(skribilo package slide html))))
+(when-engine-is-loaded 'lout
+  (lambda ()
+    (resolve-module '(skribilo package slide lout))))
+
diff --git a/src/guile/skribilo/package/slide/Makefile.am b/src/guile/skribilo/package/slide/Makefile.am
new file mode 100644
index 0000000..53320fa
--- /dev/null
+++ b/src/guile/skribilo/package/slide/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package/slide
+dist_guilemodule_DATA = base.scm latex.scm html.scm lout.scm
+
+## arch-tag: 56b5fa5c-bb6a-4692-b929-74bdd032431c
diff --git a/src/guile/skribilo/package/slide/base.scm b/src/guile/skribilo/package/slide/base.scm
new file mode 100644
index 0000000..c8e652c
--- /dev/null
+++ b/src/guile/skribilo/package/slide/base.scm
@@ -0,0 +1,185 @@
+;;; base.scm  --  Overhead transparencies, `base' engine.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo package slide base)
+  :use-module (skribilo utils syntax)
+
+  :use-module (skribilo package slide)
+  :use-module (skribilo writer)
+  :use-module (skribilo engine)
+  :use-module (skribilo ast)
+  :autoload   (skribilo output)        (output)
+  :autoload   (skribilo package base)  (symbol color itemize item)
+
+  :use-module (srfi srfi-1)
+
+  :export (%slide-outline-title %slide-outline-itemize-symbols))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Simple markups.
+;;;
+(let ((be (find-engine 'base)))
+
+   ;; slide-pause
+   (markup-writer 'slide-pause be
+      :action #f)
+   ;; slide-vspace
+   (markup-writer 'slide-vspace be
+      :options '()
+      :action #f)
+   ;; slide-embed
+   (markup-writer 'slide-embed be
+      :options '(:alt :geometry-opt)
+      :action (lambda (n e)
+		 (output (markup-option n :alt) e)))
+   ;; slide-record
+   (markup-writer 'slide-record be
+      :options '(:tag :play)
+      :action (lambda (n e)
+		 (output (markup-body n) e)))
+   ;; slide-play
+   (markup-writer 'slide-play be
+      :options '(:tag :color)
+      :action (lambda (n e)
+		 (output (markup-option n :alt) e)))
+   ;; slide-play*
+   (markup-writer 'slide-play* be
+      :options '(:tag :color :scolor)
+      :action (lambda (n e)
+		 (output (markup-option n :alt) e))))
+
+
+;;;
+;;; Helper functions for the default topic/subtopic handling.
+;;;
+
+(define (make-subtopic-list node recurse?-proc make-entry-proc
+			    itemize-symbols)
+  ;; Make a list of the subtopic of `node'.  Go recursive if `recurse?-proc'
+  ;; returns true.  `make-entry-proc' is passed a node and returns an entry
+  ;; (a markup) for this node.  `itemize-symbols' is a (circular) list
+  ;; containing the symbols to be passed to `itemize'.
+  (let* ((subtopic? (lambda (n)
+                      (or (is-markup? n 'slide-subtopic)
+                          (is-markup? n 'slide))))
+         (subtopic-types (if (is-markup? node 'slide-topic)
+                             '(slide-subtopic slide)
+                             '(slide-topic))))
+    (if (subtopic? node)
+        '()
+        (apply itemize
+               `(,@(if (is-markup? (car itemize-symbols) 'symbol)
+                       `(:symbol ,(car itemize-symbols))
+                       '())
+                 ,@(map (lambda (t)
+                          (item
+                           (make-entry-proc t)
+                           (if (recurse?-proc t)
+                               (make-subtopic-list t recurse?-proc
+                                                   make-entry-proc
+                                                   (cdr itemize-symbols))
+                               '())))
+                        (filter (lambda (n)
+                                  (and (markup? n)
+                                       (member (markup-markup n)
+                                               subtopic-types)))
+                                (markup-body node))))))))
+
+(define (make-topic-list current-topic recurse? make-entry-proc)
+  ;; Make a full topic list of the document which contains
+  ;; `current-topic'.  Here, `make-entry-proc' takes a topic node and
+  ;; the current topic node as its arguments.
+  (let ((doc (ast-document current-topic)))
+    (make-subtopic-list doc
+                        (lambda (t)
+                          (and recurse? (eq? t current-topic)))
+                        (lambda (t)
+                          (make-entry-proc t current-topic))
+                        %slide-outline-itemize-symbols)))
+
+(define (make-topic-entry topic current-topic)
+  ;; Produce an entry for `topic'.  Colorize it based on the fact
+  ;; that the current topic is `current-topic' (it may need to be
+  ;; hightlighted).
+  (let ((title (markup-option topic :title))
+        (current? (eq? topic current-topic)))
+    (color :fg (if current? "#000000" "#666666")
+           (apply (if current? bold (lambda (x) x))
+                  (list (markup-option topic :title))))))
+
+
+;;;
+;;; Default topic/subtopic handling.
+;;;
+
+;; Title for the automatically-generated outline slide.
+(define %slide-outline-title "")
+
+;; Circular list of symbols to be passed to `itemize' in outlines.
+(define %slide-outline-itemize-symbols
+  (let loop ((names '(#t "-" "bullet" "->" "middot")))
+    (if (null? names)
+	'()
+	(cons (if (string? (car names))
+		  (symbol (car names))
+		  (car names))
+	      (loop (cdr names))))))
+
+
+(define (make-outline-slide topic engine)
+  (let ((parent-topic (if (is-markup? topic 'slide-topic)
+                          topic
+                          (find1-up (lambda (n)
+                                      (is-markup? n 'slide-topic))
+                                    topic))))
+    (output (slide :title %slide-outline-title :toc #f
+                   :class (markup-option topic :class)
+                   ;; The mark below is needed for cross-referencing by PDF
+                   ;; bookmarks.
+                   (if (markup-ident topic) (mark (markup-ident topic)) "")
+                   (p (make-topic-list parent-topic #t
+                                       make-topic-entry)))
+            engine)))
+
+
+(markup-writer 'slide-topic (find-engine 'base)
+   :options '(:title :outline? :class :ident)
+   :action (lambda (n e)
+	      (if (markup-option n :outline?)
+		  (make-outline-slide n e))
+
+	      (output (markup-body n) e)))
+
+(markup-writer 'slide-subtopic (find-engine 'base)
+   ;; FIXME: Largely untested.
+   :options '(:title :outline? :class :ident)
+   :action (lambda (n e)
+	      (if (markup-option n :outline?)
+		  (make-outline-slide n e))
+
+	      (output (markup-body n) e)))
+
+
+;;; arch-tag: 1187ce0c-3ffc-4248-b68b-a7c77d6598b9
diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm
new file mode 100644
index 0000000..d47ef82
--- /dev/null
+++ b/src/guile/skribilo/package/slide/html.scm
@@ -0,0 +1,144 @@
+;;; html.scm  --  HTML implementation of the `slide' package.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package slide html)
+  :use-module (skribilo package slide))
+
+
+(define-public (%slide-html-initialize!)
+  (let ((he (find-engine 'html)))
+    (skribe-message "HTML slides setup...\n")
+    ;; &html-page-title
+    (markup-writer '&html-document-title he
+       ;;:predicate (lambda (n e) %slide-initialized)
+       :action html-slide-title)
+    ;; slide
+    (markup-writer 'slide he
+       :options '(:title :number :transition :toc :bg)
+       :before (lambda (n e)
+		  (printf "<a name=\"~a\">" (markup-ident n))
+		  (display "<br>\n"))
+       :action (lambda (n e)
+		  (let ((nb (markup-option n :number))
+			(t (markup-option n :title)))
+		     (skribe-eval
+		      (center
+			 (color :width (slide-body-width e)
+			    :bg (or (markup-option n :bg) "#ffffff")
+			    (table :width 100.
+			       (tr (th :align 'left
+				      (list
+				       (if nb
+					   (format #f "~a / ~a -- " nb
+						   (slide-number)))
+				       t)))
+			       (tr (td (hrule)))
+			       (tr (td :width 100. :align 'left
+				      (markup-body n))))
+			    (linebreak)))
+		      e)))
+       :after "<br>")
+    ;; slide-vspace
+    (markup-writer 'slide-vspace he
+       :action (lambda (n e) (display "<br>")))))
+
+
+;*---------------------------------------------------------------------*/
+;*    slide-body-width ...                                             */
+;*---------------------------------------------------------------------*/
+(define (slide-body-width e)
+   (let ((w (engine-custom e 'body-width)))
+      (if (or (number? w) (string? w)) w 95.)))
+
+;*---------------------------------------------------------------------*/
+;*    html-slide-title ...                                             */
+;*---------------------------------------------------------------------*/
+(define (html-slide-title n e)
+   (let* ((title (markup-body n))
+	  (authors (markup-option n 'author))
+	  (tbg (engine-custom e 'title-background))
+	  (tfg (engine-custom e 'title-foreground))
+	  (tfont (engine-custom e 'title-font)))
+      (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>"
+	      (html-width (slide-body-width e)))
+      (if (string? tbg)
+	  (printf "<td bgcolor=\"~a\">" tbg)
+	  (display "<td>"))
+      (if (string? tfg)
+	  (printf "<font color=\"~a\">" tfg))
+      (if title
+	  (begin
+	     (display "<center>")
+	     (if (string? tfont)
+		 (begin
+		    (printf "<font ~a><strong>" tfont)
+		    (output title e)
+		    (display "</strong></font>"))
+		 (begin
+		    (printf "<div class=\"skribetitle\"><strong><big><big><big>")
+		    (output title e)
+		    (display "</big></big></big></strong</div>")))
+	     (display "</center>\n")))
+      (if (not authors)
+	  (display "\n")
+	  (html-title-authors authors e))
+      (if (string? tfg)
+	  (display "</font>"))
+      (display "</td></tr></tbody></table></center>\n")))
+
+
+
+;;;
+;;; Slide topics/subtopics.
+;;;
+
+(markup-writer 'slide-topic (find-engine 'html)
+   :options '(:title :outline? :class :ident)
+   :action (lambda (n e)
+	      (let ((title (markup-option n :title))
+		    (body (markup-body n)))
+		 (display "\n<h2 class=\"slide-topic:title\">")
+		 (if (markup-ident n)
+		     (printf "<a name=\"~a\"></a>" (markup-ident n)))
+		 (output title e)
+		 (display "</h2> <br>\n")
+		 (display "\n<div class=\"slide-topic:slide-list\">")
+		 (for-each (lambda (s)
+			      (output (markup-option s :title) e)
+			      (display "&nbsp;--&nbsp;"))
+			   (filter (lambda (n)
+				      (or (is-markup? n 'slide-subtopic)
+					  (is-markup? n 'slide)))
+				   (markup-body n)))
+		 (display "\n</div> <!-- slide-topic:slide-list -->")
+		 (display "\n<hr><br>\n")
+
+		 ;; the slides
+		 (output (markup-body n) e))))
+
+
+;;;
+;;; Initialization.
+;;;
+
+(%slide-html-initialize!)
+
+
+;;; arch-tag: 8be0cdf2-b755-4baa-baf6-739cdd00e193
diff --git a/src/guile/skribilo/package/slide/latex.scm b/src/guile/skribilo/package/slide/latex.scm
new file mode 100644
index 0000000..e187d3c
--- /dev/null
+++ b/src/guile/skribilo/package/slide/latex.scm
@@ -0,0 +1,394 @@
+;;; latex.scm  --  LaTeX implementation of the `slide' package.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package slide latex)
+  :use-module (skribilo package slide))
+
+
+(define-public %slide-latex-mode 'seminar)
+
+(define-public (%slide-latex-initialize!)
+  (skribe-message "LaTeX slides setup...\n")
+  (case %slide-latex-mode
+    ((seminar)
+     (%slide-seminar-setup!))
+    ((advi)
+     (%slide-advi-setup!))
+    ((prosper)
+     (%slide-prosper-setup!))
+    (else
+     (skribe-error 'slide "Illegal latex mode" %slide-latex-mode))))
+
+
+;*---------------------------------------------------------------------*/
+;*    &slide-seminar-predocument ...                                   */
+;*---------------------------------------------------------------------*/
+(define &slide-seminar-predocument
+   "\\special{landscape}
+   \\slideframe{none}
+   \\centerslidesfalse
+   \\raggedslides[0pt]
+   \\renewcommand{\\slideleftmargin}{0.2in}
+   \\renewcommand{\\slidetopmargin}{0.3in}
+   \\newdimen\\slidewidth \\slidewidth 9in")
+
+;*---------------------------------------------------------------------*/
+;*    &slide-seminar-maketitle ...                                     */
+;*---------------------------------------------------------------------*/
+(define &slide-seminar-maketitle
+   "\\def\\labelitemi{$\\bullet$}
+   \\def\\labelitemii{$\\circ$}
+   \\def\\labelitemiii{$\\diamond$}
+   \\def\\labelitemiv{$\\cdot$}
+   \\pagestyle{empty}
+   \\slideframe{none}
+   \\centerslidestrue
+   \\begin{slide}
+   \\date{}
+   \\maketitle
+   \\end{slide}
+   \\slideframe{none}
+   \\centerslidesfalse")
+
+;*---------------------------------------------------------------------*/
+;*    &slide-prosper-predocument ...                                   */
+;*---------------------------------------------------------------------*/
+(define &slide-prosper-predocument
+   "\\slideCaption{}\n")
+
+;*---------------------------------------------------------------------*/
+;*    latex                                                            */
+;*---------------------------------------------------------------------*/
+(define &latex-slide #f)
+(define &latex-pause #f)
+(define &latex-embed #f)
+(define &latex-record #f)
+(define &latex-play #f)
+(define &latex-play* #f)
+
+;;; FIXME: We shouldn't load `latex.scm' from here.  Instead, we should
+;;; register a hook on its load.
+(let ((le (find-engine 'latex)))
+   ;; slide-vspace
+   (markup-writer 'slide-vspace le
+      :options '(:unit)
+      :action (lambda (n e)
+		 (display "\n\\vspace{")
+		 (output (markup-body n) e)
+		 (printf " ~a}\n\n" (markup-option n :unit))))
+   ;; slide-slide
+   (markup-writer 'slide le
+      :options '(:title :number :transition :vfill :toc :vspace :image)
+      :action (lambda (n e)
+		 (if (procedure? &latex-slide)
+		     (&latex-slide n e))))
+   ;; slide-pause
+   (markup-writer 'slide-pause le
+      :options '()
+      :action (lambda (n e)
+		 (if (procedure? &latex-pause)
+		     (&latex-pause n e))))
+   ;; slide-embed
+   (markup-writer 'slide-embed le
+      :options '(:alt :command :geometry-opt :geometry
+		      :rgeometry :transient :transient-opt)
+      :action (lambda (n e)
+		 (if (procedure? &latex-embed)
+		     (&latex-embed n e))))
+   ;; slide-record
+   (markup-writer 'slide-record le
+      :options '(:tag :play)
+      :action (lambda (n e)
+		 (if (procedure? &latex-record)
+		     (&latex-record n e))))
+   ;; slide-play
+   (markup-writer 'slide-play le
+      :options '(:tag :color)
+      :action (lambda (n e)
+		 (if (procedure? &latex-play)
+		     (&latex-play n e))))
+   ;; slide-play*
+   (markup-writer 'slide-play* le
+      :options '(:tag :color :scolor)
+      :action (lambda (n e)
+		 (if (procedure? &latex-play*)
+		     (&latex-play* n e)))))
+
+;*---------------------------------------------------------------------*/
+;*    %slide-seminar-setup! ...                                        */
+;*---------------------------------------------------------------------*/
+(define (%slide-seminar-setup!)
+   (skribe-message "Seminar slides setup...\n")
+   (let ((le (find-engine 'latex))
+	 (be (find-engine 'base)))
+      ;; latex configuration
+      (define (seminar-slide n e)
+	 (let ((nb (markup-option n :number))
+	       (t (markup-option n :title)))
+	    (display "\\begin{slide}\n")
+	    (if nb (printf "~a/~a -- " nb (slide-number)))
+	    (output t e)
+	    (display "\\hrule\n"))
+	 (output (markup-body n) e)
+	 (if (markup-option n :vill) (display "\\vfill\n"))
+	 (display "\\end{slide}\n"))
+      (engine-custom-set! le 'documentclass
+	 "\\documentclass[landscape]{seminar}\n")
+      (let ((o (engine-custom le 'predocument)))
+	 (engine-custom-set! le 'predocument
+	    (if (string? o)
+		(string-append &slide-seminar-predocument o)
+		&slide-seminar-predocument)))
+      (engine-custom-set! le 'maketitle
+	 &slide-seminar-maketitle)
+      (engine-custom-set! le 'hyperref-usepackage
+	 "\\usepackage[setpagesize=false]{hyperref}\n")
+      ;; slide-slide
+      (set! &latex-slide seminar-slide)))
+
+;*---------------------------------------------------------------------*/
+;*    %slide-advi-setup! ...                                           */
+;*---------------------------------------------------------------------*/
+(define (%slide-advi-setup!)
+   (skribe-message "Generating `Advi Seminar' slides...\n")
+   (let ((le (find-engine 'latex))
+	 (be (find-engine 'base)))
+      (define (advi-geometry geo)
+	 (let ((r (pregexp-match "([0-9]+)x([0-9]+)" geo)))
+	    (if (pair? r)
+		(let* ((w (cadr r))
+		       (w' (string->integer w))
+		       (w'' (number->string (/ w' *skribe-slide-advi-scale*)))
+		       (h (caddr r))
+		       (h' (string->integer h))
+		       (h'' (number->string (/ h' *skribe-slide-advi-scale*))))
+		   (values "" (string-append w "x" h "+!x+!y")))
+		(let ((r (pregexp-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo)))
+		   (if (pair? r)
+		       (let ((w (number->string (/ (string->integer (cadr r))
+						   *skribe-slide-advi-scale*)))
+			     (h (number->string (/ (string->integer (caddr r))
+						   *skribe-slide-advi-scale*)))
+			     (x (cadddr r))
+			     (y (car (cddddr r))))
+			  (values (string-append "width=" w "cm,height=" h "cm")
+				  "!g"))
+		       (values "" geo))))))
+      (define (advi-transition trans)
+	 (cond
+	    ((string? trans)
+	     (printf "\\advitransition{~s}" trans))
+	    ((and (symbol? trans)
+		  (memq trans '(wipe block slide)))
+	     (printf "\\advitransition{~s}" trans))
+	    (else
+	     #f)))
+      ;; latex configuration
+      (define (advi-slide n e)
+	 (let ((i (markup-option n :image))
+	       (n (markup-option n :number))
+	       (t (markup-option n :title))
+	       (lt (markup-option n :transition))
+	       (gt (engine-custom e 'transition)))
+	    (if (and i (engine-custom e 'advi))
+		(printf "\\advibg[global]{image=~a}\n"
+			(if (and (pair? i)
+				 (null? (cdr i))
+				 (string? (car i)))
+			    (car i)
+			    i)))
+	    (display "\\begin{slide}\n")
+	    (advi-transition (or lt gt))
+	    (if n (printf "~a/~a -- " n (slide-number)))
+	    (output t e)
+	    (display "\\hrule\n"))
+	 (output (markup-body n) e)
+	 (if (markup-option n :vill) (display "\\vfill\n"))
+	 (display "\\end{slide}\n\n\n"))
+      ;; advi record
+      (define (advi-record n e)
+	 (display "\\advirecord")
+	 (when (markup-option n :play) (display "[play]"))
+	 (printf "{~a}{" (markup-option n :tag))
+	 (output (markup-body n) e)
+	 (display "}"))
+      ;; advi play
+      (define (advi-play n e)
+	 (display "\\adviplay")
+	 (let ((c (markup-option n :color)))
+	    (when c
+	       (display "[")
+	       (display (skribe-get-latex-color c))
+	       (display "]")))
+	 (printf "{~a}" (markup-option n :tag)))
+      ;; advi play*
+      (define (advi-play* n e)
+	 (let ((c (skribe-get-latex-color (markup-option n :color)))
+	       (d (skribe-get-latex-color (markup-option n :scolor))))
+	    (let loop ((lbls (markup-body n))
+		       (last #f))
+	       (when last
+		  (display "\\adviplay[")
+		  (display d)
+		  (printf "]{~a}" last))
+	       (when (pair? lbls)
+		  (let ((lbl (car lbls)))
+		     (match-case lbl
+			((?id ?col)
+			 (display "\\adviplay[")
+			 (display (skribe-get-latex-color col))
+			 (printf "]{" ~a "}" id)
+			 (skribe-eval (slide-pause) e)
+			 (loop (cdr lbls) id))
+			(else
+			 (display "\\adviplay[")
+			 (display c)
+			 (printf "]{~a}" lbl)
+			 (skribe-eval (slide-pause) e)
+			 (loop (cdr lbls) lbl))))))))
+      (engine-custom-set! le 'documentclass
+	 "\\documentclass{seminar}\n")
+      (let ((o (engine-custom le 'predocument)))
+	 (engine-custom-set! le 'predocument
+	    (if (string? o)
+		(string-append &slide-seminar-predocument o)
+		&slide-seminar-predocument)))
+      (engine-custom-set! le 'maketitle
+	 &slide-seminar-maketitle)
+      (engine-custom-set! le 'usepackage
+	 (string-append "\\usepackage{advi}\n"
+			(engine-custom le 'usepackage)))
+      ;; slide
+      (set! &latex-slide advi-slide)
+      (set! &latex-pause
+	    (lambda (n e) (display "\\adviwait\n")))
+      (set! &latex-embed
+	    (lambda (n e)
+	       (let ((geometry-opt (markup-option n :geometry-opt))
+		     (geometry (markup-option n :geometry))
+		     (rgeometry (markup-option n :rgeometry))
+		     (transient (markup-option n :transient))
+		     (transient-opt (markup-option n :transient-opt))
+		     (cmd (markup-option n :command)))
+		  (let* ((a (string-append "ephemeral="
+					   (symbol->string (gensym))))
+			 (c (cond
+			       (geometry
+				(string-append cmd " "
+					       geometry-opt " "
+					       geometry))
+			       (rgeometry
+				(multiple-value-bind (aopt dopt)
+				   (advi-geometry rgeometry)
+				   (set! a (string-append a "," aopt))
+				   (string-append cmd " "
+						  geometry-opt " "
+						  dopt)))
+			       (else
+				cmd)))
+			 (c (if (and transient transient-opt)
+				(string-append c " " transient-opt " !p")
+				c)))
+		     (printf "\\adviembed[~a]{~a}\n" a c)))))
+      (set! &latex-record advi-record)
+      (set! &latex-play advi-play)
+      (set! &latex-play* advi-play*)))
+
+;*---------------------------------------------------------------------*/
+;*    %slide-prosper-setup! ...                                        */
+;*---------------------------------------------------------------------*/
+(define (%slide-prosper-setup!)
+   (skribe-message "Generating `Prosper' slides...\n")
+   (let ((le (find-engine 'latex))
+	 (be (find-engine 'base))
+	 (overlay-count 0))
+      ;; transitions
+      (define (prosper-transition trans)
+	 (cond
+	    ((string? trans)
+	     (printf "[~s]" trans))
+	    ((eq? trans 'slide)
+	     (printf "[Blinds]"))
+	    ((and (symbol? trans)
+		  (memq trans '(split blinds box wipe dissolve glitter)))
+	     (printf "[~s]"
+		     (string-upcase (symbol->string trans))))
+	    (else
+	     #f)))
+      ;; latex configuration
+      (define (prosper-slide n e)
+	 (let* ((i (markup-option n :image))
+		(t (markup-option n :title))
+		(lt (markup-option n :transition))
+		(gt (engine-custom e 'transition))
+		(pa (search-down (lambda (x) (is-markup? x 'slide-pause)) n))
+		(lpa (length pa)))
+	    (set! overlay-count 1)
+	    (if (>= lpa 1) (printf "\\overlays{~a}{%\n" (+ 1 lpa)))
+	    (display "\\begin{slide}")
+	    (prosper-transition (or lt gt))
+	    (display "{")
+	    (output t e)
+	    (display "}\n")
+	    (output (markup-body n) e)
+	    (display "\\end{slide}\n")
+	    (if (>= lpa 1) (display "}\n"))
+	    (newline)
+	    (newline)))
+      (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n")
+      (let* ((cap (engine-custom le 'slide-caption))
+	     (o (engine-custom le 'predocument))
+	     (n (if (string? cap)
+		    (format #f "~a\\slideCaption{~a}\n"
+			    &slide-prosper-predocument
+			    cap)
+		    &slide-prosper-predocument)))
+	 (engine-custom-set! le 'predocument
+	    (if (string? o) (string-append n o) n)))
+      (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n")
+      ;; writers
+      (set! &latex-slide prosper-slide)
+      (set! &latex-pause
+	    (lambda (n e)
+	       (set! overlay-count (+ 1 overlay-count))
+	       (printf "\\FromSlide{~s}%\n" overlay-count)))))
+
+;*---------------------------------------------------------------------*/
+;*    Setup ...                                                        */
+;*---------------------------------------------------------------------*/
+(let* ((opt &slide-load-options)
+       (p (memq :prosper opt)))
+   (if (and (pair? p) (pair? (cdr p)) (cadr p))
+       ;; prosper
+       (set! %slide-latex-mode 'prosper)
+       (let ((a (memq :advi opt)))
+	  (if (and (pair? a) (pair? (cdr a)) (cadr a))
+	      ;; advi
+	      (set! %slide-latex-mode 'advi)))))
+
+
+
+;;;
+;;; Initialization.
+;;;
+
+(%slide-latex-initialize!)
+
+;;; arch-tag: b99e2c65-55f7-462c-8482-f47c7e223538
diff --git a/src/guile/skribilo/package/slide/lout.scm b/src/guile/skribilo/package/slide/lout.scm
new file mode 100644
index 0000000..d53cff1
--- /dev/null
+++ b/src/guile/skribilo/package/slide/lout.scm
@@ -0,0 +1,151 @@
+;;; lout.scm  --  Lout implementation of the `slide' package.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package slide lout)
+  :use-module (skribilo utils syntax)
+
+  ;; XXX: If changing the following `autoload' to `use-module' doesn't work,
+  ;; then you need to fix your Guile.  See this thread about
+  ;; `make-autoload-interface':
+  ;;
+  ;;   http://article.gmane.org/gmane.lisp.guile.devel/5748
+  ;;   http://lists.gnu.org/archive/html/guile-devel/2006-03/msg00004.html .
+
+  :autoload (skribilo engine lout) (lout-tagify lout-output-pdf-meta-info
+				    lout-verbatim-encoding))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; TODO:
+;;;
+;;; Make some more PS/PDF trickery.
+
+(format (current-error-port) "Lout slides setup...~%")
+
+(let ((le (find-engine 'lout)))
+
+  ;; FIXME: Automatically switching to `slides' is problematic, e.g., for the
+  ;; user manual which embeds slides.
+;  ;; Automatically switch to the `slides' document type.
+;  (engine-custom-set! le 'document-type 'slides))
+
+  (markup-writer 'slide le
+     :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 le
+     :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 le
+     ;; 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 le
+     :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)))))))))
+
+
+
+;;;
+;;; Customs for a nice handling of topics/subtopics.
+;;;
+
+(let ((lout (find-engine 'lout)))
+  (if lout
+      (begin
+	(engine-custom-set! lout 'pdf-bookmark-node-pred
+			    (lambda (n e)
+			      (or (is-markup? n 'slide)
+				  (is-markup? n 'slide-topic)
+				  (is-markup? n 'slide-subtopic))))
+	(engine-custom-set! lout 'pdf-bookmark-closed-pred
+			    (lambda (n e) #f)))))
+
+
+;;; arch-tag: 0c717553-5cbb-46ed-937a-f844b6aeb145
diff --git a/src/guile/skribilo/package/web-article.scm b/src/guile/skribilo/package/web-article.scm
new file mode 100644
index 0000000..6d1b7a5
--- /dev/null
+++ b/src/guile/skribilo/package/web-article.scm
@@ -0,0 +1,241 @@
+;;; web-article.scm  --  A Skribe style for producing web articles
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package web-article))
+
+;*---------------------------------------------------------------------*/
+;*    &web-article-load-options ...                                    */
+;*---------------------------------------------------------------------*/
+(define &web-article-load-options (skribe-load-options))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-body-width ...                                       */
+;*---------------------------------------------------------------------*/
+(define (web-article-body-width e)
+   (let ((w (engine-custom e 'body-width)))
+      (if (or (number? w) (string? w)) w 98.)))
+
+;*---------------------------------------------------------------------*/
+;*    html-document-title-web ...                                      */
+;*---------------------------------------------------------------------*/
+(define (html-document-title-web n e)
+   (let* ((title (markup-body n))
+	  (authors (markup-option n 'author))
+	  (tbg (engine-custom e 'title-background))
+	  (tfg (engine-custom e 'title-foreground))
+	  (tfont (engine-custom e 'title-font)))
+      (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>"
+	      (html-width (web-article-body-width e)))
+      (if (string? tbg)
+	  (printf "<td bgcolor=\"~a\">" tbg)
+	  (display "<td>"))
+      (if (string? tfg)
+	  (printf "<font color=\"~a\">" tfg))
+      (if title
+	  (begin
+	     (display "<center>")
+	     (if (string? tfont)
+		 (begin
+		    (printf "<font ~a><b>" tfont)
+		    (output title e)
+		    (display "</b></font>"))
+		 (begin
+		    (printf "<h1>")
+		    (output title e)
+		    (display "</h1>")))
+	     (display "</center>\n")))
+      (if (not authors)
+	  (display "\n")
+	  (html-title-authors authors e))
+      (if (string? tfg)
+	  (display "</font>"))
+      (display "</td></tr></tbody></table></center>\n")))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-css-document-title ...                               */
+;*---------------------------------------------------------------------*/
+(define (web-article-css-document-title n e)
+   (let* ((title (markup-body n))
+	  (authors (markup-option n 'author))
+	  (id (markup-ident n)))
+      ;; the title
+      (printf "<div id=\"~a\" class=\"document-title-title\">\n"
+	      (string-canonicalize id))
+      (output title e)
+      (display "</div>\n")
+      ;; the authors
+      (printf "<div id=\"~a\" class=\"document-title-authors\">\n"
+	      (string-canonicalize id))
+      (for-each (lambda (a) (output a e))
+		(cond
+		   ((is-markup? authors 'author)
+		    (list authors))
+		   ((list? authors)
+		    authors)
+		   (else
+		    '())))
+      (display "</div>\n")))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-css-author ...                                       */
+;*---------------------------------------------------------------------*/
+(define (web-article-css-author n e)
+   (let ((name (markup-option n :name))
+	 (title (markup-option n :title))
+	 (affiliation (markup-option n :affiliation))
+	 (email (markup-option n :email))
+	 (url (markup-option n :url))
+	 (address (markup-option n :address))
+	 (phone (markup-option n :phone))
+	 (nfn (engine-custom e 'author-font))
+	 (align (markup-option n :align)))
+      (when name
+	 (printf "<span class=\"document-author-name\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output name e)
+	 (display "</span>\n"))
+      (when title
+	 (printf "<span class=\"document-author-title\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output title e)
+	 (display "</span>\n"))
+      (when affiliation
+	 (printf "<span class=\"document-author-affiliation\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output affiliation e)
+	 (display "</span>\n"))
+      (when (pair? address)
+	 (printf "<span class=\"document-author-address\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (for-each (lambda (a)
+		      (output a e)
+		      (newline))
+		   address)
+	 (display "</span>\n"))
+      (when phone
+	 (printf "<span class=\"document-author-phone\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output phone e)
+	 (display "</span>\n"))
+      (when email
+	 (printf "<span class=\"document-author-email\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output email e)
+	 (display "</span>\n"))
+      (when url
+	 (printf "<span class=\"document-author-url\" id=\"~a\">"
+		 (string-canonicalize (markup-ident n)))
+	 (output url e)
+	 (display "</span>\n"))))
+
+;*---------------------------------------------------------------------*/
+;*    HTML settings                                                    */
+;*---------------------------------------------------------------------*/
+(define (web-article-modern-setup he)
+   (let ((sec (markup-writer-get 'section he))
+	 (ft (markup-writer-get '&html-footnotes he)))
+      ;; &html-document-title
+      (markup-writer '&html-document-title he
+	 :action html-document-title-web)
+      ;; section
+      (markup-writer 'section he
+	 :options 'all
+	 :before "<br>"
+	 :action (lambda (n e)
+		    (let ((e1 (make-engine 'html-web :delegate e))
+			  (bg (engine-custom he 'section-background)))
+		       (markup-writer 'section e1
+			  :options 'all
+			  :action (lambda (n e2) (output n e sec)))
+		       (skribe-eval
+			(center (color :width (web-article-body-width e)
+				   :margin 5 :bg bg n))
+			e1))))
+      ;; &html-footnotes
+      (markup-writer '&html-footnotes he
+	 :options 'all
+	 :before "<br>"
+	 :action (lambda (n e)
+		    (let ((e1 (make-engine 'html-web :delegate e))
+			  (bg (engine-custom he 'section-background))
+			  (fg (engine-custom he 'subsection-title-foreground)))
+		       (markup-writer '&html-footnotes e1
+			  :options 'all
+			  :action (lambda (n e2)
+				     (invoke (writer-action ft) n e)))
+		       (skribe-eval
+			(center (color :width (web-article-body-width e)
+				   :margin 5 :bg bg :fg fg n))
+			e1))))))
+
+;*---------------------------------------------------------------------*/
+;*    web-article-css-setup ...                                        */
+;*---------------------------------------------------------------------*/
+(define (web-article-css-setup he)
+   (let ((sec (markup-writer-get 'section he))
+	 (ft (markup-writer-get '&html-footnotes he)))
+      ;; &html-document-title
+      (markup-writer '&html-document-title he
+	 :before (lambda (n e)
+		    (printf "<div id=\"~a\" class=\"document-title\">\n"
+			    (string-canonicalize (markup-ident n))))
+	 :action web-article-css-document-title
+	 :after "</div>\n")
+      ;; author
+      (markup-writer 'author he
+	 :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+	 :before (lambda (n e)
+		    (printf "<span id=\"~a\" class=\"document-author\">\n"
+			    (string-canonicalize (markup-ident n))))
+	 :action web-article-css-author
+	 :after "</span\n")
+      ;; section
+      (markup-writer 'section he
+	 :options 'all
+	 :before (lambda (n e)
+		    (printf "<div class=\"section\" id=\"~a\">"
+			    (string-canonicalize (markup-ident n))))
+	 :action (lambda (n e) (output n e sec))
+	 :after "</div>\n")
+      ;; &html-footnotes
+      (markup-writer '&html-footnotes he
+	 :options 'all
+	 :before (lambda (n e)
+		    (printf "<div class=\"footnotes\" id=\"~a\">"
+			    (string-canonicalize (markup-ident n))))
+	 :action (lambda (n e)
+		    (output n e ft))
+	 :after "</div>\n")))
+
+;*---------------------------------------------------------------------*/
+;*    Setup ...                                                        */
+;*---------------------------------------------------------------------*/
+(let* ((opt &web-article-load-options)
+       (p (memq :style opt))
+       (css (memq :css opt))
+       (he (find-engine 'html)))
+   (cond
+      ((and (pair? p) (pair? (cdr p)) (eq? (cadr p) 'css))
+       (web-article-css-setup he))
+      ((and (pair? css) (pair? (cdr css)) (string? (cadr css)))
+       (engine-custom-set! he 'css (cadr css))
+       (web-article-css-setup he))
+      (else
+       (web-article-modern-setup he))))
diff --git a/src/guile/skribilo/package/web-book.scm b/src/guile/skribilo/package/web-book.scm
new file mode 100644
index 0000000..49197f1
--- /dev/null
+++ b/src/guile/skribilo/package/web-book.scm
@@ -0,0 +1,121 @@
+;;; web-book.scm  --  The Skribe web book style.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-skribe-module (skribilo package web-book))
+
+;*---------------------------------------------------------------------*/
+;*    html customization                                               */
+;*---------------------------------------------------------------------*/
+(define he (find-engine 'html))
+(engine-custom-set! he 'main-browsing-extra #f)
+(engine-custom-set! he 'chapter-file #t)
+
+;*---------------------------------------------------------------------*/
+;*    main-browsing ...                                                */
+;*---------------------------------------------------------------------*/
+(define main-browsing 
+   (lambda (n e)
+      ;; search the document
+      (let ((p (ast-document n)))
+	 (cond
+	    ((document? p)
+	     ;; got it
+	     (let* ((mt (markup-option p :margin-title))
+ 		    (r (ref :handle (handle p)
+ 			    :text (or mt (markup-option p :title))))
+ 		    (fx (engine-custom e 'web-book-main-browsing-extra)))
+		(center
+		 (table :width 97. :border 1 :frame 'box
+		    :cellpadding 0 :cellspacing 0
+		    (tr :bg (engine-custom e 'title-background)
+		       (th (let ((text (bold "main page"))
+                                 (bg   (engine-custom e 'background)))
+                             (if bg (color :fg bg text) text))))
+		    (tr :bg (engine-custom e 'background)
+		       (td (apply table :width 100. :border 0
+				  (tr (td :align 'left 
+					 :valign 'top 
+					 (bold "top:"))
+				     (td :align 'right 
+					:valign 'top r))
+				  (if (procedure? fx)
+				      (list (tr (td :width 100. 
+						   :colspan 2 
+						   (fx n e))))
+				      '()))))))))
+	    ((not p)
+	     ;; no document!!!
+	     #f)))))
+
+;*---------------------------------------------------------------------*/
+;*    chapter-browsing ...                                             */
+;*---------------------------------------------------------------------*/
+(define chapter-browsing
+   (lambda (n e)
+      (center
+       (table :width 97. :border 1 :frame 'box
+	  :cellpadding 0 :cellspacing 0
+	      (tr :bg (engine-custom e 'title-background)
+		  (th (let ((title (bold (markup-option n :title)))
+                            (bg    (engine-custom e 'background)))
+                        (if bg (color :fg title) title))))
+	      (tr :bg (engine-custom e 'background)
+		  (td (toc (handle n) :chapter #t :section #t :subsection #t)))))))
+
+;*---------------------------------------------------------------------*/
+;*    document-browsing ...                                            */
+;*---------------------------------------------------------------------*/
+(define document-browsing
+   (lambda (n e)
+      (let ((chap (find1-down (lambda (n)
+				 (is-markup? n 'chapter))
+			      n)))
+	 (center
+	    (table :width 97. :border 1 :frame 'box
+	       :cellpadding 0 :cellspacing 0
+	       (tr :bg (engine-custom e 'title-background)
+		  (th (let ((text (bold (if chap "Chapters" "Sections")))
+                            (bg   (engine-custom e 'background)))
+                        (if bg (color :fg bg text) text))))
+	       (tr :bg (engine-custom e 'background)
+		  (td (if chap
+			  (toc (handle n) :chapter #t :section #f)
+			  (toc (handle n) :section #t :subsection #t)))))))))
+
+;*---------------------------------------------------------------------*/
+;*    left margin ...                                                  */
+;*---------------------------------------------------------------------*/
+(engine-custom-set! he 'left-margin-size 20.)
+
+(engine-custom-set! he 'left-margin
+   (lambda (n e) 
+      (let ((d (ast-document n))
+	    (c (ast-chapter n)))
+	 (list (linebreak 1)
+	       (main-browsing n e)
+	       (if (is-markup? c 'chapter)
+		   (list (linebreak 2)
+			 (chapter-browsing c e))
+		   #f)
+	       (if (document? d)
+		   (list (linebreak 2)
+			 (document-browsing d e))
+		   #f)))))
+
diff --git a/src/guile/skribilo/parameters.scm b/src/guile/skribilo/parameters.scm
new file mode 100644
index 0000000..5893851
--- /dev/null
+++ b/src/guile/skribilo/parameters.scm
@@ -0,0 +1,88 @@
+;;; parameters.scm  --  Skribilo settings as parameter objects.
+;;;
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo parameters)
+  :use-module (srfi srfi-39))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module defines parameter objects that may be used to specify
+;;; run-time parameters of a Skribilo process.
+;;;
+;;; Code:
+
+
+;;;
+;;; Switches.
+;;;
+
+(define (make-expect pred pred-name parameter)
+  (let ((msg (string-append parameter ": " pred-name " expected")))
+    (lambda (val)
+      (if (pred val)
+	  val
+	  (error msg val)))))
+
+(define-macro (define-number-parameter name)
+  `(define-public ,name
+     (make-parameter 0
+		     (make-expect number? "number" ,(symbol->string name)))))
+
+(define-number-parameter *verbose*)
+(define-number-parameter *warning*)
+
+(define-public *load-rc-file?* (make-parameter #f))
+
+;;;
+;;; Paths.
+;;;
+
+
+(define-macro (define-path-parameter name)
+  `(define-public ,name
+     (make-parameter (list ".")
+		     (make-expect list? "list" ,(symbol->string name)))))
+
+
+(define-path-parameter *document-path*)
+(define-path-parameter *bib-path*)
+(define-path-parameter *source-path*)
+(define-path-parameter *image-path*)
+
+
+;;;
+;;; Files.
+;;;
+
+(define-public *destination-file* (make-parameter "output.html"))
+(define-public *source-file*      (make-parameter "default-input-file.skb"))
+
+;; Base prefix to remove from hyperlinks.
+(define-public *ref-base*         (make-parameter ""))
+
+;;; TODO: Skribe used to have other parameters as global variables.  See
+;;; which ones need to be kept.
+
+
+;;; arch-tag: 3c0d2e18-b997-4615-8a3d-b6622ae28874
+
+;;; parameters.scm ends here
diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm
new file mode 100644
index 0000000..266d607
--- /dev/null
+++ b/src/guile/skribilo/prog.scm
@@ -0,0 +1,220 @@
+;;; prog.scm  --  All the stuff for the prog markup
+;;;
+;;; Copyright 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2006 Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo prog)
+  :use-module (ice-9 regex)
+  :autoload   (ice-9 receive) (receive)
+  :use-module (skribilo lib)  ;; `new'
+  :autoload   (skribilo ast) (node? node-body)
+  :export (make-prog-body resolve-line))
+
+;;; ======================================================================
+;;;
+;;; COMPATIBILITY
+;;;
+;;; ======================================================================
+(define pregexp-match 	string-match)
+(define pregexp-replace (lambda (rx str what)
+			  (regexp-substitute/global #f rx str
+						    'pre what 'post)))
+(define pregexp-quote   regexp-quote)
+
+
+(define (node-body-set! b v)
+  (slot-set! b 'body v))
+
+;;;
+;;; FIXME: Tout le module peut se factoriser
+;;;        définir en bigloo  node-body-set
+
+
+;*---------------------------------------------------------------------*/
+;*    *lines* ...                                                      */
+;*---------------------------------------------------------------------*/
+;; FIXME: Removed that global.  Rework the thing.
+(define *lines* (make-hash-table))
+
+;*---------------------------------------------------------------------*/
+;*    make-line-mark ...                                               */
+;*---------------------------------------------------------------------*/
+(define (make-line-mark m line-ident b)
+   (let* ((n (list (mark line-ident) b)))
+      (hash-set! *lines* m n)
+      n))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-line ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (resolve-line id)
+   (hash-ref *lines* id))
+
+;*---------------------------------------------------------------------*/
+;*    extract-string-mark ...                                          */
+;*---------------------------------------------------------------------*/
+(define (extract-string-mark line mark regexp)
+   (let ((m (pregexp-match regexp line)))
+      (if (pair? m)
+	  (values (substring (car m)
+			     (string-length mark)
+			     (string-length (car m)))
+		  (pregexp-replace regexp line ""))
+	  (values #f line))))
+   
+;*---------------------------------------------------------------------*/
+;*    extract-mark ...                                                 */
+;*    -------------------------------------------------------------    */
+;*    Extract the prog mark from a line.                               */
+;*---------------------------------------------------------------------*/
+(define (extract-mark line mark regexp)
+   (cond
+      ((not regexp)
+       (values #f line))
+      ((string? line)
+       (extract-string-mark line mark regexp))
+      ((list? line)
+       (let loop ((ls line)
+		  (res '()))
+	  (if (null? ls)
+	      (values #f line)
+	      (receive (m l)
+		 (extract-mark (car ls) mark regexp)
+		 (if (not m)
+		     (loop (cdr ls) (cons l res))
+		     (values m (append (reverse! res) (cons l (cdr ls)))))))))
+      ((node? line)
+       (receive (m l)
+	  (extract-mark (node-body line) mark regexp)
+	  (if (not m)
+	      (values #f line)
+	      (begin
+		 (node-body-set! line l)
+		 (values m line)))))
+      (else
+       (values #f line))))
+
+;*---------------------------------------------------------------------*/
+;*    split-line ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (split-line line)
+   (cond
+      ((string? line)
+       (let ((l (string-length line)))
+	  (let loop ((r1 0)
+		     (r2 0)
+		     (res '()))
+	     (cond
+		((= r2 l)
+		 (if (= r1 r2)
+		     (reverse! res)
+		     (reverse! (cons (substring line r1 r2) res))))
+		((char=? (string-ref line r2) #\Newline)
+		 (loop (+ r2 1)
+		       (+ r2 1)
+		       (if (= r1 r2)
+			   (cons 'eol res)
+			   (cons* 'eol (substring line r1 r2) res))))
+		(else
+		 (loop r1
+		       (+ r2 1)
+		       res))))))
+      ((list? line)
+       (let loop ((ls line)
+		  (res '()))
+	  (if (null? ls)
+	      res
+	      (loop (cdr ls) (append res (split-line (car ls)))))))
+      (else
+       (list line))))
+
+;*---------------------------------------------------------------------*/
+;*    flat-lines ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (flat-lines lines)
+   (apply append (map split-line lines)))
+
+;*---------------------------------------------------------------------*/
+;*    collect-lines ...                                                */
+;*---------------------------------------------------------------------*/
+(define (collect-lines lines)
+   (let loop ((lines (flat-lines lines))
+	      (res '())
+	      (tmp '()))
+      (cond
+	 ((null? lines)
+	  (reverse! (cons (reverse! tmp) res)))
+	 ((eq? (car lines) 'eol)
+	  (cond
+	     ((null? (cdr lines))
+	      (reverse! (cons (reverse! tmp) res)))
+	     ((and (null? res) (null? tmp))
+	      (loop (cdr lines)
+		    res
+		    '()))
+	     (else
+	      (loop (cdr lines)
+		    (cons (reverse! tmp) res)
+		    '()))))
+	 (else
+	  (loop (cdr lines)
+		res
+		(cons (car lines) tmp))))))
+      
+;*---------------------------------------------------------------------*/
+;*    make-prog-body ...                                               */
+;*---------------------------------------------------------------------*/
+(define (make-prog-body src lnum-init ldigit mark)
+   (define (int->str i rl)
+      (let* ((s (number->string i))
+	     (l (string-length s)))
+	 (if (= l rl)
+	     s
+	     (string-append (make-string (- rl l) #\space) s))))
+ 
+   (let* ((regexp (and mark
+		       (format #f "~a[-a-zA-Z_][-0-9a-zA-Z_]+"
+			       (pregexp-quote mark))))
+	  (src (cond
+		  ((not (pair? src)) (list src))
+		  ((and (pair? (car src)) (null? (cdr src))) (car src))
+		  (else src)))
+	  (lines (collect-lines src))
+	  (lnum (if (integer? lnum-init) lnum-init 1))
+	  (s (number->string (+ (if (integer? ldigit)
+				    (max lnum (expt 10 (- ldigit 1)))
+				    lnum)
+				(length lines))))
+	  (cs (string-length s)))
+     (let loop ((lines lines)
+		 (lnum lnum)
+		 (res '()))
+	 (if (null? lines)
+	     (reverse! res)
+	     (receive (m l)
+		      (extract-mark (car lines) mark regexp)
+		(let* ((line-ident (symbol->string (gensym "&prog-line")))
+		       (n (new markup
+			     (markup '&prog-line)
+			     (ident  line-ident)
+			     (body (if m (make-line-mark m line-ident l) l)))))
+ 		   (loop (cdr lines)
+ 			 (+ lnum 1)
+ 			 (cons n res))))))))
+
diff --git a/src/guile/skribilo/reader.scm b/src/guile/skribilo/reader.scm
new file mode 100644
index 0000000..871d92c
--- /dev/null
+++ b/src/guile/skribilo/reader.scm
@@ -0,0 +1,106 @@
+;;; reader.scm  --  Skribilo's front-end (aka. reader) interface.
+;;;
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo reader)
+  :use-module (srfi srfi-9)  ;; records
+  :use-module (srfi srfi-17) ;; generalized `set!'
+  :use-module (srfi srfi-39) ;; parameter objects
+  :use-module (skribilo condition)
+  :autoload   (srfi srfi-34) (raise)
+  :use-module (srfi srfi-35)
+  :export (%make-reader lookup-reader make-reader
+	   %default-reader *document-reader*
+
+	   &reader-search-error reader-search-error?
+	   reader-search-error:reader)
+  :export-syntax (define-reader define-public-reader))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module contains Skribilo's front-end (aka. ``reader'') interface.
+;;; Skribilo's default reader is `(skribilo reader skribe)' which provides a
+;;; reader for the Skribe syntax.
+;;;
+;;; Code:
+
+(define-record-type <reader>
+  (%make-reader name version make)
+  reader?
+  (name      reader:name      reader:set-name!)    ;; a symbol
+  (version   reader:version   reader:set-version!) ;; a string
+  (make      reader:make      reader:set-make!))   ;; a one-argument proc
+                                                   ;; that returns a reader
+                                                   ;; proc
+
+(define-public reader:name
+  (getter-with-setter reader:name reader:set-name!))
+
+(define-public reader:version
+  (getter-with-setter reader:version reader:set-version!))
+
+(define-public reader:make
+  (getter-with-setter reader:make reader:set-make!))
+
+(define-macro (define-reader name version make-proc)
+  `(define reader-specification
+     (%make-reader (quote ,name) ,version ,make-proc)))
+
+(define-macro (define-public-reader name version make-proc)
+  `(define-reader ,name ,version ,make-proc))
+
+
+;;; Error condition.
+
+(define-condition-type &reader-search-error &skribilo-error
+  reader-search-error?
+  (reader reader-search-error:reader))
+
+
+
+;;; The mechanism below is inspired by Guile-VM code written by K. Nishida.
+
+(define (lookup-reader name)
+  "Look for a reader named @var{name} (a symbol) in the @code{(skribilo
+reader)} module hierarchy.  If no such reader was found, an error is
+raised."
+  (let ((m (false-if-exception
+	    (resolve-module `(skribilo reader ,name)))))
+    (if (and (module? m)
+	     (module-bound? m 'reader-specification))
+	(module-ref m 'reader-specification)
+	(raise (condition (&reader-search-error (reader name)))))))
+
+(define (make-reader name)
+  "Look for reader @var{name} and instantiate it."
+  (let* ((spec (lookup-reader name))
+         (make (reader:make spec)))
+    (make)))
+
+(define %default-reader (make-reader 'skribe))
+
+
+;;; Current document reader.
+
+(define *document-reader* (make-parameter %default-reader))
+
+
+;;; reader.scm ends here
diff --git a/src/guile/skribilo/reader/Makefile.am b/src/guile/skribilo/reader/Makefile.am
new file mode 100644
index 0000000..807e4a7
--- /dev/null
+++ b/src/guile/skribilo/reader/Makefile.am
@@ -0,0 +1,2 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/reader
+dist_guilemodule_DATA = skribe.scm outline.scm
diff --git a/src/guile/skribilo/reader/outline.scm b/src/guile/skribilo/reader/outline.scm
new file mode 100644
index 0000000..09792f5
--- /dev/null
+++ b/src/guile/skribilo/reader/outline.scm
@@ -0,0 +1,426 @@
+;;; outline.scm  --  A reader for Emacs' outline syntax.
+;;;
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo reader outline)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo reader)
+  :use-module (ice-9 optargs)
+  :use-module (srfi srfi-11)
+
+  :autoload   (ice-9 rdelim) (read-line)
+  :autoload   (ice-9 regex) (make-regexp)
+
+  :export (reader-specification
+           make-outline-reader))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; A reader for Emacs' outline-mode syntax.
+;;;
+;;; Code:
+
+;;; TODO:
+;;;
+;;; - add source position information;
+;;; - handle `blockquote' (indented paragraph);
+;;; - handle sublists (indented lists) --- optional;
+;;; - handle inline Skribe code: `\n{skribe\n(table (tr ... ))\n}\n'
+
+
+
+
+;;;
+;;; Tools.
+;;;
+
+(define (apply-any procs args)
+  "Apply the procedure listed in @var{procs} to @var{args} until one of these
+procedure returns true."
+  (let loop ((procs procs))
+    (if (null? procs)
+	#f
+	(let ((result (apply (car procs) args)))
+	  (if result result (loop (cdr procs)))))))
+
+(define (make-markup name body)
+  "Return a clean markup form, i.e., an s-exp whose @code{car} is a symbol
+equal to @var{name}, a markup name."
+  (cond ((list? body)
+	 (cond ((null? body) `(,name))
+	       ((symbol? (car body)) `(,name ,body))
+	       (else `(,name ,@body))))
+	(else
+	 (list name body))))
+
+
+(define (append-trees . trees)
+  "Append markup trees @var{trees}.  Trees whose car is a symbol (e.g.,
+@code{(bold \"paf\")} will be considered as sub-trees of the resulting tree."
+  (let loop ((trees trees)
+	     (result '()))
+    (if (null? trees)
+	result
+	(let ((tree (car trees)))
+	  (loop (cdr trees)
+		(append result
+			(if (list? tree)
+			    (cond ((null? tree) '())
+				  ((symbol? (car tree)) (list tree))
+				  (else tree))
+			    (list tree))))))))
+
+(define (null-string? s)
+  (and (string? s) (string=? s "")))
+
+
+(define empty-line-rx (make-regexp "^([[:space:]]*|;.*)$"))
+(define (empty-line? s)
+  "Return true if string @var{s} denotes an ``empty'' line, i.e., a blank
+line or a line comment."
+  (regexp-exec empty-line-rx s))
+
+
+
+;;;
+;;; In-line markup, i.e., markup that doesn't span over multiple lines.
+;;;
+
+(define %inline-markup
+  ;; Note: the order matters because, for instance, URLs must be searched for
+  ;; _before_ italics (`/italic/').
+  `(("_([^_]+)_" .
+     ,(lambda (m)
+	(values (match:prefix m)                           ;; before
+		(match:substring m 1)                      ;; body
+		(match:suffix m)                           ;; after
+		(lambda (body) `(emph ,body)))))           ;; process-body
+    ("(f|ht)tp://[a-zA-Z0-9\\._~%/-]+" .
+     ,(lambda (m)
+	(values (match:prefix m)
+		(match:substring m)
+		(match:suffix m)
+		(lambda (url) `(ref :url ,url)))))
+    ("\\/([^\\/]+)\\/" .
+     ,(lambda (m)
+	(values (match:prefix m)
+		(match:substring m 1)
+		(match:suffix m)
+		(lambda (body) `(it ,body)))))
+    ("\\*([^\\*]+)\\*" .
+     ,(lambda (m)
+	(values (match:prefix m)
+		(match:substring m 1)
+		(match:suffix m)
+		(lambda (body) `(bold ,body)))))
+    ("``(([^`^'])+)''" .
+     ,(lambda (m)
+	(values (match:prefix m)
+		(match:substring m 1)
+		(match:suffix m)
+		(lambda (body) `(q ,body)))))
+    ("`(([^`^'])+)'" .
+     ,(lambda (m)
+	(values (match:prefix m)
+		(match:substring m 1)
+		(match:suffix m)
+		(lambda (body) `(tt ,body)))))))
+
+(define (make-markup-processor rx proc)
+  (lambda (line)
+    (let ((match (regexp-exec rx line)))
+      (if match
+	  (proc match)
+	  #f))))
+
+(define (make-line-processor markup-alist)
+  "Returns a @dfn{line processor}.  A line processor is a procedure that
+takes a string and returns a list."
+  (let* ((markups (map (lambda (rx+proc)
+			 (cons (make-regexp (car rx+proc) regexp/extended)
+			       (cdr rx+proc)))
+		       markup-alist))
+	 (procs (map (lambda (rx+proc)
+		       (make-markup-processor (car rx+proc) (cdr rx+proc)))
+		     markups)))
+    (lambda (line)
+      (let self ((line line))
+	;;(format #t "self: ~a~%" line)
+	(cond ((string? line)
+	       (let ((result (apply-any procs (list line))))
+		 (if result
+		     (let-values (((before body after proc-body)
+				   result))
+		       (let ((body+
+			      (if (string=? (string-append before body after)
+					    line)
+				  body (self body))))
+			 (if (and (null-string? before)
+				  (null-string? after))
+			     (proc-body body+)
+			     (append-trees (self before)
+					   (proc-body body+)
+					   (self after)))))
+		     line)))
+	      (else
+	       (error "line-processor: internal error" line)))))))
+
+(define %line-processor
+  (make-line-processor %inline-markup))
+
+
+
+;;;
+;;; Large-scale structures: paragraphs, chapters, sections, etc.
+;;;
+
+(define (process-paragraph line line-proc port)
+  (let loop ((line line)
+	     (result '()))
+    (if (or (eof-object? line) (empty-line? line))
+	(cons 'p result)
+	(loop (read-line port)
+	      (let ((line (line-proc line)))
+		(append-trees result line "\n"))))))
+
+(define (make-list-processor rx node-type extract-line-proc line-proc
+			     end-of-node?)
+  "Return a procedure (a @dfn{list processor}) that takes a line and a port
+and returns an AST node of type @var{node-type} (a symbol, typically
+@code{itemize} or @code{enumerate}) along with a line.  If the processor is
+not triggered, i.e., it is passed a line that does not match @var{rx}, then
+it returns @code{#f}."
+  (lambda (line port)
+    (let ((match (regexp-exec rx line)))
+      (if (not match)
+	  #f
+	  (let loop ((line line)
+		     (contiguous-empty-lines 0)
+		     (item '())
+		     (body '()))
+	      (if (eof-object? line)
+		  (let ((body (if (null? item)
+				  body
+				  (cons `(item ,@(reverse! item)) body))))
+		    (values line `(,node-type ,@(reverse! body))))
+		  (let ((match (regexp-exec rx line)))
+		    (cond (match
+			   ;; reading the first line of an item
+			   (loop (read-line port) 0
+				 (append-trees
+				  (line-proc (extract-line-proc match)))
+				 body))
+
+			  ((and (procedure? end-of-node?)
+				(end-of-node? line))
+			   (values line
+				   `(,node-type ,@(reverse! body))))
+
+			  ((empty-line? line)
+			   (cond ((>= contiguous-empty-lines 1)
+				  ;; end of list
+				  (values line
+					  `(,node-type ,@(reverse! body))))
+
+				 ((= contiguous-empty-lines 0)
+				  ;; end of item: add ITEM to BODY
+				  (loop (read-line port) 1 '()
+					(cons (make-markup 'item item)
+					      body)))
+
+				 (else
+				  ;; skipping empty line
+				  (loop (read-line port)
+					(+ 1 contiguous-empty-lines)
+					item body))))
+
+			  (else
+			   ;; reading an item: add LINE to ITEM
+			   (loop (read-line port) 0
+				 (append-trees item (line-proc line))
+				 body))))))))))
+
+(define (make-node-processor rx node-type title-proc line-proc
+			     subnode-procs end-of-node?)
+  "Return a procedure that reads the given string and return an AST node of
+type @var{node-type} or @code{#f}.  When the original string matches the node
+header, then the rest of the node is read from @var{port}.
+@var{subnode-procs} is a list of node processors for node types subordinate
+to @var{node-type}."
+  (lambda (line port)
+    (let ((match (regexp-exec rx line)))
+      (if (not match)
+	  #f
+	  (let ((title (line-proc (title-proc match))))
+	    (let loop ((line (read-line port))
+		       (body '()))
+
+	      (let ((subnode (and (not (eof-object? line))
+				  (apply-any subnode-procs
+					     (list line port)))))
+		(cond (subnode
+		       (let-values (((line node) subnode))
+			 (loop line (cons node body))))
+
+		      ((or (eof-object? line)
+			   (regexp-exec rx line)
+			   (and (procedure? end-of-node?)
+				(end-of-node? line)))
+		       (values line
+			       `(,node-type :title ,title ,@(reverse! body))))
+
+		      ((empty-line? line)
+		       (loop (read-line port) body))
+
+		      (else
+			   (let ((par (process-paragraph line line-proc port)))
+			     (loop (read-line port)
+				   (cons par body))))))))))))
+
+
+(define (node-markup-line? line)
+  (define node-rx (make-regexp "^\\*+ (.+)$" regexp/extended))
+  (regexp-exec node-rx line))
+
+(define %list-processors
+  (list (make-list-processor (make-regexp "^[-~o] (.+)$" regexp/extended)
+			     'itemize
+			     (lambda (m) (match:substring m 1))
+			     %line-processor
+			     node-markup-line?)
+	(make-list-processor (make-regexp "^([0-9]+)\\.? (.+)$"
+					  regexp/extended)
+			     'enumerate
+			     (lambda (m) (match:substring m 2))
+			     %line-processor
+			     node-markup-line?)))
+
+(define %node-processors
+  (let* ((subsubsection-proc
+	  (make-node-processor (make-regexp "^\\*\\*\\*\\* (.+)$"
+					    regexp/extended)
+			       'subsection
+			       (lambda (m) (match:substring m 1))
+			       %line-processor
+			       %list-processors ;; no further subnodes
+			       node-markup-line?))
+	 (subsection-proc
+	  (make-node-processor (make-regexp "^\\*\\*\\* (.+)$"
+					    regexp/extended)
+			       'subsection
+			       (lambda (m) (match:substring m 1))
+			       %line-processor
+			       (append %list-processors
+				       (list subsubsection-proc))
+			       node-markup-line?))
+	 (section-proc
+	  (make-node-processor (make-regexp "^\\*\\* (.+)$" regexp/extended)
+			       'section
+			       (lambda (m) (match:substring m 1))
+			       %line-processor
+			       (append %list-processors
+				       (list subsection-proc))
+			       node-markup-line?)))
+    (list (make-node-processor (make-regexp "^\\* (.+)$" regexp/extended)
+			       'chapter
+			       (lambda (m) (match:substring m 1))
+			       %line-processor
+			       (append %list-processors
+				       (list section-proc))
+			       #f))))
+
+
+
+
+;;;
+;;; The top-level parser.
+;;;
+
+(define (make-document-processor node-procs line-proc)
+  (lambda (line port)
+    (let self ((line line)
+	       (doc '()))
+      ;;(format #t "doc-proc: ~a~%" line)
+      (if (eof-object? line)
+	  (if (null? doc)
+	      line
+	      (reverse! doc))
+	  (if (empty-line? line)
+	      (self (read-line port) doc)
+	      (let ((result (apply-any node-procs (list line port))))
+		(if result
+		    (let-values (((line node) result))
+		      (self line (cons node doc)))
+		    (let ((par (process-paragraph line line-proc port)))
+		      (self (read-line port)
+			    (cons par doc))))))))))
+
+
+(define* (outline-reader :optional (port (current-input-port)))
+  (define modeline-rx
+    (make-regexp "^[[:space:]]*-\\*- [a-zA-Z-]+ -\\*-[[:space:]]*$"))
+  (define title-rx (make-regexp "^[Tt]itle: (.+)$" regexp/extended))
+  (define author-rx (make-regexp "^[Aa]uthor: (.+)$" regexp/extended))
+
+  (let ((doc-proc (make-document-processor %node-processors %line-processor)))
+
+    (let loop ((title #f)
+	       (author #f)
+	       (line (read-line port)))
+
+      (if (eof-object? line)
+	  (if (or title author)
+	      `(document :title ,title :author (author :name ,author) '())
+	      line)
+	  (if (or (empty-line? line)
+		  (regexp-exec modeline-rx line))
+	      (loop title author (read-line port))
+	      (let ((title-match (regexp-exec title-rx line)))
+		(if title-match
+		    (loop (match:substring title-match 1)
+			  author (read-line port))
+		    (let ((author-match (regexp-exec author-rx line)))
+		      (if author-match
+			  (loop title (match:substring author-match 1)
+				(read-line port))
+
+			  ;; Let's go.
+			  `(document :title ,title
+				     :author (author :name ,author)
+				     ,@(doc-proc line port)))))))))))
+
+
+(define* (make-outline-reader :optional (version "0.1"))
+  outline-reader)
+
+
+
+;;; The reader specification.
+
+(define-reader outline "0.1" make-outline-reader)
+
+
+;;; arch-tag: 53473e73-c811-4eed-a0b4-22ada4d6ef08
+
+;;; outline.scm ends here
+
diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm
new file mode 100644
index 0000000..d3dbb5f
--- /dev/null
+++ b/src/guile/skribilo/reader/skribe.scm
@@ -0,0 +1,113 @@
+;;; skribe.scm  --  A reader for the Skribe syntax.
+;;;
+;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo reader skribe)
+  :use-module (skribilo reader)
+  :use-module (ice-9 optargs)
+  :use-module (srfi srfi-1)
+
+  ;; the Scheme reader composition framework
+  :use-module ((system reader) #:renamer (symbol-prefix-proc 'r:))
+
+  :export (reader-specification
+           make-skribe-reader))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; A reader for the Skribe syntax, i.e. roughly R5RS Scheme plus DSSSL-style
+;;; keywords and sk-exps (expressions introduced using a square bracket).
+;;;
+;;; Code:
+
+;;; Note: We need guile-reader 0.2 at least.
+
+(define* (make-skribe-reader #:optional (version "1.2d"))
+  "Return a Skribe reader (a procedure) suitable for version @var{version} of
+the Skribe syntax."
+  (if (string> version "1.2d")
+      (error "make-skribe-reader: unsupported version" version)
+      %skribe-reader))
+
+(define (make-colon-free-token-reader tr)
+  ;; Stolen from `guile-reader' 0.3.
+  "If token reader @var{tr} handles the @code{:} (colon) character, remove it
+from its specification and return the new token reader."
+  (let* ((spec (r:token-reader-specification tr))
+	 (proc (r:token-reader-procedure tr)))
+    (r:make-token-reader (filter (lambda (chr)
+				   (not (char=? chr #\:)))
+				 spec)
+			 proc)))
+
+(define &sharp-reader
+  ;; The reader for what comes after a `#' character.
+  (let* ((dsssl-keyword-reader  ;; keywords à la `#!key'
+          (r:make-token-reader #\!
+ 			       (r:token-reader-procedure
+ 				(r:standard-token-reader 'keyword)))))
+      (r:make-reader (cons dsssl-keyword-reader
+			   (map r:standard-token-reader
+				'(character srfi-4 vector
+				  number+radix boolean
+				  srfi30-block-comment
+				  srfi62-sexp-comment)))
+		     #f ;; use default fault handler
+		     'reader/record-positions)))
+
+(define (%make-skribe-reader)
+  (let ((colon-keywords ;; keywords à la `:key' fashion
+	 (r:make-token-reader #\:
+			      (r:token-reader-procedure
+			       (r:standard-token-reader 'keyword))))
+	(symbol-misc-chars-tr
+	 ;; Make sure `:' is handled only by the keyword token reader.
+	 (make-colon-free-token-reader
+	  (r:standard-token-reader 'r6rs-symbol-misc-chars))))
+
+
+    ;; Note: we use the `r6rs-symbol-*' and `r6rs-number' token readers since
+    ;; they consider square brackets as delimiters.
+    (r:make-reader (cons* (r:make-token-reader #\# &sharp-reader)
+			  colon-keywords
+			  symbol-misc-chars-tr
+			  (map r:standard-token-reader
+			       `(whitespace
+				 sexp string r6rs-number
+				 r6rs-symbol-lower-case
+				 r6rs-symbol-upper-case
+				 quote-quasiquote-unquote
+				 semicolon-comment
+				 skribe-exp)))
+		   #f ;; use the default fault handler
+		   'reader/record-positions
+		   )))
+
+;; We actually cache an instance here.
+(define %skribe-reader (%make-skribe-reader))
+
+
+
+;;; The reader specification.
+
+(define-reader skribe "1.2d" make-skribe-reader)
+
+;;; skribe.scm ends here
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
new file mode 100644
index 0000000..ba5af6a
--- /dev/null
+++ b/src/guile/skribilo/resolve.scm
@@ -0,0 +1,296 @@
+;;; resolve.scm  --  Skribilo reference resolution.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo resolve)
+  :use-module (skribilo debug)
+  :use-module (skribilo ast)
+  :use-module (skribilo utils syntax)
+
+  :use-module (oop goops)
+  :use-module (srfi srfi-39)
+
+  :use-module (skribilo condition)
+  :use-module (srfi srfi-34)
+  :use-module (srfi srfi-35)
+
+  :export (resolve! resolve-search-parent resolve-children resolve-children*
+	   find1 resolve-counter resolve-parent resolve-ident
+	   *document-being-resolved*))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+
+;;;
+;;; Resolving nodes.
+;;;
+
+;; The document being resolved.  Note: This is only meant to be used by the
+;; compatibility layer in order to implement things like `find-markups'!
+(define *document-being-resolved* (make-parameter #f))
+
+(define *unresolved* (make-parameter #f))
+(define-generic do-resolve!)
+
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE!
+;;;;
+;;;; This function iterates over an ast until all unresolved  references
+;;;; are resolved.
+;;;;
+;;;; ======================================================================
+(define (resolve! ast engine env)
+  (with-debug 3 'resolve
+     (debug-item "ast=" ast)
+
+     (if (document? ast)
+	 ;; Bind nodes prior to resolution so that unresolved nodes can
+	 ;; lookup nodes by identifier using `document-lookup-node' or
+	 ;; `resolve-ident'.
+	 (document-bind-nodes! ast))
+
+     (parameterize ((*unresolved* #f))
+       (let Loop ((ast ast))
+	 (*unresolved* #f)
+	 (let ((ast (do-resolve! ast engine env)))
+	   (if (*unresolved*)
+	       (begin
+		 (debug-item "iterating over ast " ast)
+		 (Loop ast))
+	       ast))))))
+
+;;;; ======================================================================
+;;;;
+;;;;				D O - R E S O L V E !
+;;;;
+;;;; ======================================================================
+
+(define-method (do-resolve! ast engine env)
+  ast)
+
+
+(define-method (do-resolve! (ast <pair>) engine env)
+  (let Loop ((n* ast))
+    (cond
+      ((null? n*)
+       ast)
+      ((list? n*)
+       (set-car! n* (do-resolve! (car n*) engine env))
+       (Loop (cdr n*)))
+      ((pair? n*)
+       (set-car! n* (do-resolve! (car n*) engine env))
+       (set-cdr! n* (do-resolve! (cdr n*) engine env)))
+      (else
+       (raise (condition (&invalid-argument-error
+			  (proc-name "do-resolve!<pair>")
+			  (argument n*))))))))
+
+
+(define-method (do-resolve! (node <node>) engine env)
+  (if (ast-resolved? node)
+      node
+      (let ((body    (slot-ref node 'body))
+	    (options (slot-ref node 'options))
+	    (parent  (slot-ref node 'parent))
+	    (unresolved? (*unresolved*)))
+	(with-debug 5 'do-resolve<body>
+	   (debug-item "body=" body)
+	   (parameterize ((*unresolved* #f))
+	     (when (eq? parent 'unspecified)
+	       (let ((p (assq 'parent env)))
+		 (slot-set! node 'parent
+			    (and (pair? p) (pair? (cdr p)) (cadr p)))
+		 (when (pair? options)
+		   (debug-item "unresolved options=" options)
+		   (for-each (lambda (o)
+			       (set-car! (cdr o)
+					 (do-resolve! (cadr o) engine env)))
+			     options)
+		   (debug-item "resolved options=" options))))
+	     (slot-set! node 'body (do-resolve! body engine env))
+	     (slot-set! node 'resolved? (not (*unresolved*))))
+
+	   (*unresolved* (or unresolved? (not (ast-resolved? node))))
+	   node))))
+
+
+(define-method (do-resolve! (node <container>) engine env0)
+  (let ((body     (slot-ref node 'body))
+	(options  (slot-ref node 'options))
+	(env      (slot-ref node 'env))
+	(parent   (slot-ref node 'parent)))
+    (with-debug 5 'do-resolve<container>
+       (debug-item "markup=" (markup-markup node))
+       (debug-item "body=" body)
+       (debug-item "env0=" env0)
+       (debug-item "env=" env)
+       (when (eq? parent 'unspecified)
+	 (let ((p (assq 'parent env0)))
+	   (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p)))
+	   (when (pair? options)
+	     (let ((e (append `((parent ,node)) env0)))
+	       (debug-item "unresolved options=" options)
+	       (for-each (lambda (o)
+			   (set-car! (cdr o)
+				     (do-resolve! (cadr o) engine e)))
+			 options)
+	       (debug-item "resolved options=" options)))))
+       (let ((e `((parent ,node) ,@env ,@env0)))
+	 (slot-set! node 'body (do-resolve! body engine e)))
+       node)))
+
+
+(define-method (do-resolve! (node <document>) engine env0)
+  (parameterize ((*document-being-resolved* node))
+    (next-method)
+    ;; resolve the engine custom
+    (let ((env (append `((parent ,node)) env0)))
+      (for-each (lambda (c)
+		  (let ((i (car c))
+			(a (cadr c)))
+		    (debug-item "custom=" i " " a)
+		    (set-car! (cdr c) (do-resolve! a engine env))))
+		(slot-ref engine 'customs)))
+    node))
+
+
+(define-method (do-resolve! (node <unresolved>) engine env)
+  (with-debug 5 'do-resolve<unresolved>
+     (debug-item "node=" node)
+     (let ((p (assq 'parent env)))
+       (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p))))
+
+     (let* ((proc (slot-ref node 'proc))
+	    (res  (proc node engine env))
+	    (loc  (ast-loc node)))
+       (when (ast? res)
+	 (ast-loc-set! res loc)
+	 (slot-set! res 'parent (assq 'parent env)))
+       (debug-item "res=" res)
+       (*unresolved* #t)
+       res)))
+
+
+(define-method (do-resolve! (node <handle>) engine env)
+  node)
+
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE-PARENT
+;;;;
+;;;; ======================================================================
+(define (resolve-parent n e)
+  (with-debug 5 'resolve-parent
+     (debug-item "n=" n)
+     (cond
+       ((not (is-a? n <ast>))
+	(let ((c (assq 'parent e)))
+	  (if (pair? c)
+	      (cadr c)
+	      n)))
+       ((eq? (slot-ref n 'parent) 'unspecified)
+        (raise (condition (&ast-orphan-error (ast n)))))
+       (else
+	(slot-ref n 'parent)))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE-SEARCH-PARENT
+;;;;
+;;;; ======================================================================
+(define (resolve-search-parent n e pred)
+  (with-debug 5 'resolve-search-parent
+     (debug-item "node=" n)
+     (debug-item "searching=" pred)
+     (let ((p (resolve-parent n e)))
+       (debug-item "parent=" p " "
+		   (if (is-a? p 'markup) (slot-ref p 'markup) "???"))
+       (cond
+	 ((pred p)		 p)
+	 ((is-a? p <unresolved>) p)
+	 ((not p)		 #f)
+	 (else			 (resolve-search-parent p e pred))))))
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE-COUNTER
+;;;;
+;;;; ======================================================================
+;;FIXME: factoriser
+(define (resolve-counter n e cnt val . opt)
+  (let ((c (assq (symbol-append cnt '-counter) e)))
+    (if (not (pair? c))
+	(if (or (null? opt) (not (car opt)) (null? e))
+            (raise (condition (&ast-orphan-error (ast n))))
+	    (begin
+	      (set-cdr! (last-pair e)
+			(list (list (symbol-append cnt '-counter) 0)
+			      (list (symbol-append cnt '-env) '())))
+	      (resolve-counter n e cnt val)))
+	(let* ((num (cadr c))
+	       (nval (if (integer? val)
+			 val
+			 (+ 1 num))))
+	  (let ((c2 (assq (symbol-append cnt '-env) e)))
+	    (set-car! (cdr c2) (cons (resolve-parent n e) (cadr c2))))
+	  (cond
+	    ((integer? val)
+	     (set-car! (cdr c) val)
+	     (car val))
+	    ((not val)
+	     val)
+	    (else
+	     (set-car! (cdr c) (+ 1 num))
+	     (+ 1 num)))))))
+
+
+;;;
+;;; `resolve-ident'.
+;;;
+;;; This function kind of sucks because the document where IDENT is to be
+;;; searched is not explictly passed.  Thus, using `document-lookup-node' is
+;;; recommended instead of using this function.
+;;;
+
+(define (resolve-ident ident markup n e)
+  ;; Search for a node with identifier IDENT and markup type MARKUP.  N is
+  ;; typically an `<unresolved>' node and the node lookup should be performed
+  ;; in its parent document.  E is the "environment" (an alist).
+  (with-debug 4 'resolve-ident
+     (debug-item "ident=" ident)
+     (debug-item "markup=" markup)
+     (debug-item "n=" (if (markup? n) (markup-markup n) n))
+     (if (not (string? ident))
+         (raise (condition (&invalid-argument-error ;; type error
+                            (proc-name "resolve-ident")
+                            (argument  ident))))
+	 (let* ((doc (ast-document n))
+		(result (and doc (document-lookup-node doc ident))))
+	   (if (or (not markup)
+		   (and (markup? result) (eq? (markup-markup result) markup)))
+	       result
+	       #f)))))
+
diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm
new file mode 100644
index 0000000..a61de4f
--- /dev/null
+++ b/src/guile/skribilo/source.scm
@@ -0,0 +1,208 @@
+;;;; source.scm	-- Highlighting source files.
+;;;;
+;;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;; Copyright 2005, 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;;; USA.
+;;;;
+
+(define-module (skribilo source)
+  :export (<language> language? language-extractor language-fontifier
+	   source-read-lines source-read-definition source-fontify)
+
+  :use-module (srfi srfi-35)
+  :autoload   (srfi srfi-34) (raise)
+  :autoload   (srfi srfi-13) (string-prefix-length)
+  :autoload   (skribilo condition) (&file-search-error &file-open-error)
+
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo parameters)
+  :use-module (skribilo lib)
+  :use-module (oop goops)
+  :use-module (ice-9 rdelim))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; Class definition.
+;;;
+
+(define-class <language> ()
+  (name	:init-keyword :name	 :init-value #f :getter langage-name)
+  (fontifier	:init-keyword :fontifier :init-value #f
+		:getter language-fontifier)
+  (extractor	:init-keyword :extractor :init-value #f
+		:getter language-extractor))
+
+(define (language? obj)
+  (is-a? obj <language>))
+
+
+
+;*---------------------------------------------------------------------*/
+;*    source-read-lines ...                                            */
+;*---------------------------------------------------------------------*/
+(define (source-read-lines file start stop tab)
+  (let ((p (search-path (*source-path*) file)))
+    (if (or (not (string? p)) (not (file-exists? p)))
+	(raise (condition (&file-search-error (file-name file)
+					      (path (*source-path*)))))
+	(with-input-from-file p
+	  (lambda ()
+	    (if (> (*verbose*) 0)
+		(format (current-error-port) "  [source file: ~S]\n" p))
+	    (let ((startl (if (string? start) (string-length start) -1))
+		  (stopl  (if (string? stop)  (string-length stop)  -1)))
+	      (let loop ((l      0) ;; In Guile, line nums are 0-origined.
+			 (armedp (not (or (integer? start) (string? start))))
+			 (s      (read-line))
+			 (r      '()))
+		(cond
+		 ((or (eof-object? s)
+		      (and (integer? stop) (> l stop))
+		      (and (string? stop)
+			   (= (string-prefix-length stop s) stopl)))
+		  (apply string-append (reverse! r)))
+		 (armedp
+		  (loop (+ l 1)
+			#t
+			(read-line)
+			(cons* "\n" (untabify s tab) r)))
+		 ((and (integer? start) (>= l start))
+		  (loop (+ l 1)
+			#t
+			(read-line)
+			(cons* "\n" (untabify s tab) r)))
+		 ((and (string? start)
+		       (= (string-prefix-length start s) startl))
+		  (loop (+ l 1) #t (read-line) r))
+		 (else
+		  (loop (+ l 1) #f (read-line) r))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    untabify ...                                                     */
+;*---------------------------------------------------------------------*/
+(define (untabify obj tab)
+   (if (not tab)
+       obj
+       (let ((len (string-length obj))
+	     (tabl tab))
+	  (let loop ((i 0)
+		     (col 1))
+	     (cond
+		((= i len)
+		 (let ((nlen (- col 1)))
+		    (if (= len nlen)
+			obj
+			(let ((new (make-string col #\space)))
+			   (let liip ((i 0)
+				      (j 0)
+				      (col 1))
+			      (cond
+				 ((= i len)
+				  new)
+				 ((char=? (string-ref obj i) #\tab)
+				  (let ((next-tab (* (/ (+ col tabl)
+							    tabl)
+						       tabl)))
+				     (liip (+ i 1)
+					   next-tab
+					   next-tab)))
+				 (else
+				  (string-set! new j (string-ref obj i))
+				  (liip (+ i 1) (+ j 1) (+ col 1)))))))))
+		((char=? (string-ref obj i) #\tab)
+		 (loop (+ i 1)
+		       (* (/ (+ col tabl) tabl) tabl)))
+		(else
+		 (loop (+ i 1) (+ col 1))))))))
+
+;*---------------------------------------------------------------------*/
+;*    source-read-definition ...                                       */
+;*---------------------------------------------------------------------*/
+(define (source-read-definition file definition tab lang)
+   (let ((p (search-path (*source-path*) file)))
+      (cond
+	 ((not (language-extractor lang))
+	  (skribe-error 'source
+			"The specified language has not defined extractor"
+			(slot-ref lang 'name)))
+
+	 ((or (not p) (not (file-exists? p)))
+	  (raise (condition (&file-search-error (file-name file)
+						(path (*source-path*))))))
+
+	 (else
+	  (let ((ip (open-input-file p)))
+	     (if (> (*verbose*) 0)
+		 (format (current-error-port) "  [source file: ~S]\n" p))
+	     (if (not (input-port? ip))
+		 (raise (condition (&file-open-error (file-name p))))
+		 (unwind-protect
+		    (let ((s ((language-extractor lang) ip definition tab)))
+		       (if (not (string? s))
+			   (skribe-error 'source
+					 "Can't find definition"
+					 definition)
+			   s))
+		    (close-input-port ip))))))))
+
+;*---------------------------------------------------------------------*/
+;*    source-fontify ...                                               */
+;*---------------------------------------------------------------------*/
+(define (source-fontify o language)
+   (define (fontify f o)
+      (cond
+	 ((string? o) (f o))
+	 ((pair? o) (map (lambda (s) (if (string? s) (f s) (fontify f s))) o))
+	 (else o)))
+   (let ((f (language-fontifier language)))
+      (if (procedure? f)
+	  (fontify f o)
+	  o)))
+
+;*---------------------------------------------------------------------*/
+;*    split-string-newline ...                                         */
+;*---------------------------------------------------------------------*/
+(define (split-string-newline str)
+   (let ((l (string-length str)))
+      (let loop ((i 0)
+		 (j 0)
+		 (r '()))
+	 (cond
+	    ((= i l)
+	     (if (= i j)
+		 (reverse! r)
+		 (reverse! (cons (substring str j i) r))))
+	    ((char=? (string-ref str i) #\newline)
+	     (loop (+ i 1)
+		   (+ i 1)
+		   (if (= i j)
+		       (cons 'eol r)
+		       (cons* 'eol (substring str j i) r))))
+	    ((and (char=? (string-ref str i) #\cr)
+		  (< (+ i 1) l)
+		  (char=? (string-ref str (+ i 1)) #\newline))
+	     (loop (+ i 2)
+		   (+ i 2)
+		   (if (= i j)
+		       (cons 'eol r)
+		       (cons* 'eol (substring str j i) r))))
+	    (else
+	     (loop (+ i 1) j r))))))
diff --git a/src/guile/skribilo/sui.scm b/src/guile/skribilo/sui.scm
new file mode 100644
index 0000000..e0a9b19
--- /dev/null
+++ b/src/guile/skribilo/sui.scm
@@ -0,0 +1,199 @@
+;;; sui.scm
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2005, 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo sui)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo lib)
+  :use-module (ice-9 match)
+  :use-module (srfi srfi-1)
+  :autoload   (skribilo parameters) (*verbose*)
+  :autoload   (skribilo reader)     (make-reader)
+
+  :export (load-sui sui-ref->url sui-title sui-file sui-key
+           sui-find-ref sui-search-ref sui-filter))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; Author:  Manuel Serrano
+;;; Commentary:
+;;;
+;;; Library dealing with Skribe URL Indexes (SUI).
+;;;
+;;; Code:
+
+
+;;; The contents of the file below are (almost) unchanged compared to Skribe
+;;; 1.2d's `sui.scm' file found in the `common' directory.
+
+
+;*---------------------------------------------------------------------*/
+;*    *sui-table* ...                                                  */
+;*---------------------------------------------------------------------*/
+(define *sui-table* (make-hash-table))
+
+;*---------------------------------------------------------------------*/
+;*    load-sui ...                                                     */
+;*    -------------------------------------------------------------    */
+;*    Returns a SUI sexp if already loaded. Load it otherwise.         */
+;*    Raise an error if the file cannot be open.                       */
+;*---------------------------------------------------------------------*/
+(define (load-sui path)
+   (let ((sexp (hash-ref *sui-table* path)))
+      (or sexp
+	  (begin
+	     (when (> (*verbose*) 0)
+		(format (current-error-port) "  [loading sui: ~a]\n" path))
+	     (let ((p (open-input-file path))
+                   (read (make-reader 'skribe)))
+		(if (not (input-port? p))
+		    (skribe-error 'load-sui
+				  "Can't find `Skribe Url Index' file"
+				  path)
+		    (unwind-protect
+		       (let ((sexp (read p)))
+			  (match sexp
+			     (('sui (? string?) . _)
+			      (hash-set! *sui-table* path sexp))
+			     (else
+			      (skribe-error 'load-sui
+					    "Illegal `Skribe Url Index' file"
+					    path)))
+			  sexp)
+		       (close-input-port p))))))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-ref->url ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (sui-ref->url dir sui ident opts)
+   (let ((refs (sui-find-ref sui ident opts)))
+      (and (pair? refs)
+	   (let ((base (sui-file sui))
+		 (file (car (car refs)))
+		 (mark (cdr (car refs))))
+	      (format #f "~a/~a#~a" dir (or file base) mark)))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-title ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (sui-title sexp)
+   (match sexp
+      (('sui (and title (? string?)) . _)
+       title)
+      (else
+       (skribe-error 'sui-title "Illegal `sui' format" sexp))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-file ...                                                     */
+;*---------------------------------------------------------------------*/
+(define (sui-file sexp)
+   (sui-key sexp :file))
+
+;*---------------------------------------------------------------------*/
+;*    sui-key ...                                                      */
+;*---------------------------------------------------------------------*/
+(define (sui-key sexp key)
+   (match sexp
+      (('sui _ . rest)
+       (let loop ((rest rest))
+	  (and (pair? rest)
+	       (if (eq? (car rest) key)
+		   (and (pair? (cdr rest))
+			(cadr rest))
+		   (loop (cdr rest))))))
+      (else
+       (skribe-error 'sui-key "Illegal `sui' format" sexp))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-find-ref ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (sui-find-ref sui ident opts)
+   (let ((ident (assq :ident opts))
+	 (mark (assq :mark opts))
+	 (class (let ((c (assq :class opts)))
+		   (and (pair? c) (cadr c))))
+	 (chapter (assq :chapter opts))
+	 (section (assq :section opts))
+	 (subsection (assq :subsection opts))
+	 (subsubsection (assq :subsubsection opts)))
+      (match sui
+	 (('sui (? string?) . refs)
+	  (cond
+	     (mark (sui-search-ref 'marks refs (cadr mark) class))
+	     (chapter (sui-search-ref 'chapters refs (cadr chapter) class))
+	     (section (sui-search-ref 'sections refs (cadr section) class))
+	     (subsection (sui-search-ref 'subsections refs (cadr subsection) class))
+	     (subsubsection (sui-search-ref 'subsubsections refs (cadr subsubsection) class))
+	     (ident (sui-search-all-refs sui ident class))
+	     (else '())))
+	 (else
+	  (skribe-error 'sui-find-ref "Illegal `sui' format" sui)))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-search-all-refs ...                                          */
+;*---------------------------------------------------------------------*/
+(define (sui-search-all-refs sui id refs)
+   '())
+
+;*---------------------------------------------------------------------*/
+;*    sui-search-ref ...                                               */
+;*---------------------------------------------------------------------*/
+(define (sui-search-ref kind refs val class)
+   (define (find-ref refs val class)
+      (map (lambda (r)
+	      (let ((f (memq :file r))
+		    (c (memq :mark r)))
+		 (cons (and (pair? f) (cadr f)) (and (pair? c) (cadr c)))))
+	   (filter (if class
+		       (lambda (m)
+			  (and (pair? m)
+			       (string? (car m))
+			       (string=? (car m) val)
+			       (let ((c (memq :class m)))
+				  (and (pair? c)
+				       (eq? (cadr c) class)))))
+		       (lambda (m)
+			  (and (pair? m)
+			       (string? (car m))
+			       (string=? (car m) val))))
+		   refs)))
+   (let loop ((refs refs))
+      (if (pair? refs)
+	  (if (and (pair? (car refs)) (eq? (caar refs) kind))
+	      (find-ref (cdar refs) val class)
+	      (loop (cdr refs)))
+	  '())))
+
+;*---------------------------------------------------------------------*/
+;*    sui-filter ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (sui-filter sui pred1 pred2)
+   (match sui
+      (('sui (? string?) . refs)
+       (let loop ((refs refs)
+		  (res '()))
+	  (if (pair? refs)
+	      (if (and (pred1 (car refs)))
+		  (loop (cdr refs)
+			(cons (filter pred2 (cdar refs)) res))
+		  (loop (cdr refs) res))
+	      (reverse! res))))
+      (else
+       (skribe-error 'sui-filter "Illegal `sui' format" sui))))
diff --git a/src/guile/skribilo/utils/Makefile.am b/src/guile/skribilo/utils/Makefile.am
new file mode 100644
index 0000000..9d9df6f
--- /dev/null
+++ b/src/guile/skribilo/utils/Makefile.am
@@ -0,0 +1,5 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/utils
+dist_guilemodule_DATA = syntax.scm compat.scm files.scm images.scm	\
+			keywords.scm strings.scm
+
+## arch-tag: 3a18b64b-1da2-417b-8338-2c534bca277f
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
new file mode 100644
index 0000000..118f294
--- /dev/null
+++ b/src/guile/skribilo/utils/compat.scm
@@ -0,0 +1,309 @@
+;;; compat.scm  --  Skribe compatibility module.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+
+(define-module (skribilo utils compat)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo utils files)
+  :use-module (skribilo parameters)
+  :use-module (skribilo evaluator)
+  :use-module (srfi srfi-1)
+  :autoload   (srfi srfi-13)       (string-rindex)
+  :use-module (srfi srfi-34)
+  :use-module (srfi srfi-35)
+  :use-module (ice-9 optargs)
+  :autoload   (skribilo ast)       (ast? document? document-lookup-node)
+  :autoload   (skribilo condition) (file-search-error? &file-search-error)
+  :autoload   (skribilo reader)    (make-reader)
+  :autoload   (skribilo lib)       (type-name)
+  :autoload   (skribilo resolve)   (*document-being-resolved*)
+  :autoload   (skribilo output)    (*document-being-output*)
+  :use-module (skribilo debug)
+
+  :re-export (file-size)  ;; re-exported from `(skribilo utils files)'
+  :replace (gensym))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module defines symbols for compatibility with Skribe 1.2.
+;;;
+;;; Code:
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; gensym
+;;;
+
+(define %gensym-orig (module-ref the-root-module 'gensym))
+
+(define gensym
+  ;; In Skribe, `gensym' accepts a symbol.  Guile's `gensym' accepts only
+  ;; strings (or no argument).
+  (lambda obj
+    (apply %gensym-orig
+	   (cond ((null? obj) '())
+		 ((symbol? (car obj)) (list (symbol->string (car obj))))
+		 ((string? (car obj)) (list (car obj)))
+		 (else (skribe-error 'gensym "invalid argument" obj))))))
+
+
+;;;
+;;; Global variables that have been replaced by parameter objects
+;;; in `(skribilo parameters)'.
+;;;
+;;; FIXME: There's not much we can do about these variables (as opposed to
+;;; the _accessors_ below).  Perhaps we should just not define them?
+;;;
+
+;;; Switches
+(define-public *skribe-verbose*	0)
+(define-public *skribe-warning*	5)
+(define-public *load-rc*		#t)
+
+
+;;; Path variables
+(define-public *skribe-path*		#f)
+(define-public *skribe-bib-path*	'("."))
+(define-public *skribe-source-path*	'("."))
+(define-public *skribe-image-path*	'("."))
+
+
+(define-public *skribe-rc-directory*
+  (string-append (getenv "HOME") "/" ".skribilo"))
+
+
+;;; In and out ports
+(define-public *skribe-src*		'())
+(define-public *skribe-dest*		#f)
+
+;;; Engine
+(define-public *skribe-engine*  	'html)	;; Use HTML by default
+
+;;; Misc
+(define-public *skribe-chapter-split*	'())
+(define-public *skribe-ref-base*	#f)
+(define-public *skribe-convert-image*  #f)	;; i.e. use the Skribe standard converter
+(define-public *skribe-variants*	'())
+
+
+
+;;;
+;;; Accessors mapped to parameter objects.
+;;;
+
+(define-public skribe-path        *document-path*)
+(define-public skribe-image-path  *image-path*)
+(define-public skribe-source-path *source-path*)
+(define-public skribe-bib-path    *bib-path*)
+
+(define-public (skribe-path-set! path)        (*document-path* path))
+(define-public (skribe-image-path-set! path)  (*image-path* path))
+(define-public (skribe-source-path-set! path) (*source-path* path))
+(define-public (skribe-bib-path-set! path)    (*bib-path* path))
+
+
+
+;;;
+;;; Evaluator.
+;;;
+
+(define %skribe-known-files
+  ;; Like of Skribe package files and their equivalent Skribilo module.
+  '(("web-book.skr"     . (skribilo package web-book))
+    ("web-article.skr"  . (skribilo package web-article))
+    ("slide.skr"        . (skribilo package slide))
+    ("sigplan.skr"      . (skribilo package sigplan))
+    ("scribe.skr"       . (skribilo package scribe))
+    ("lncs.skr"         . (skribilo package lncs))
+    ("letter.skr"       . (skribilo package letter))
+    ("jfp.skr"          . (skribilo package jfp))
+    ("french.skr"       . (skribilo package french))
+    ("acmproc.skr"      . (skribilo package acmproc))))
+
+(define*-public (skribe-load file :rest args)
+  (guard (c ((file-search-error? c)
+	     ;; Regular file loading failed.  Try built-ins.
+	     (let ((mod-name (assoc-ref %skribe-known-files file)))
+	       (if mod-name
+		   (begin
+		     (if (> (*verbose*) 1)
+			 (format (current-error-port)
+				 "  skribe-load: `~a' -> `~a'~%"
+				 file mod-name))
+		     (let ((mod (false-if-exception
+				 (resolve-module mod-name))))
+		       (if (not mod)
+			   (raise c)
+			   (begin
+			     (set-module-uses!
+			      (current-module)
+			      (cons mod (module-uses (current-module))))
+			     #t))))
+		   (raise c)))))
+
+	 ;; Try a regular `load-document'.
+	 (apply load-document file args)))
+
+
+(define-public skribe-include      include-document)
+(define-public skribe-load-options *load-options*)
+
+(define-public skribe-eval         evaluate-document)
+(define-public skribe-eval-port    evaluate-document-from-port)
+
+(set! %skribe-reader #f)
+(define*-public (skribe-read #:optional (port (current-input-port)))
+  (if (not %skribe-reader)
+      (set! %skribe-reader (make-reader 'skribe)))
+  (%skribe-reader port))
+
+
+
+;;;
+;;; Node lookup (formerly provided by `ast.scm').
+;;;
+
+(define-public (bind-markup! node)
+  (let ((doc (or (*document-being-resolved*)
+		 (*document-being-output*))))
+    (if (document? doc)
+	(document-bind-node! doc node)
+	(error "Sorry, unable to achieve `bind-markup!'.  Use `document-bind-node!' instead."
+	       node))))
+
+(define-public (find-markups ident)
+  (let ((doc (or (*document-being-resolved*)
+		 (*document-being-output*))))
+    (if (document? doc)
+	(let ((result (document-lookup-node doc ident)))
+	  (if result
+	      (list result)
+	      #f))
+	(error "Sorry, unable to achieve `find-markups'.  Use `document-lookup-node' instead."
+	       ident))))
+
+(define-public (find-markup-ident ident)
+  (or (find-markups ident) '()))
+
+
+
+;;;
+;;; Debugging facilities.
+;;;
+
+(define-public (set-skribe-debug! val)
+  (*debug* val))
+
+(define-public (no-debug-color)
+  (*debug-use-colors?* #f))
+
+(define-public skribe-debug *debug*)
+
+(define-public (add-skribe-debug-symbol s)
+  (*watched-symbols* (cons s *watched-symbols*)))
+
+
+
+;;;
+;;; Compatibility with Bigloo.
+;;;
+
+(define-public (substring=? s1 s2 len)
+  (let ((l1 (string-length s1))
+	(l2 (string-length s2)))
+    (let Loop ((i 0))
+      (cond
+	((= i len) #t)
+	((= i l1)  #f)
+	((= i l2)  #f)
+	((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1)))
+	(else #f)))))
+
+(define-public (directory->list str)
+  (map basename (glob (string-append str "/*") (string-append "/.*"))))
+
+(define-macro (printf . args)   `(format #t ,@args))
+(export-syntax printf)
+(define-public fprintf			format)
+
+(define-public (fprint port . args)
+  (if port
+      (with-output-to-port port
+	(lambda ()
+	  (for-each display args)
+	  (display "\n")))))
+
+
+
+(define-public prefix			file-prefix)
+(define-public suffix			file-suffix)
+(define-public system->string		system)  ;; FIXME
+(define-public any?			any)
+(define-public every?			every)
+(define-public (find-file/path file path)
+  (search-path path file))
+
+(define-public process-input-port	#f) ;process-input)
+(define-public process-output-port	#f) ;process-output)
+(define-public process-error-port	#f) ;process-error)
+
+;;; hash tables
+(define-public make-hashtable		make-hash-table)
+(define-public hashtable?		hash-table?)
+(define-public hashtable-get		(lambda (h k) (hash-ref h k #f)))
+(define-public hashtable-put!		hash-set!)
+(define-public (hashtable-update! table key update-proc init-value)
+  ;; This is a Bigloo-specific API.
+  (let ((handle (hash-get-handle table key)))
+    (if (not handle)
+	(hash-set! table key init-value)
+	(set-cdr! handle (update-proc (cdr handle))))))
+
+(define-public (hashtable->list h)
+  (hash-map->list (lambda (key val) val) h))
+
+(define-public (find-runtime-type obj)
+  (type-name obj))
+
+
+;;;
+;;; Miscellaneous.
+;;;
+
+(use-modules ((srfi srfi-19) #:renamer (symbol-prefix-proc 's19:)))
+
+(define-public (date)
+  (s19:date->string (s19:current-date) "~c"))
+
+(define-public (correct-arity? proc argcount)
+  (let ((a (procedure-property proc 'arity)))
+    (and (pair? a)
+         (let ((compulsory (car a))
+               (optional   (cadr a))
+               (rest?      (caddr a)))
+           (or rest?
+               (>= (+ compulsory optional) argcount))))))
+
+
+;;; compat.scm ends here
diff --git a/src/guile/skribilo/utils/files.scm b/src/guile/skribilo/utils/files.scm
new file mode 100644
index 0000000..6d89d4d
--- /dev/null
+++ b/src/guile/skribilo/utils/files.scm
@@ -0,0 +1,55 @@
+;;; files.scm  --  File-related utilities.
+;;;
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo utils files)
+  :export (file-prefix file-suffix file-size))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module defines filesystem-related utility functions.
+;;;
+;;; Code:
+
+(define (file-size file)
+  (let ((file-info (false-if-exception (stat file))))
+    (if file-info
+	(stat:size file-info)
+	#f)))
+
+(define (file-prefix fn)
+  (if fn
+      (let ((dot (string-rindex fn #\.)))
+	(if dot (substring fn 0 dot) fn))
+      "./SKRIBILO-OUTPUT"))
+
+(define (file-suffix fn)
+  (if fn
+      (let ((dot (string-rindex fn #\.)))
+	(if dot
+	    (substring fn (+ dot 1) (string-length fn))
+	    ""))
+      #f))
+
+
+;;; arch-tag: b63d2a9f-a254-4e2d-8d85-df773bbc4a9b
+
+;;; files.scm ends here
diff --git a/src/guile/skribilo/utils/images.scm b/src/guile/skribilo/utils/images.scm
new file mode 100644
index 0000000..24405d6
--- /dev/null
+++ b/src/guile/skribilo/utils/images.scm
@@ -0,0 +1,99 @@
+;;; images.scm  --  Images handling utilities.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo utils images)
+  :export (convert-image
+	   *fig-convert-program* *bitmap-convert-program*)
+
+  :autoload (skribilo utils files) (file-suffix file-prefix)
+  :autoload (skribilo parameters)  (*image-path* *verbose*)
+  :autoload   (skribilo condition) (&file-search-error)
+  :autoload   (srfi srfi-34) (raise)
+  :use-module (srfi srfi-35)
+  :use-module (srfi srfi-39))
+
+;;; Author:  Erick Gallesio, Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module provides convenience functions to handle image files, notably
+;;; for format conversion via ImageMagick's `convert'.
+;;;
+;;; Code:
+
+(define *fig-convert-program*     (make-parameter "fig2dev -L"))
+(define *generic-convert-program* (make-parameter "convert"))
+
+(define (builtin-convert-image from fmt dir)
+  (let* ((s  (file-suffix from))
+	 (f  (string-append (file-prefix (basename from)) "." fmt))
+	 (to (string-append dir "/" f)))   ;; FIXME:
+    (cond
+      ((string=? s fmt)
+       to)
+      ((file-exists? to)
+       to)
+      (else
+       (let ((c (if (string=? s "fig")
+		    (string-append (*fig-convert-program*) " "
+				   fmt " " from " > " to)
+		    (string-append (*generic-convert-program*) " "
+				   from " " to))))
+	 (cond
+	   ((> (*verbose*) 1)
+	    (format (current-error-port) "  [converting image: ~S (~S)]" from c))
+	   ((> (*verbose*) 0)
+	    (format (current-error-port) "  [converting image: ~S]" from)))
+	 (and (zero? (system c))
+	      to))))))
+
+(define (convert-image file formats)
+  (let ((path (search-path (*image-path*) file)))
+    (if (not path)
+	(raise (condition (&file-search-error (file-name file)
+					      (path (*image-path*)))))
+	(let ((suf (file-suffix file)))
+	  (if (member suf formats)
+	      (let* ((dir (if (string? (*destination-file*))
+			      (dirname (*destination-file*))
+			      #f)))
+		(if dir
+		    (let* ((dest (basename path))
+			   (dest-path (string-append dir "/" dest)))
+		      (if (not (string=? path dest-path))
+			  (copy-file path dest-path))
+		      dest)
+		    path))
+	      (let loop ((fmts formats))
+		(if (null? fmts)
+		    #f
+		     (let* ((dir (if (string? (*destination-file*))
+				     (dirname (*destination-file*))
+				     "."))
+			    (p (builtin-convert-image path (car fmts) dir)))
+		       (if (string? p)
+			   p
+			   (loop (cdr fmts)))))))))))
+
+
+;;; arch-tag: a1992fa8-6073-4cd7-a018-80e2cc8d537c
+
+;;; images.scm ends here
diff --git a/src/guile/skribilo/utils/keywords.scm b/src/guile/skribilo/utils/keywords.scm
new file mode 100644
index 0000000..1bcd5dc
--- /dev/null
+++ b/src/guile/skribilo/utils/keywords.scm
@@ -0,0 +1,99 @@
+;;; keywords.scm  --  Convenience procedures for keyword-argument handling.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo utils keywords)
+  :export (the-body the-options list-split))
+
+;;; Author: Manuel Serrano, Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module provides convenience functions to handle keyword arguments.
+;;; These are typically used by markup functions.
+;;;
+;;; Code:
+
+(define (the-body opt+)
+  ;; Filter out the keyword arguments from OPT+.
+  (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)
+  ;; Return a list made of keyword arguments (i.e., each time, a keyword
+  ;; followed by its associated value).  The OUT argument should be a list
+  ;; containing keyword argument names to be filtered out (e.g.,
+  ;; `(#:ident)').
+  (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 (list-split l num . fill)
+   (let loop ((l l)
+	      (i 0)
+	      (acc '())
+	      (res '()))
+      (cond
+	 ((null? l)
+	  (reverse! (cons (if (or (null? fill) (= i num))
+			      (reverse! acc)
+			      (append! (reverse! acc)
+				       (make-list (- num i) (car fill))))
+			  res)))
+	 ((= i num)
+	  (loop l
+		0
+		'()
+		(cons (reverse! acc) res)))
+	 (else
+	  (loop (cdr l)
+		(+ i 1)
+		(cons (car l) acc)
+		res)))))
+
+;;; arch-tag: 3e9066d5-6d7d-4da5-922b-cc3d4ba8476e
+
+;;; keywords.scm ends here
diff --git a/src/guile/skribilo/utils/strings.scm b/src/guile/skribilo/utils/strings.scm
new file mode 100644
index 0000000..e8e8f8f
--- /dev/null
+++ b/src/guile/skribilo/utils/strings.scm
@@ -0,0 +1,145 @@
+;;; strings.scm	-- Convenience functions to manipulate strings.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo utils strings)
+  :export (strip-ref-base string-canonicalize
+	   make-string-replace)
+  :autoload   (skribilo parameters) (*ref-base*)
+  :use-module (skribilo lib)
+  :use-module (srfi srfi-13))
+
+
+;;;
+;;; Utilities.
+;;;
+
+(define (strip-ref-base file)
+  ;; Given FILE, a file path (a string), remove `(*ref-base*)'  from it.
+  ;; This is useful, e.g., for hyperlinks.
+  (if (not (string? (*ref-base*)))
+      file
+      (let ((l (string-length (*ref-base*))))
+	(cond
+	  ((not (> (string-length file) (+ l 2)))
+	   file)
+	  ((not (string-contains file (*ref-base*) 0 l))
+	   file)
+	  ((not (char=? (string-ref file l) #\/))
+	   file)
+	  (else
+	   (substring file (+ l 1) (string-length file)))))))
+
+
+(define (string-canonicalize old)
+   ;; Return a string that is a canonical summarized representation of string
+   ;; OLD.  This is a one-way function.
+   (let* ((l (string-length old))
+	  (new (make-string l)))
+      (let loop ((r 0)
+		 (w 0)
+		 (s #f))
+	 (cond
+	    ((= r l)
+	     (cond
+		((= w 0)
+		 "")
+		((char-whitespace? (string-ref new (- w 1)))
+		 (substring new 0 (- w 1)))
+		((= w r)
+		 new)
+		(else
+		 (substring new 0 w))))
+	    ((char-whitespace? (string-ref old r))
+	     (if s
+		 (loop (+ r 1) w #t)
+		 (begin
+		    (string-set! new w #\-)
+		    (loop (+ r 1) (+ w 1) #t))))
+	    ((or (char=? (string-ref old r) #\#)
+		 (>= (char->integer (string-ref old r)) #x7f))
+	     (string-set! new w #\-)
+	     (loop (+ r 1) (+ w 1) #t))
+	    (else
+	     (string-set! new w (string-ref old r))
+	     (loop (+ r 1) (+ w 1) #f))))))
+
+
+
+
+;;;
+;;; String writing.
+;;;
+
+;;
+;; (define (%make-html-replace)
+;;   ;; Ad-hoc version for HTML, a little bit faster than the
+;;   ;; make-general-string-replace define later (particularily if there
+;;   ;; is nothing to replace since, it does not allocate a new string
+;;   (let ((specials (string->regexp "&|\"|<|>")))
+;;     (lambda (str)
+;;       (if (regexp-match specials str)
+;;	  (begin
+;;	    (let ((out (open-output-string)))
+;;	      (dotimes (i (string-length str))
+;;		(let ((ch (string-ref str i)))
+;;		  (case ch
+;;		    ((#\") (display "&quot;" out))
+;;		    ((#\&) (display "&amp;" out))
+;;		    ((#\<) (display "&lt;" out))
+;;		    ((#\>) (display "&gt;" out))
+;;		    (else  (write-char ch out)))))
+;;	      (get-output-string out)))
+;;	  str))))
+
+
+(define (%make-general-string-replace lst)
+  ;; The general version
+  (let ((chars (make-hash-table)))
+
+    ;; Setup a hash table equivalent to LST.
+    (for-each (lambda (chr)
+		(hashq-set! chars (car chr) (cadr chr)))
+	      lst)
+
+    ;; Help the GC.
+    (set! lst #f)
+
+    (lambda (str)
+      (let ((out (open-output-string)))
+	(string-for-each (lambda (ch)
+			   (let ((res (hashq-ref chars ch #f)))
+			     (display (if res res ch) out)))
+			 str)
+	(get-output-string out)))))
+
+(define %html-replacements
+  '((#\" "&quot;") (#\& "&amp;") (#\< "&lt;") (#\> "&gt;")))
+
+(define %string->html
+  (%make-general-string-replace %html-replacements))
+
+(define (make-string-replace lst)
+  (let ((l (sort lst (lambda (r1 r2) (char<? (car r1) (car r2))))))
+    (cond
+      ((equal? l %html-replacements)
+       %string->html)
+      (else
+       (%make-general-string-replace lst)))))
+
diff --git a/src/guile/skribilo/utils/syntax.scm b/src/guile/skribilo/utils/syntax.scm
new file mode 100644
index 0000000..44bff09
--- /dev/null
+++ b/src/guile/skribilo/utils/syntax.scm
@@ -0,0 +1,81 @@
+;;; syntax.scm  --  Syntactic candy for Skribilo modules.
+;;;
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo utils syntax)
+  :use-module (skribilo reader)
+  :use-module (system reader library)
+  :use-module (system reader compat) ;; make sure `current-reader' exists
+  :use-module (system reader confinement)
+  :export (%skribe-reader %skribilo-module-reader)
+  :export-syntax (unwind-protect unless when))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module provides syntactic candy for Skribilo modules, i.e., a syntax
+;;; similar to Guile's default syntax with a few extensions, plus various
+;;; convenience macros.
+;;;
+;;; Code:
+
+(define %skribilo-module-reader
+  ;; The syntax used to read Skribilo modules.
+  (apply make-alternate-guile-reader
+         '(colon-keywords no-scsh-block-comments
+           srfi30-block-comments srfi62-sexp-comments)
+         (lambda (chr port read)
+	   (let ((file (port-filename port))
+		 (line (port-line port))
+		 (column (port-column port)))
+	     (error (string-append
+		     (if (string? file)
+			 (format #f "~a:~a:~a: " file line column)
+			 "")
+		     "unexpected character in Skribilo module")
+		    chr)))
+
+         ;; By default, don't record positions: this yields a nice read
+         ;; performance improvement.
+         (if (memq 'debug (debug-options))
+             (list 'reader/record-positions)
+             '())))
+
+(define %skribe-reader
+  ;; The Skribe syntax reader.
+  (make-reader 'skribe))
+
+
+(define-macro (unwind-protect expr1 expr2)
+  ;; This is no completely correct.
+  `(dynamic-wind
+       (lambda () #f)
+       (lambda () ,expr1)
+       (lambda () ,expr2)))
+
+(define-macro (unless condition . exprs)
+  `(if (not ,condition) (begin ,@exprs)))
+
+(define-macro (when condition . exprs)
+  `(if ,condition (begin ,@exprs)))
+
+;;; arch-tag: 9a0e0638-64f0-480a-ab19-49e8bfcbcd9b
+
+;;; syntax.scm ends here
diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm
new file mode 100644
index 0000000..052b5cc
--- /dev/null
+++ b/src/guile/skribilo/verify.scm
@@ -0,0 +1,160 @@
+;;; verify.scm  --  Skribe AST verification.
+;;;
+;;; Copyright 2003-2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo verify)
+  :autoload (skribilo engine) (engine-ident processor-get-engine)
+  :autoload (skribilo writer) (writer? writer-options lookup-markup-writer)
+  :autoload (skribilo lib)    (skribe-warning/ast skribe-warning
+			       skribe-error)
+  :export (verify))
+
+(use-modules (skribilo debug)
+	     (skribilo ast)
+	     (skribilo utils syntax)
+	     (oop goops))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+(define-generic verify)
+
+;;;
+;;; CHECK-REQUIRED-OPTIONS
+;;;
+(define (check-required-options markup writer engine)
+  (let ((required-options (slot-ref markup 'required-options))
+	(ident		  (slot-ref writer 'ident))
+	(options	  (slot-ref writer 'options))
+	(verified?	  (slot-ref writer 'verified?)))
+    (or verified?
+	(eq? options 'all)
+	(begin
+	  (for-each (lambda (o)
+		      (if (not (memq o options))
+			  (skribe-error (engine-ident engine)
+					(format #f "option unsupported: ~a, supported options: ~a" o options)
+					markup)))
+		    required-options)
+	  (slot-set! writer 'verified? #t)))))
+
+;;;
+;;; CHECK-OPTIONS
+;;;
+(define (check-options lopts markup engine)
+
+  ;;  Only keywords are checked, symbols are voluntary left unchecked. */
+  (with-debug 6 'check-options
+      (debug-item "markup="  (markup-markup markup))
+      (debug-item "options=" (slot-ref markup 'options))
+      (debug-item "lopts="   lopts)
+      (for-each
+	  (lambda (o2)
+	    (for-each
+		(lambda (o)
+		  (if (and (keyword? o)
+			   (not (eq? o :&skribe-eval-location))
+			   (not (memq o lopts)))
+		      (skribe-warning/ast
+		       3
+		       markup
+		       'verify
+		       (format #f "engine ~a does not support markup ~a option `~a' -- ~a"
+			       (engine-ident engine)
+			       (markup-markup markup)
+			       o
+			       (markup-option markup o)))))
+		o2))
+	  (slot-ref markup 'options))))
+
+
+;;; ======================================================================
+;;;
+;;;				V E R I F Y
+;;;
+;;; ======================================================================
+
+;;; TOP
+(define-method (verify (obj <top>) e)
+  obj)
+
+;;; PAIR
+(define-method (verify (obj <pair>) e)
+  (for-each (lambda (x) (verify x e)) obj)
+  obj)
+
+;;; PROCESSOR
+(define-method (verify (obj <processor>) e)
+  (let ((combinator (slot-ref obj 'combinator))
+	(engine     (slot-ref obj 'engine))
+	(body       (slot-ref obj 'body)))
+    (verify body (processor-get-engine combinator engine e))
+    obj))
+
+;;; NODE
+(define-method (verify (node <node>) e)
+  ;; Verify body
+  (verify (slot-ref node 'body) e)
+  ;; Verify options
+  (for-each (lambda (o) (verify (cadr o) e))
+	    (slot-ref node 'options))
+  node)
+
+;;; MARKUP
+(define-method (verify (node <markup>) e)
+  (with-debug 5 'verify::<markup>
+     (debug-item "node="    (markup-markup node))
+     (debug-item "options=" (slot-ref node 'options))
+     (debug-item "e="	    (engine-ident e))
+
+     (next-method)
+
+     (let ((w (lookup-markup-writer node e)))
+       (when (writer? w)
+	 (check-required-options node w e)
+	 (when (pair? (writer-options w))
+	   (check-options (slot-ref w 'options) node e))
+	 (let ((validate (slot-ref w 'validate)))
+	   (when (procedure? validate)
+	     (unless (validate node e)
+	       (skribe-warning
+		     1
+		     node
+		     (format #f "node `~a' forbidden here by ~a engine"
+			     (markup-markup node)
+			     (engine-ident e))))))))
+     node))
+
+
+;;; DOCUMENT
+(define-method (verify (node <document>) e)
+  (next-method)
+
+  ;; verify the engine customs
+  (for-each (lambda (c)
+	      (let ((i (car c))
+		    (a (cadr c)))
+		(set-car! (cdr c) (verify a e))))
+	    (slot-ref e 'customs))
+
+   node)
+
+;;; verify.scm ends here
\ No newline at end of file
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
new file mode 100644
index 0000000..b16819d
--- /dev/null
+++ b/src/guile/skribilo/writer.scm
@@ -0,0 +1,261 @@
+;;; writer.scm  --  Markup writers.
+;;;
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo writer)
+  :export (<writer> writer? write-object writer-options writer-ident
+	            writer-before writer-action writer-after writer-class
+
+	   invoke markup-writer markup-writer-get markup-writer-get*
+	   lookup-markup-writer copy-markup-writer)
+
+  :use-module (skribilo utils syntax)
+  :autoload (srfi srfi-1)     (find filter)
+  :autoload (skribilo engine) (engine? engine-ident? default-engine))
+
+
+(use-modules (skribilo debug)
+	     (skribilo output)
+	     (skribilo ast)
+	     (skribilo lib)
+
+	     (oop goops)
+	     (ice-9 optargs))
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Class definition.
+;;;
+
+(define-class <writer> ()
+  (ident	:init-keyword :ident	 :init-value '??? :getter writer-ident)
+  (class	:init-keyword :class	 :init-value 'unspecified
+		:getter writer-class)
+  (pred	:init-keyword :pred	 :init-value 'unspecified)
+  (upred	:init-keyword :upred	 :init-value 'unspecified)
+  (options	:init-keyword :options	 :init-value '()  :getter writer-options)
+  (verified?	:init-keyword :verified? :init-value #f)
+  (validate	:init-keyword :validate  :init-value #f)
+  (before	:init-keyword :before	 :init-value #f   :getter writer-before)
+  (action	:init-keyword :action	 :init-value #f   :getter writer-action)
+  (after	:init-keyword :after	 :init-value #f   :getter writer-after))
+
+(define (writer? obj)
+  (is-a? obj <writer>))
+
+(define-method (write (obj <writer>) port)
+  (format port "#[~A (~A) ~A]"
+	  (class-name (class-of obj))
+	  (slot-ref obj 'ident)
+	  (object-address obj)))
+
+
+
+;;;
+;;; Writer methods.
+;;;
+
+(define (invoke proc node e)
+  (with-debug 5 'invoke
+     (debug-item "e=" (engine-ident e))
+     (debug-item "node=" node " " (if (markup? node) (markup-markup node) ""))
+
+     (if (string? proc)
+	 (display proc)
+	 (if (procedure? proc)
+	     (proc node e)))))
+
+
+
+(define (make-writer-predicate markup predicate class)
+  (define (%always-true n e) #t)
+
+  (let* ((t2 (if class
+		 (lambda (n e)
+		   (and (equal? (markup-class n) class)))
+		 #f)))
+    (if predicate
+	(cond
+	  ((not (procedure? predicate))
+	     (skribe-error 'markup-writer
+			   "Illegal predicate (procedure expected)"
+			   predicate))
+	  ((not (eq? (%procedure-arity predicate) 2))
+	     (skribe-error 'markup-writer
+			   "Illegal predicate arity (2 arguments expected)"
+			   predicate))
+	  (else
+	   (if (procedure? t2)
+	       (lambda (n e)
+		 (and (t2 n e) (predicate n e)))
+	       predicate)))
+	t2)))
+
+
+;;;
+;;; `markup-writer'
+;;;
+
+(define* (markup-writer markup ;; #:optional (engine #f)
+			#:key (predicate #f) (class #f) (options '())
+			      (validate #f)
+			      (before #f)
+			      (action 'unspecified)
+			      (after #f)
+			#:rest engine)
+  ;;; FIXME:  `lambda*' sucks and fails when both optional arguments and
+  ;;; keyword arguments are used together.  In particular, if ENGINE is not
+  ;;; specified by the caller but other keyword arguments are specified, it
+  ;;; will consider the value of ENGINE to be the first keyword found.
+
+;  (let ((e (or engine (default-engine))))
+  (let ((e (or (if (and (list? engine) (not (keyword? (car engine))))
+		   (car engine)
+		   #f)
+	       (default-engine))))
+
+    (cond
+      ((and (not (symbol? markup)) (not (eq? markup #t)))
+       (skribe-error 'markup-writer "illegal markup" markup))
+      ((not (engine? e))
+	  (skribe-error 'markup-writer "illegal engine" e))
+      ((and (not predicate)
+	    (not class)
+	    (null? options)
+	    (not before)
+	    (eq? action 'unspecified)
+	    (not after))
+       (skribe-error 'markup-writer "illegal writer" markup))
+      (else
+       (let ((m  (make-writer-predicate markup predicate class))
+	     (ac (if (eq? action 'unspecified)
+		     (lambda (n e) (output (markup-body n) e))
+		     action)))
+	 (engine-add-writer! e markup m predicate
+			     options before ac after class validate))))))
+
+
+
+;;;
+;;; Finding a markup writer.
+;;;
+
+(define (lookup-markup-writer node e)
+  ;; Find the writer that applies best to NODE.  See also `markup-writer-get'
+  ;; and `markup-writer-get*'.
+
+  (define (matching-writer writers)
+    (find (lambda (w)
+	    (let ((pred (slot-ref w 'pred)))
+	      (if (procedure? pred)
+		  (pred node e)
+		  #t)))
+	  writers))
+
+  (let* ((writers (slot-ref e 'writers))
+	 (node-writers (hashq-ref writers (markup-markup node) '()))
+	 (delegate (slot-ref e 'delegate)))
+
+    (or (matching-writer node-writers)
+	(matching-writer (slot-ref e 'free-writers))
+	(and (engine? delegate)
+	     (lookup-markup-writer node delegate)))))
+
+
+(define* (markup-writer-get markup :optional engine :key (class #f) (pred #f))
+  ;; Get a markup writer for MARKUP (a symbol) in ENGINE, with class CLASS
+  ;; and user predicate PRED.  [FIXME: Useless since PRED is a procedure and
+  ;; therefore not comparable?]
+
+  (define (matching-writer writers)
+    (find (lambda (w)
+	    (and (if class (equal? (writer-class w) class) #t)
+		 (or (unspecified? pred)
+		     (eq? (slot-ref w 'upred) pred))))
+	  writers))
+
+  (let ((e (or engine (default-engine))))
+    (cond
+      ((not (symbol? markup))
+       (skribe-error 'markup-writer-get "illegal symbol" markup))
+      ((not (engine? e))
+       (skribe-error 'markup-writer-get "illegal engine" e))
+      (else
+       (let* ((writers (slot-ref e 'writers))
+	      (markup-writers (hashq-ref writers markup '()))
+	      (delegate (slot-ref e 'delegate)))
+
+	 (or (matching-writer markup-writers)
+	     (and (engine? delegate)
+		  (markup-writer-get markup delegate
+				     :class class :pred pred))))))))
+
+
+(define* (markup-writer-get* markup #:optional engine #:key (class #f))
+  ;; Finds all writers, recursively going through the engine hierarchy, that
+  ;; match MARKUP with optional CLASS attribute.
+
+  (define (matching-writers writers)
+    (filter (lambda (w)
+	      (or (not class)
+		  (equal? (writer-class w) class)))
+	    writers))
+
+  (let ((e (or engine (default-engine))))
+    (cond
+      ((not (symbol? markup))
+       (skribe-error 'markup-writer "illegal symbol" markup))
+      ((not (engine? e))
+       (skribe-error 'markup-writer "illegal engine" e))
+      (else
+       (let* ((writers (slot-ref e 'writers))
+	      (markup-writers (hashq-ref writers markup '()))
+	      (delegate (slot-ref e 'delegate)))
+
+	 (append (matching-writers writers)
+		 (if (engine? delegate)
+		     (markup-writer-get* markup delegate :class class)
+		     '())))))))
+
+
+(define* (copy-markup-writer markup old-engine :optional new-engine
+			      :key (predicate 'unspecified)
+				   (class 'unspecified)
+				   (options 'unspecified)
+				   (validate 'unspecified)
+				   (before 'unspecified)
+				   (action 'unspecified)
+				   (after 'unspecified))
+    (let ((old        (markup-writer-get markup old-engine))
+	  (new-engine (or new-engine old-engine)))
+      (markup-writer markup new-engine
+	 :pred      (if (unspecified? predicate) (slot-ref old 'pred) predicate)
+	 :class     (if (unspecified? class)     (slot-ref old 'class) class)
+	 :options   (if (unspecified? options)   (slot-ref old 'options) options)
+	 :validate  (if (unspecified? validate)  (slot-ref old 'validate) validate)
+	 :before    (if (unspecified? before)    (slot-ref old 'before) before)
+	 :action    (if (unspecified? action)    (slot-ref old 'action) action)
+	 :after     (if (unspecified? after)     (slot-ref old 'after) after))))
+
+;;; writer.scm ends here