From efea4dc93f2565555e47de0bfd027614a9c8674d Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Fri, 1 Jul 2005 23:55:56 +0000
Subject: Lots of changes, again.
Lots of changes, notably the following:
* skr/*.skr: Moved engines to `src/guile/skribilo/engine'.
* src/guile/skribilo/engine.scm (lookup-engine): Rewritten. Don't use
the auto-load alist.
* src/guile/skribilo/evaluator.scm: New name of the `eval' module.
`eval' couldn't be used as the module base-name because of Guile's
recursive module name space.
git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-2
---
skr/html.skr | 2271 ----------------------------------------------------------
1 file changed, 2271 deletions(-)
delete mode 100644 skr/html.skr
(limited to 'skr/html.skr')
diff --git a/skr/html.skr b/skr/html.skr
deleted file mode 100644
index 79186ca..0000000
--- a/skr/html.skr
+++ /dev/null
@@ -1,2271 +0,0 @@
-;*=====================================================================*/
-;* 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-file-default ... */
-;*---------------------------------------------------------------------*/
-(define html-file-default
- ;; Default implementation of the `file-name-proc' custom.
- (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-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 " -- ")
- ;; html file naming
- (file-name-proc ,html-file-default)
- ;; 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-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 '((#\< "<")
- (#\> ">")
- (#\& "&")
- (#\" """)))))
-
-;*---------------------------------------------------------------------*/
-;* 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 "~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 "