DSSSL style sheet for DocBook to HTML conversion Version 1.6
From: Mark Burton
Posted to: CTS, 04 Jul 1997 13:39:42 +0100
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; dbtohtml.dsl - DSSSL style sheet for DocBook to HTML conversion (jadeware)
;
; Author : Mark Burton (markb@ordern.com)
; Created On : Fri Jun 13 18:21:14 1997
; Last Modified By: Mark Burton
; Last Modified On: Thu Jul 3 10:07:20 1997
;
; $Id: dbtohtml.dsl,v 1.6 1997/07/03 09:07:58 markb Exp $
;
; Usage:
;
; jade -d dbtohtml.dsl -t sgml yourdoc.sgm
;
; Additional command line options:
;
; -V %no-split-output% sends all the output to one file
; -V %no-make-index% disables index creation
; -V %no-make-toc% disables TOC creation
; -V %no-shade-screen% disables grey background to SCREEN regions
; -V %show-comments% includes contents of COMMENT regions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Contributors
; Mark Eichin (eichin@cygnus.com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Parameterisation
; This style sheet can easily be parameterised by the use of a driver.
; Here is a simple example that sets the output file basename and directory.
; If the driver is foo.dsl, use: jade -d foo.dsl -t sgml yourdoc.sgm
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; declare non-standard functions
(declare-flow-object-class element
"UNREGISTERED::James Clark//Flow Object Class::element")
(declare-flow-object-class empty-element
"UNREGISTERED::James Clark//Flow Object Class::empty-element")
(declare-flow-object-class document-type
"UNREGISTERED::James Clark//Flow Object Class::document-type")
(declare-flow-object-class processing-instruction
"UNREGISTERED::James Clark//Flow Object Class::processing-instruction")
(declare-flow-object-class entity
"UNREGISTERED::James Clark//Flow Object Class::entity")
(declare-flow-object-class entity-ref
"UNREGISTERED::James Clark//Flow Object Class::entity-ref")
(declare-flow-object-class formatting-instruction
"UNREGISTERED::James Clark//Flow Object Class::formatting-instruction")
(declare-characteristic preserve-sdata?
"UNREGISTERED::James Clark//Characteristic::preserve-sdata?" #f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; variables
(define %no-split-output% #f)
(define %no-make-toc% #f)
(define %no-make-index% #f)
(define %no-shade-screen% #f)
(define %show-comments% #f)
(define %html-public-id% "-//W3C//DTD HTML 3.2 Final//EN")
(define %body-bgcolor% "white")
(define %output-directory% ".")
(define %output-basename% "DBTOHTML")
(define %output-suffix% ".html")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; top-level sections
(element BOOK
(cond (%no-split-output% ; everything goes in one file
(make-file (string-append %output-basename% %output-suffix%)
(make sequence
(process-children)
(cond ((not %no-make-index%)
(make sequence
(make-fat-rule)
(make-index)))
(#t (empty-sosofo))))))
(#t ; split output into separate files
(make sequence
(make-file (string-append %output-basename% %output-suffix%)
(make sequence
(process-first-descendant "TITLE")
(process-first-descendant "BOOKINFO")))
(process-matching-children "PREFACE"
"CHAPTER"
"APPENDIX"
"BIBLIOGRAPHY"
"ARTHEADER")
(cond ((not %no-make-index%)
(make-file (string-append %output-basename%
"-INDEX"
%output-suffix%)
(make-index)))
(#t (empty-sosofo)))))))
(define (make-file file-name content)
(make entity
system-id: (string-append %output-directory% "/" file-name)
(make sequence
(make document-type
name: "html"
public-id: %html-public-id%)
(make element
gi: "HTML"
(make sequence
(make element
gi: "HEAD"
(make element
gi: "TITLE"
(with-mode extract-title-text
(process-first-descendant "TITLE"))))
(make element
gi: "BODY"
attributes: (list (list "bgcolor" %body-bgcolor%))
(make sequence
(make-anchor)
content
(make-footer))))))))
(define (make-footer)
(let ((copyright (select-elements (descendants (book-node))
'("COPYRIGHT" "BOOKINFO"))))
(cond ((node-list-empty? copyright) (empty-sosofo))
(#t (make sequence
(make-fat-rule)
(process-node-list copyright))))))
(define (node-list-last nl)
(node-list-ref nl (- (node-list-length nl) 1)))
(define (make-nav-links parent-gi)
(make sequence
(make element
gi: "A"
attributes: (list (list "href" (link-file-name (ancestor parent-gi))))
(literal "Up"))
(literal " ")
(if (absolute-last-sibling?)
(empty-sosofo)
(make element
gi: "A"
attributes: (list (list "href"
(link-file-name (node-list-first
(follow (current-node))))))
(literal "Forward")))
(literal " ")
(if (absolute-first-sibling?)
(empty-sosofo)
(make element
gi: "A"
attributes: (list (list "href"
(link-file-name (node-list-last
(preced (current-node))))))
(literal "Back")))))
(define (make-pref-chap-app)
(cond (%no-split-output%
(make sequence
(make-anchor)
(make-fat-rule)
(process-children)))
(#t
(make-file (link-file-name (current-node))
(make sequence
(make-nav-links "BOOK")
(process-children)
(make-nav-links "BOOK"))))))
(element ARTICLE (process-children))
(element PREFACE (make-pref-chap-app))
(element CHAPTER (make-pref-chap-app))
(element APPENDIX (make-pref-chap-app))
(element BEGINPAGE (make empty-element gi: "HR"))
(element BIBLIOGRAPHY (make-pref-chap-app))
(element BOOKBIBLIO (process-children))
(element ARTHEADER (make-pref-chap-app))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; sections
(element SECT1
(make sequence
(make-anchor)
(process-children)))
(element SECT2
(make sequence
(make-anchor)
(process-children)))
(element SECT3
(make sequence
(make-anchor)
(process-children)))
(element SECT4
(make sequence
(make-anchor)
(process-children)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; titles
(mode extract-title-text
(element (TITLE)
(process-children)))
(element (BOOK TITLE)
(make sequence
(make element
gi: "CENTER"
(make element
gi: "H1"
(process-children)))))
(element (CHAPTER TITLE)
(make element
gi: "H1"
(make sequence
(literal (chap-app-head-label "Chapter"))
(process-children-trim))))
(element (APPENDIX TITLE)
(make element
gi: "H1"
(make sequence
(literal (chap-app-head-label "Appendix"))
(process-children-trim))))
(element (BIBLIOGRAPHY TITLE)
(make element gi: "H1"
(make sequence
(literal (chap-app-head-label "Bibliography"))
(process-children-trim))))
(element (BOOKBIBLIO TITLE)
(make element gi: "H2"
(make sequence
;;; (literal (chap-app-head-label "Bibliography"))
(process-children-trim))))
(element (ARTHEADER TITLE)
(make element gi: "H1"
(process-children-trim)))
(element (SECT1 TITLE) (make element gi: "H2"))
(element (SECT2 TITLE) (make element gi: "H3"))
(element (SECT3 TITLE) (make element gi: "H4"))
(element (SECT4 TITLE) (make element gi: "H5"))
(element (FORMALPARA TITLE) (make element gi: "H5"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; font changers
(element EMPHASIS
(make element gi: "I"))
(element TYPE
(make element gi: "B"
(make element gi: "TT")))
(element TOKEN
(make element gi: "I"
(make element gi: "B"
(make element gi: "TT"))))
(element REPLACEABLE (make element gi: "I"))
(element FIRSTTERM (make element gi: "I"))
(element APPLICATION (make element gi: "TT"))
(element FILENAME (make element gi: "TT"))
(element LITERAL (make element gi: "TT"))
(element ENVAR (make element gi: "TT"))
(element SUBSCRIPT (make element gi: "SUB"))
(element SUPERSCRIPT (make element gi: "SUP"))
(element CITETITLE (make element gi: "I"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; paragraph like things
(element CAUTION (make-special-para))
(element IMPORTANT (make-special-para))
(element WARNING (make-special-para))
(element NOTE (make-special-para))
(element TIP (make-special-para))
(element COMMENT
(cond (%show-comments%
(make element
gi: "FONT"
attributes: '(("color" "red"))
(make-special-para)))
(#t (empty-sosofo))))
(element PARA
(make sequence
(make empty-element
gi: "P")
(with-mode footnote-ref
(process-children))
(with-mode footnote-def
(process-matching-children "FOOTNOTE"))))
(element BLOCKQUOTE (make element gi: "BLOCKQUOTE"))
(element SCREEN
(let ((gubbins (make element
gi: "PRE"
(process-children))))
(make sequence
(make empty-element
gi: "P")
(if %no-shade-screen%
gubbins
(make element
gi: "TABLE"
attributes: '(("border" "0")
("bgcolor" "#E0E0E0")
("width" "100%"))
(make element
gi: "TR"
(make element
gi: "TD"
gubbins)))))))
(element FORMALPARA (process-children))
(element PHRASE (maybe-bold-children))
(mode footnote-ref
(element FOOTNOTE
(make sequence
(literal "[")
(literal (format-number (element-number (current-node)) "1"))
(literal "]"))))
(mode footnote-def
(element FOOTNOTE
(make element
gi: "BLOCKQUOTE"
(make sequence
(literal "[")
(literal (format-number (element-number (current-node)) "1"))
(literal "]")
(process-children)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; lists
(element ITEMIZEDLIST
(make sequence
(make empty-element
gi: "P")
(make element
gi: "UL")))
(element ORDEREDLIST
(make sequence
(make empty-element
gi: "P")
(make element
gi: "OL")))
(element (ITEMIZEDLIST LISTITEM)
(make sequence
(make empty-element
gi: "LI")
(process-children)
(make empty-element
gi: "P")))
(element (ORDEREDLIST LISTITEM)
(make sequence
(make empty-element
gi: "LI")
(process-children)
(make empty-element
gi: "P")))
(element VARIABLELIST
(make sequence
(make empty-element
gi: "P")
(make element
gi: "DL")))
(element VARLISTENTRY
(make sequence
(make empty-element
gi: "DT")
(process-children)))
(element (VARLISTENTRY LISTITEM)
(make sequence
(make empty-element
gi: "DD")
(process-children)
(make empty-element
gi: "P")))
(element TERM (maybe-bold-children))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; index
(define (index-entry-name indexterm)
(string-append "index." (format-number (element-number indexterm) "1")))
(element INDEXTERM
(make sequence
(make element
gi: "A"
attributes: (list (list "name" (index-entry-name (current-node))))
(literal ""))
(empty-sosofo)))
; DIY string-ci>?
(define (string-ci>? s1 s2)
(let ((len1 (string-length s1))
(len2 (string-length s2)))
(let loop ((i 0))
(cond ((= i len1) #f)
((= i len2) #t)
(#t (let ((c1 (index-char-val (string-ref s1 i)))
(c2 (index-char-val (string-ref s2 i))))
(cond
((= c1 c2) (loop (+ i 1)))
(#t (> c1 c2)))))))))
(define (index-char-val ch)
(case ch
((#\A #\a) 65)
((#\B #\b) 66)
((#\C #\c) 67)
((#\D #\d) 68)
((#\E #\e) 69)
((#\F #\f) 70)
((#\G #\g) 71)
((#\H #\h) 72)
((#\I #\i) 73)
((#\J #\j) 74)
((#\K #\k) 75)
((#\L #\l) 76)
((#\M #\m) 77)
((#\N #\n) 78)
((#\O #\o) 79)
((#\P #\p) 80)
((#\Q #\q) 81)
((#\R #\r) 82)
((#\S #\s) 83)
((#\T #\t) 84)
((#\U #\u) 85)
((#\V #\v) 86)
((#\W #\w) 87)
((#\X #\x) 88)
((#\Y #\y) 89)
((#\Z #\z) 90)
((#\ ) 32)
((#\0) 48)
((#\1) 49)
((#\2) 50)
((#\3) 51)
((#\4) 52)
((#\5) 53)
((#\6) 54)
((#\7) 55)
((#\8) 56)
((#\9) 57)
; laziness precludes me from filling this out further
(else 0)))
(define (string->number-list s)
(let loop ((i (- (string-length s) 1))
(l '()))
(if (< i 0)
l
(loop (- i 1) (cons (index-char-val (string-ref s i)) l)))))
(define (number-list>? l1 l2)
(cond ((null? l1) #f)
((null? l2) #t)
((= (car l1) (car l2))
(number-list>? (cdr l1) (cdr l2)))
(#t (> (car l1) (car l2)))))
; return the string data for a given index entry
(define (get-index-entry-data entry)
(let ((primary (select-elements (descendants entry) "PRIMARY"))
(secondary (select-elements (descendants entry) "SECONDARY")))
(if (node-list-empty? secondary)
(data primary)
(string-append (data primary) " - " (data secondary)))))
(define (make-index-entry entry)
(let ((text (get-index-entry-data entry)))
(cons text
(make sequence
(make empty-element
gi: "LI")
(make element
gi: "A"
attributes: (list (list "href"
(string-append (link-file-name
entry)
"#"
(index-entry-name
entry))))
(literal text))))))
(define (build-index nl)
(let loop ((result '())
(nl nl))
(if (node-list-empty? nl)
result
(loop (cons (make-index-entry (node-list-first nl)) result)
(node-list-rest nl)))))
(define (sort-index il)
(letrec ((list-head (lambda (l n)
(if (> n 0)
(cons (car l) (list-head (cdr l) (- n 1)))
'())))
(merge (lambda (il1 il2)
(cond ((null? il1) il2)
((null? il2) il1)
((string-ci>? (car (car il1)) (car (car il2)))
(cons (car il2) (merge il1 (cdr il2))))
(#t
(cons (car il1) (merge (cdr il1) il2)))))))
(let* ((ll (length il))
(ldiv2 (quotient ll 2)))
(if (> 2 ll)
il
(merge (sort-index (list-head il ldiv2))
(sort-index (list-tail il ldiv2)))))))
(define (output-index il)
(let extract-and-append ((il il)
(result (empty-sosofo)))
(if (null? il)
result
(extract-and-append (cdr il) (sosofo-append result (cdr (car il)))))))
(define (make-index)
(make sequence
(make element
gi: "A"
attributes: (list (list "name" "INDEXTOP"))
(literal ""))
(make element
gi: "H1"
(literal "Index"))
(make element
gi: "UL"
(output-index
(sort-index
(build-index (select-elements (descendants (current-node))
"INDEXTERM")))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; links & cross-references
(define (link-file-name target)
(cond (%no-split-output% "")
(#t
(string-append
%output-basename%
(cond ((equal? (gi target) "CHAPTER")
(string-append
"-"
(format-number (child-number target) "1")))
((ancestor-child-number "CHAPTER" target)
(string-append
"-"
(format-number (ancestor-child-number "CHAPTER" target) "1")))
((equal? (gi target) "APPENDIX")
(string-append
"-"
(format-number (child-number target) "A")))
((ancestor-child-number "APPENDIX" target)
(string-append
"-"
(format-number (ancestor-child-number "APPENDIX" target) "A")))
(#t ""))
%output-suffix%))))
(element LINK
(let* ((target (element-with-id (attribute-string "linkend")
(book-node)))
(target-file-name (link-file-name target)))
(make element
gi: "A"
attributes: (list
(list "href"
(string-append
target-file-name
"#"
(attribute-string "linkend")))))))
(element ULINK
(make element
gi: "A"
attributes: (list
(list "href" (attribute-string "url")))))
(element XREF
(let* ((target (element-with-id (attribute-string "linkend")
(book-node)))
(target-file-name (link-file-name target)))
(make element
gi: "A"
attributes: (list
(list "href"
(string-append target-file-name
"#"
(attribute-string "linkend"))))
(with-mode extract-xref-text
(process-node-list target)))))
(mode extract-xref-text
(default
(let ((title-sosofo (with-mode extract-title-text
(process-first-descendant "TITLE"))))
(if (sosofo? title-sosofo)
title-sosofo
(literal (string-append "Reference to " (gi)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; figures
(element FIGURE
(make sequence
(make empty-element
gi: "P")
(make-anchor)
(process-children)
(make empty-element
gi: "P")))
(element (FIGURE TITLE)
(make sequence
(make element
gi: "B")
(make empty-element
gi: "P")))
(element GRAPHIC
(let ((img
(make sequence
(make empty-element
gi: "P")
(make empty-element
gi: "IMG"
attributes: (list
(list "src" (attribute-string "fileref")))))))
(if (equal?
(attribute-string "align")
"CENTER")
(make element
gi: "CENTER"
img)
img)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; tables
(element INFORMALTABLE
(make sequence
(make empty-element
gi: "P")
(make element
gi: "TABLE"
attributes: (if (equal?
(attribute-string "frame")
"ALL")
'(("border" "2") ("cellpadding" "2"))
'()))
(make empty-element
gi: "P")))
(element TGROUP (process-children))
(element THEAD (process-children))
(element (THEAD ROW)
(make sequence
(make empty-element
gi: "TR")
(process-children)))
(element (THEAD ROW ENTRY)
(make sequence
(make empty-element
gi: "TD")
(make element
gi: "B"
(process-children))))
(element TBODY (process-children))
(element (TBODY ROW)
(make sequence
(make empty-element
gi: "TR")
(process-children)))
(element (TBODY ROW ENTRY)
(make sequence
(make empty-element
gi: "TD")
(process-children)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; book info
(element BOOKINFO
(make sequence
(make element
gi: "CENTER"
(process-children))
(cond ((not %no-make-toc%)
(make sequence
(make-fat-rule)
(make element
gi: "H2"
(literal "Contents"))
(make element
gi: "ul"
(with-mode make-toc-links
(process-node-list (book-node))))))
(#t (empty-sosofo)))))
(element AUTHORGROUP
(let ((reducer (lambda (sofar new)
(sosofo-append sofar (make element
gi: "H2"
(process-node-list new))))))
(make sequence
(node-list-reduce (select-elements (descendants (current-node)) "AUTHOR")
reducer
(empty-sosofo))
(node-list-reduce (select-elements (descendants (current-node)) "CORPAUTHOR")
reducer
(empty-sosofo)))))
(element COPYRIGHT
(make element
gi: "H4"
(make sequence
(make entity-ref
name: "copy")
(process-matching-children "HOLDER")
(process-matching-children "YEAR"))))
(element HOLDER
(make sequence
(literal " ")
(process-children-trim)))
(element YEAR
(make sequence
(literal " ")
(process-children-trim)))
(element CORPAUTHOR
(process-children-trim))
(element AUTHOR
(process-children-trim))
(element HONORIFIC
(make sequence
(process-children-trim)
(literal " ")))
(element FIRSTNAME
(make sequence
(process-children-trim)
(literal " ")))
(element OTHERNAME
(make sequence
(process-children-trim)
(literal " ")))
(element SURNAME
(make sequence
(process-children-trim)
(literal " ")))
(element LINEAGE
(make sequence
(process-children-trim)
(literal " ")))
(element TRADEMARK (process-children))
(element PUBLISHERNAME (process-children))
(element BIBLIOENTRY (process-children))
(element ACRONYM (process-children))
(element AFFILIATION
(make sequence
(make element
gi: "I")))
(element ORGNAME
(make sequence
(make empty-element
gi: "BR")
(process-children)))
(element ORGDIV
(make sequence
(make empty-element
gi: "BR")
(process-children)))
(element PUBLISHER
(make sequence
(make empty-element
gi: "BR")
(process-children)))
(element ISBN
(make sequence
(make empty-element
gi: "BR")
(process-children)))
(element PUBDATE
(make sequence
(make empty-element
gi: "BR")
(process-children)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TOC
(element LOF (empty-sosofo))
(element LOT (empty-sosofo))
(element TOC (empty-sosofo))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DIY TOC
(mode make-toc-links
(element (BOOK)
(sosofo-append
(process-children)
(cond ((not %no-make-index%)
(make sequence
(make empty-element
gi: "LI")
(make element
gi: "A"
attributes: (list (list "href"
(cond (%no-split-output% "#INDEXTOP")
(#t
(string-append %output-basename%
"-INDEX"
%output-suffix%
"#INDEXTOP")))))
(literal "Index"))))
(#t (empty-sosofo)))))
(element (CHAPTER)
(make-chap-or-app-toc-links))
(element (APPENDIX)
(make-chap-or-app-toc-links))
(element (SECT1)
(make sequence
(make empty-element
gi: "LI")
(let ((title-text (with-mode extract-title-text
(process-first-descendant "TITLE"))))
(if (id)
(make element
gi: "A"
attributes: (list (list "href" (string-append (link-file-name (current-node))
"#"
(id))))
title-text)
title-text))))
(default
(empty-sosofo)))
(define (make-chap-or-app-toc-links)
(make sequence
(make empty-element
gi: "LI")
(let ((title-text
(make sequence
(literal (if (equal? (gi) "CHAPTER")
(string-append "Chapter "
(format-number
(element-number (current-node))
"1")
" - ")
(string-append "Appendix "
(format-number
(element-number (current-node))
"A")
" - ")))
(with-mode extract-title-text
(process-first-descendant "TITLE")))))
(if (id)
(make element
gi: "A"
attributes: (list (list "href" (string-append (link-file-name (current-node))
"#"
(id))))
title-text)
title-text))
(make element
gi: "UL"
(with-mode make-toc-links
(process-matching-children "SECT1")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; make the unimplemented bits stand out
(default
(make element
gi: "FONT"
attributes: '(("color" "red"))
(make sequence
(literal (string-append "<" (gi) ">"))
(process-children)
(literal (string-append "" (gi) ">")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; standard subroutines
(define (node-list-reduce nl combine init)
(if (node-list-empty? nl)
init
(node-list-reduce (node-list-rest nl)
combine
(combine init (node-list-first nl)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; various homebrew subroutines
(define (book-node)
(cond ((equal? (gi) "BOOK") (current-node))
(#t (ancestor "BOOK"))))
(define (make-fat-rule)
(make empty-element
gi: "HR"
attributes: '(("size" "5"))))
(define (chap-app-head-label chap-or-app)
(let ((label
(attribute-string "label" (ancestor chap-or-app))))
(string-append
chap-or-app
" "
(if label
(if (equal? label "auto")
(format-number
(element-number (ancestor chap-or-app))
(if (equal? chap-or-app "Chapter") "1" "A"))
label)
(format-number
(element-number (ancestor chap-or-app))
(if (equal? chap-or-app "Chapter") "1" "A")))
". ")))
(define (make-anchor)
(if (id)
(make element
gi: "A"
attributes: (list (list "name" (id)))
(literal ""))
(empty-sosofo)))
(define (make-special-para)
(make sequence
(make empty-element
gi: "P")
(make element
gi: "B"
(literal (string-append (gi) ":")))
(make element
gi: "BLOCKQUOTE"
(process-children))))
(define (maybe-bold-children)
(cond ((equal? (attribute-string "role")
"bold")
(make element
gi: "B"
(process-children-trim)))
(#t (process-children-trim))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; the end