From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Jun 2005 13:00:39 +0000
Subject: Initial import of Skribe 1.2d.
Initial import of Skribe 1.2d.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0
---
skribe/skr/html.skr | 2251 +++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 2251 insertions(+)
create mode 100644 skribe/skr/html.skr
(limited to 'skribe/skr/html.skr')
diff --git a/skribe/skr/html.skr b/skribe/skr/html.skr
new file mode 100644
index 0000000..ebac5f2
--- /dev/null
+++ b/skribe/skr/html.skr
@@ -0,0 +1,2251 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/skr/html.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sat Jul 26 12:28:57 2003 */
+;* Last change : Thu Jun 2 10:57:42 2005 (serrano) */
+;* Copyright : 2003-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* HTML Skribe engine */
+;* ------------------------------------------------------------- */
+;* Implementation: */
+;* common: @path ../src/common/api.src@ */
+;* bigloo: @path ../src/bigloo/api.bgl@ */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/htmle.skb:ref@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* html-engine ... */
+;*---------------------------------------------------------------------*/
+(define html-engine
+ ;; setup the html engine
+ (default-engine-set!
+ (make-engine 'html
+ :version 1.0
+ :format "html"
+ :delegate (find-engine 'base)
+ :filter (make-string-replace '((#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\" """)
+ (#\@ "@")))
+ :custom `(;; the icon associated with the URL
+ (favicon #f)
+ ;; charset used
+ (charset "ISO-8859-1")
+ ;; enable/disable Javascript
+ (javascript #f)
+ ;; user html head
+ (head #f)
+ ;; user CSS
+ (css ())
+ ;; user inlined CSS
+ (inline-css ())
+ ;; user JS
+ (js ())
+ ;; emit-sui
+ (emit-sui #f)
+ ;; the body
+ (background "#ffffff")
+ (foreground #f)
+ ;; the margins
+ (margin-padding 3)
+ (left-margin #f)
+ (chapter-left-margin #f)
+ (section-left-margin #f)
+ (left-margin-font #f)
+ (left-margin-size 17.)
+ (left-margin-background "#dedeff")
+ (left-margin-foreground #f)
+ (right-margin #f)
+ (chapter-right-margin #f)
+ (section-right-margin #f)
+ (right-margin-font #f)
+ (right-margin-size 17.)
+ (right-margin-background "#dedeff")
+ (right-margin-foreground #f)
+ ;; author configuration
+ (author-font #f)
+ ;; title configuration
+ (title-font #f)
+ (title-background "#8381de")
+ (title-foreground #f)
+ (file-title-separator " -- ")
+ ;; index configuration
+ (index-header-font-size +2.)
+ ;; chapter configuration
+ (chapter-number->string number->string)
+ (chapter-file #f)
+ ;; section configuration
+ (section-title-start "
")
+ (section-title-stop "
")
+ (section-title-background "#dedeff")
+ (section-title-foreground "black")
+ (section-title-number-separator " ")
+ (section-number->string number->string)
+ (section-file #f)
+ ;; subsection configuration
+ (subsection-title-start "")
+ (subsection-title-stop "
")
+ (subsection-title-background "#ffffff")
+ (subsection-title-foreground "#8381de")
+ (subsection-title-number-separator " ")
+ (subsection-number->string number->string)
+ (subsection-file #f)
+ ;; subsubsection configuration
+ (subsubsection-title-start "")
+ (subsubsection-title-stop "
")
+ (subsubsection-title-background #f)
+ (subsubsection-title-foreground "#8381de")
+ (subsubsection-title-number-separator " ")
+ (subsubsection-number->string number->string)
+ (subsubsection-file #f)
+ ;; source fontification
+ (source-color #t)
+ (source-comment-color "#ffa600")
+ (source-error-color "red")
+ (source-define-color "#6959cf")
+ (source-module-color "#1919af")
+ (source-markup-color "#1919af")
+ (source-thread-color "#ad4386")
+ (source-string-color "red")
+ (source-bracket-color "red")
+ (source-type-color "#00cf00")
+ ;; image
+ (image-format ("png" "gif" "jpg" "jpeg")))
+ :symbol-table '(("iexcl" "¡")
+ ("cent" "¢")
+ ("pound" "£")
+ ("currency" "¤")
+ ("yen" "¥")
+ ("section" "§")
+ ("mul" "¨")
+ ("copyright" "©")
+ ("female" "ª")
+ ("lguillemet" "«")
+ ("not" "¬")
+ ("registered" "®")
+ ("degree" "°")
+ ("plusminus" "±")
+ ("micro" "µ")
+ ("paragraph" "¶")
+ ("middot" "·")
+ ("male" "¸")
+ ("rguillemet" "»")
+ ("1/4" "¼")
+ ("1/2" "½")
+ ("3/4" "¾")
+ ("iquestion" "¿")
+ ("Agrave" "À")
+ ("Aacute" "Á")
+ ("Acircumflex" "Â")
+ ("Atilde" "Ã")
+ ("Amul" "Ä")
+ ("Aring" "Å")
+ ("AEligature" "Æ")
+ ("Oeligature" "Œ")
+ ("Ccedilla" "Ç")
+ ("Egrave" "È")
+ ("Eacute" "É")
+ ("Ecircumflex" "Ê")
+ ("Euml" "Ë")
+ ("Igrave" "Ì")
+ ("Iacute" "Í")
+ ("Icircumflex" "Î")
+ ("Iuml" "Ï")
+ ("ETH" "Ð")
+ ("Ntilde" "Ñ")
+ ("Ograve" "Ò")
+ ("Oacute" "Ó")
+ ("Ocurcumflex" "Ô")
+ ("Otilde" "Õ")
+ ("Ouml" "Ö")
+ ("times" "×")
+ ("Oslash" "Ø")
+ ("Ugrave" "Ù")
+ ("Uacute" "Ú")
+ ("Ucircumflex" "Û")
+ ("Uuml" "Ü")
+ ("Yacute" "Ý")
+ ("THORN" "Þ")
+ ("szlig" "ß")
+ ("agrave" "à")
+ ("aacute" "á")
+ ("acircumflex" "â")
+ ("atilde" "ã")
+ ("amul" "ä")
+ ("aring" "å")
+ ("aeligature" "æ")
+ ("oeligature" "œ")
+ ("ccedilla" "ç")
+ ("egrave" "è")
+ ("eacute" "é")
+ ("ecircumflex" "ê")
+ ("euml" "ë")
+ ("igrave" "ì")
+ ("iacute" "í")
+ ("icircumflex" "î")
+ ("iuml" "ï")
+ ("eth" "ð")
+ ("ntilde" "ñ")
+ ("ograve" "ò")
+ ("oacute" "ó")
+ ("ocurcumflex" "ô")
+ ("otilde" "õ")
+ ("ouml" "ö")
+ ("divide" "÷")
+ ("oslash" "ø")
+ ("ugrave" "ù")
+ ("uacute" "ú")
+ ("ucircumflex" "û")
+ ("uuml" "ü")
+ ("yacute" "ý")
+ ("thorn" "þ")
+ ("ymul" "ÿ")
+ ;; Greek
+ ("Alpha" "Α")
+ ("Beta" "Β")
+ ("Gamma" "Γ")
+ ("Delta" "Δ")
+ ("Epsilon" "Ε")
+ ("Zeta" "Ζ")
+ ("Eta" "Η")
+ ("Theta" "Θ")
+ ("Iota" "Ι")
+ ("Kappa" "Κ")
+ ("Lambda" "Λ")
+ ("Mu" "Μ")
+ ("Nu" "Ν")
+ ("Xi" "Ξ")
+ ("Omicron" "Ο")
+ ("Pi" "Π")
+ ("Rho" "Ρ")
+ ("Sigma" "Σ")
+ ("Tau" "Τ")
+ ("Upsilon" "Υ")
+ ("Phi" "Φ")
+ ("Chi" "Χ")
+ ("Psi" "Ψ")
+ ("Omega" "Ω")
+ ("alpha" "α")
+ ("beta" "β")
+ ("gamma" "γ")
+ ("delta" "δ")
+ ("epsilon" "ε")
+ ("zeta" "ζ")
+ ("eta" "η")
+ ("theta" "θ")
+ ("iota" "ι")
+ ("kappa" "κ")
+ ("lambda" "λ")
+ ("mu" "μ")
+ ("nu" "ν")
+ ("xi" "ξ")
+ ("omicron" "ο")
+ ("pi" "π")
+ ("rho" "ρ")
+ ("sigmaf" "ς")
+ ("sigma" "σ")
+ ("tau" "τ")
+ ("upsilon" "υ")
+ ("phi" "φ")
+ ("chi" "χ")
+ ("psi" "ψ")
+ ("omega" "ω")
+ ("thetasym" "ϑ")
+ ("piv" "ϖ")
+ ;; punctuation
+ ("bullet" "•")
+ ("ellipsis" "…")
+ ("weierp" "℘")
+ ("image" "ℑ")
+ ("real" "ℜ")
+ ("tm" "™")
+ ("alef" "ℵ")
+ ("<-" "←")
+ ("<--" "←")
+ ("uparrow" "↑")
+ ("->" "→")
+ ("-->" "→")
+ ("downarrow" "↓")
+ ("<->" "↔")
+ ("<-->" "↔")
+ ("<+" "↵")
+ ("<=" "⇐")
+ ("<==" "⇐")
+ ("Uparrow" "⇑")
+ ("=>" "⇒")
+ ("==>" "⇒")
+ ("Downarrow" "⇓")
+ ("<=>" "⇔")
+ ("<==>" "⇔")
+ ;; Mathematical operators
+ ("forall" "∀")
+ ("partial" "∂")
+ ("exists" "∃")
+ ("emptyset" "∅")
+ ("infinity" "∞")
+ ("nabla" "∇")
+ ("in" "∈")
+ ("notin" "∉")
+ ("ni" "∋")
+ ("prod" "∏")
+ ("sum" "∑")
+ ("asterisk" "∗")
+ ("sqrt" "√")
+ ("propto" "∝")
+ ("angle" "∠")
+ ("and" "∧")
+ ("or" "∨")
+ ("cap" "∩")
+ ("cup" "∪")
+ ("integral" "∫")
+ ("therefore" "∴")
+ ("models" "|=")
+ ("vdash" "|-")
+ ("dashv" "-|")
+ ("sim" "∼")
+ ("cong" "≅")
+ ("approx" "≈")
+ ("neq" "≠")
+ ("equiv" "≡")
+ ("le" "≤")
+ ("ge" "≥")
+ ("subset" "⊂")
+ ("supset" "⊃")
+ ("nsupset" "⊃")
+ ("subseteq" "⊆")
+ ("supseteq" "⊇")
+ ("oplus" "⊕")
+ ("otimes" "⊗")
+ ("perp" "⊥")
+ ("mid" "|")
+ ("lceil" "⌈")
+ ("rceil" "⌉")
+ ("lfloor" "⌊")
+ ("rfloor" "⌋")
+ ("langle" "〈")
+ ("rangle" "〉")
+ ;; Misc
+ ("loz" "◊")
+ ("spades" "♠")
+ ("clubs" "♣")
+ ("hearts" "♥")
+ ("diams" "♦")
+ ("euro" "ℐ")
+ ;; LaTeX
+ ("dag" "dag")
+ ("ddag" "ddag")
+ ("circ" "o")
+ ("top" "T")
+ ("bottom" "⊥")
+ ("lhd" "<")
+ ("rhd" ">")
+ ("parallel" "||")))))
+
+;*---------------------------------------------------------------------*/
+;* html-title-engine ... */
+;*---------------------------------------------------------------------*/
+(define html-title-engine
+ (copy-engine 'html-title base-engine
+ :filter (make-string-replace '((#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\" """)))))
+
+;*---------------------------------------------------------------------*/
+;* html-browser-title ... */
+;*---------------------------------------------------------------------*/
+(define (html-browser-title n)
+ (and (markup? n)
+ (or (markup-option n :html-title)
+ (if (document? n)
+ (markup-option n :title)
+ (html-browser-title (ast-parent n))))))
+
+;*---------------------------------------------------------------------*/
+;* html-file ... */
+;*---------------------------------------------------------------------*/
+(define html-file
+ (let ((table '())
+ (filename (gensym)))
+ (define (get-file-name base suf)
+ (let* ((c (assoc base table))
+ (n (if (pair? c)
+ (let ((n (+ 1 (cdr c))))
+ (set-cdr! c n)
+ n)
+ (begin
+ (set! table (cons (cons base 1) table))
+ 1))))
+ (format "~a-~a.~a" base n suf)))
+ (lambda (node e)
+ (let ((f (markup-option node filename))
+ (file (markup-option node :file)))
+ (cond
+ ((string? f)
+ f)
+ ((string? file)
+ file)
+ ((or file
+ (and (is-markup? node 'chapter)
+ (engine-custom e 'chapter-file))
+ (and (is-markup? node 'section)
+ (engine-custom e 'section-file))
+ (and (is-markup? node 'subsection)
+ (engine-custom e 'subsection-file))
+ (and (is-markup? node 'subsubsection)
+ (engine-custom e 'subsubsection-file)))
+ (let* ((b (or (and (string? *skribe-dest*)
+ (prefix *skribe-dest*))
+ ""))
+ (s (or (and (string? *skribe-dest*)
+ (suffix *skribe-dest*))
+ "html"))
+ (nm (get-file-name b s)))
+ (markup-option-add! node filename nm)
+ nm))
+ ((document? node)
+ *skribe-dest*)
+ (else
+ (let ((p (ast-parent node)))
+ (if (container? p)
+ (let ((file (html-file p e)))
+ (if (string? file)
+ (begin
+ (markup-option-add! node filename file)
+ file)
+ #f))
+ #f))))))))
+
+;*---------------------------------------------------------------------*/
+;* html-container-number ... */
+;* ------------------------------------------------------------- */
+;* Returns a string representing the container number */
+;*---------------------------------------------------------------------*/
+(define (html-container-number c e)
+ (define (html-number n proc)
+ (cond
+ ((string? n)
+ n)
+ ((number? n)
+ (if (procedure? proc)
+ (proc n)
+ (number->string n)))
+ (else
+ "")))
+ (define (html-chapter-number c)
+ (html-number (markup-option c :number)
+ (engine-custom e 'chapter-number->string)))
+ (define (html-section-number c)
+ (let ((p (ast-parent c))
+ (s (html-number (markup-option c :number)
+ (engine-custom e 'section-number->string))))
+ (cond
+ ((is-markup? p 'chapter)
+ (string-append (html-chapter-number p) "." s))
+ (else
+ (string-append s)))))
+ (define (html-subsection-number c)
+ (let ((p (ast-parent c))
+ (s (html-number (markup-option c :number)
+ (engine-custom e 'subsection-number->string))))
+ (cond
+ ((is-markup? p 'section)
+ (string-append (html-section-number p) "." s))
+ (else
+ (string-append "." s)))))
+ (define (html-subsubsection-number c)
+ (let ((p (ast-parent c))
+ (s (html-number (markup-option c :number)
+ (engine-custom e 'subsubsection-number->string))))
+ (cond
+ ((is-markup? p 'subsection)
+ (string-append (html-subsection-number p) "." s))
+ (else
+ (string-append ".." s)))))
+ (define (inner-html-container-number c)
+ (html-number (markup-option c :number) #f))
+ (let ((n (markup-option c :number)))
+ (if (not n)
+ ""
+ (case (markup-markup c)
+ ((chapter)
+ (html-chapter-number c))
+ ((section)
+ (html-section-number c))
+ ((subsection)
+ (html-subsection-number c))
+ ((subsubsection)
+ (html-subsubsection-number c))
+ (else
+ (if (container? c)
+ (inner-html-container-number c)
+ (skribe-error 'html-container-number
+ "Not a container"
+ (markup-markup c))))))))
+
+;*---------------------------------------------------------------------*/
+;* html-counter ... */
+;*---------------------------------------------------------------------*/
+(define (html-counter cnts)
+ (cond
+ ((not cnts)
+ "")
+ ((null? cnts)
+ "")
+ ((not (pair? cnts))
+ cnts)
+ ((null? (cdr cnts))
+ (format "~a." (car cnts)))
+ (else
+ (let loop ((cnts cnts))
+ (if (null? (cdr cnts))
+ (format "~a" (car cnts))
+ (format "~a.~a" (car cnts) (loop (cdr cnts))))))))
+
+;*---------------------------------------------------------------------*/
+;* html-width ... */
+;*---------------------------------------------------------------------*/
+(define (html-width width)
+ (cond
+ ((and (integer? width) (exact? width))
+ (format "~A" width))
+ ((real? width)
+ (format "~A%" (inexact->exact (round width))))
+ ((string? width)
+ width)
+ (else
+ (skribe-error 'html-width "bad width" width))))
+
+;*---------------------------------------------------------------------*/
+;* html-class ... */
+;*---------------------------------------------------------------------*/
+(define (html-class m)
+ (if (markup? m)
+ (let ((c (markup-class m)))
+ (if (or (string? c) (symbol? c) (number? c))
+ (printf " class=\"~a\"" c)))))
+
+;*---------------------------------------------------------------------*/
+;* html-markup-class ... */
+;*---------------------------------------------------------------------*/
+(define (html-markup-class m)
+ (lambda (n e)
+ (printf "<~a" m)
+ (html-class n)
+ (display ">")))
+
+;*---------------------------------------------------------------------*/
+;* html-color-spec? ... */
+;*---------------------------------------------------------------------*/
+(define (html-color-spec? v)
+ (and v
+ (not (unspecified? v))
+ (or (not (string? v)) (> (string-length v) 0))))
+
+;*---------------------------------------------------------------------*/
+;* document ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+ :options '(:title :author :ending :html-title :env)
+ :action (lambda (n e)
+ (let* ((id (markup-ident n))
+ (title (new markup
+ (markup '&html-document-title)
+ (parent n)
+ (ident (string-append id "-title"))
+ (class (markup-class n))
+ (options `((author ,(markup-option n :author))))
+ (body (markup-option n :title)))))
+ (&html-generic-document n title e)))
+ :after (lambda (n e)
+ (if (engine-custom e 'emit-sui)
+ (document-sui n e))))
+
+;*---------------------------------------------------------------------*/
+;* &html-html ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-html
+ :before "
+
+\n"
+ :after "")
+
+;*---------------------------------------------------------------------*/
+;* &html-head ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-head
+ :before (lambda (n e)
+ (printf "\n")
+ (printf "\n" (engine-custom (find-engine 'html)
+ 'charset)))
+ :after "\n\n")
+
+;*---------------------------------------------------------------------*/
+;* &html-body ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-body
+ :before (lambda (n e)
+ (let ((bg (engine-custom e 'background)))
+ (display "\n")))
+ :after "\n")
+
+;*---------------------------------------------------------------------*/
+;* &html-page ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-page
+ :action (lambda (n e)
+ (define (html-margin m fn size bg fg cla)
+ (printf "" bg)
+ (display ">"))
+ (printf " \n" cla)
+ (cond
+ ((and (string? fg) (string? fn))
+ (printf "" fg fn))
+ ((string? fg)
+ (printf "" fg))
+ ((string? fn)
+ (printf "" fn)))
+ (if (procedure? m)
+ (skribe-eval (m n e) e)
+ (output m e))
+ (if (or (string? fg) (string? fn))
+ (display ""))
+ (display " | \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 "\n" ac))
+ (html-margin lm lmfn lms lmbg lmfg "skribe-left-margin")
+ (html-margin body #f #f #f #f "skribe-body")
+ (html-margin rm rmfn rms rmbg rmfg "skribe-right-margin")
+ (display "
"))
+ (lm
+ (let* ((ep (engine-custom e 'margin-padding))
+ (ac (if (number? ep) ep 0)))
+ (printf "\n" ac))
+ (html-margin lm lmfn lms lmbg lmfg "skribe-left-margin")
+ (html-margin body #f #f #f #f "skribe-body")
+ (display "
"))
+ (rm
+ (let* ((ep (engine-custom e 'margin-padding))
+ (ac (if (number? ep) ep 0)))
+ (printf "\n"))
+ (html-margin body #f #f #f #f "skribe-body")
+ (html-margin rm rmfn rms rmbg rmfg "skribe-right-margin")
+ (display "
"))
+ (else
+ (display "\n")
+ (output body e)
+ (display "
\n"))))))
+
+;*---------------------------------------------------------------------*/
+;* &html-generic-header ... */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-header n e)
+ (let* ((ic (engine-custom e 'favicon))
+ (id (markup-ident n)))
+ (unless (string? id)
+ (skribe-error '&html-generic-header
+ (format "Illegal identifier `~a'" id)
+ n))
+ ;; title
+ (output (new markup
+ (markup '&html-header-title)
+ (parent n)
+ (ident (string-append id "-title"))
+ (class (markup-class n))
+ (body (markup-body n)))
+ e)
+ ;; favicon
+ (output (new markup
+ (markup '&html-header-favicon)
+ (parent n)
+ (ident (string-append id "-favicon"))
+ (body (cond
+ ((string? ic)
+ ic)
+ ((procedure? ic)
+ (ic d e)))))
+ e)
+ ;; style
+ (output (new markup
+ (markup '&html-header-style)
+ (parent n)
+ (ident (string-append id "-style"))
+ (class (markup-class n)))
+ e)
+ ;; css
+ (output (new markup
+ (markup '&html-header-css)
+ (parent n)
+ (ident (string-append id "-css"))
+ (body (let ((c (engine-custom e 'css)))
+ (if (string? c)
+ (list c)
+ c))))
+ e)
+ ;; javascript
+ (output (new markup
+ (markup '&html-header-javascript)
+ (parent n)
+ (ident (string-append id "-javascript")))
+ e)))
+
+(markup-writer '&html-header-title
+ :before ""
+ :action (lambda (n e)
+ (output (markup-body n) html-title-engine))
+ :after "\n")
+
+(markup-writer '&html-header-favicon
+ :action (lambda (n e)
+ (let ((i (markup-body n)))
+ (when i
+ (printf " \n" i)))))
+
+(markup-writer '&html-header-css
+ :action (lambda (n e)
+ (let ((css (markup-body n)))
+ (when (pair? css)
+ (for-each (lambda (css)
+ (printf " \n" css))
+ css)))))
+
+(markup-writer '&html-header-style
+ :before " \n")
+
+(markup-writer '&html-header-javascript
+ :action (lambda (n e)
+ (when (engine-custom e 'javascript)
+ (display " \n"))
+ (let* ((ejs (engine-custom e 'js))
+ (js (cond
+ ((string? ejs)
+ (list ejs))
+ ((list? ejs)
+ ejs)
+ (else
+ '()))))
+ (for-each (lambda (s)
+ (printf "" 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 ""
+ :action (lambda (n e)
+ (let ((body (markup-body n)))
+ (if body
+ (output body #t)
+ (skribe-eval [
+,(hrule)
+,(p :class "ending" (font :size -1 [
+This ,(sc "Html") page has been produced by
+,(ref :url (skribe-url) :text "Skribe").
+,(linebreak)
+Last update ,(it (date)).]))] e))))
+ :after "
\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 "\n")
+ (if (html-color-spec? tbg)
+ (printf "" tbg)
+ (display " | "))
+ (if (string? tfg)
+ (printf "" tfg))
+ (when title
+ (if (string? tfont)
+ (begin
+ (printf "" tfont)
+ (output title e)
+ (display ""))
+ (begin
+ (printf " ")
+ (output title e)
+ (display " "))))
+ (if (not authors)
+ (display "\n")
+ (html-title-authors authors e))
+ (if (string? tfg)
+ (display ""))
+ (display " |
\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 "