Subject: Re: DAVENPORT: explanation of indexing From: Mark Burton <markb@xxxxxxxxxx> Date: Fri, 24 Jul 1998 15:35:22 +0100 |
From: Norman Walsh <ndw@xxxxxxxxxx> Subject: Re: DAVENPORT: explanation of indexing Date: Fri, 24 Jul 1998 09:56:30 -0400 > Very few people actually build indexes in SGML because few systems are > tightly coupled with the backend. I have in mind putting together a > solution for the HTML case, though, if that helps at all... ;-) I enclose a very simple Docbook to HTML style sheet that does handle index entries. If any of it does what you want please snarf it. Regards, Mark
<!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN"> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; dbtohtml.dsl - DSSSL style sheet for DocBook to HTML conversion (jadeware) ; ; Author : Mark Burton (markb@xxxxxxxxxx) ; Created On : Fri Jun 13 18:21:14 1997 ; Last Modified By: Mark Burton ; Last Modified On: Fri Jul 24 15:35:18 1998 ; ; $Id: dbtohtml.dsl,v 1.12 1998/07/07 10:03:38 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@xxxxxxxxxx) ; Jason Molenda (crash@xxxxxxxxxxxx) ; Tony Graham (tgraham@xxxxxxxxxxxxxxxx) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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 <!-- <!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" [ <!ENTITY dbtohtml.dsl SYSTEM "dbtohtml.dsl" CDATA DSSSL > ]> <style-specification id="foodbtohtml" use="dbtohtml"> (define %output-basename% "foo") (define %output-directory% "foodir") </style-specification> <external-specification id="dbtohtml" document="dbtohtml.dsl"> --> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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 %shade-width% "100%") ; width or #f (define %email-element% "TT") ; font changing element or #f (define %lineannotation-color% "green") ; colour or #f (define %warning-color% "red") ; colour or #f (define %important-color% #f) ; colour or #f (define %caution-color% #f) ; colour or #f (define %tip-color% #f) ; colour or #f (define %note-color% #f) ; colour or #f (define %example-color% #f) ; colour or #f (define %centre-figures% #t) (define %default-graphic-format% "gif") (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" "ARTICLE" "CHAPTER" "APPENDIX" "BIBLIOGRAPHY" "GLOSSARY" "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)) '("BOOKINFO" "COPYRIGHT")))) (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 empty-element gi: "P") (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"))) (make empty-element gi: "P"))) (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 (make-pref-chap-app)) (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 BIBLIODIV (process-children)) (element GLOSSARY (make-pref-chap-app)) ; (element GLOSSDIV (make-pref-chap-app)) (element ARTHEADER (process-children)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; sections (element SECT1 (make sequence ; (if (ancestor "ARTICLE") (make-fat-rule) ; (empty-sosofo)) (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 (BIBLIODIV TITLE) (make element gi: "H2" (make sequence (process-children-trim)))) (element (GLOSSARY TITLE) (make element gi: "H1" (make sequence (literal "Glossary") ; (process-children-trim) ))) (element (GLOSSDIV TITLE) (make element gi: "H2" (process-children-trim))) (element (ARTHEADER TITLE) (make element gi: "CENTER" (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: "H4")) (element (SIDEBAR TITLE) (make element gi: "H2")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; font changers (element LINEANNOTATION (cond (%lineannotation-color% (make element gi: "FONT" attributes: (list (list "color" %lineannotation-color%)))) (#t (process-children-trim)))) (element EMPHASIS (make element gi: "I")) (element TYPE (make element gi: "B" (make element gi: "TT"))) (element REPLACEABLE (make element gi: "I" (make element gi: "B" (make element gi: "TT")))) (element TOKEN (process-children)) (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")) (element GUIBUTTON (make element gi: "I")) (element GUIMENU (make element gi: "I")) (element GUIMENUITEM (make element gi: "I")) (element GUILABEL (make element gi: "I")) (element COMMAND (make element gi: "TT")) (element OPTION (make element gi: "TT")) (element USERINPUT (make element gi: "TT")) (element COMPUTEROUTPUT (make element gi: "TT")) (element PROMPT (make element gi: "TT")) (element PRODUCTNAME (make element gi: "I")) (element SGMLTAG (make element gi: "TT")) (element FUNCTION (make element gi: "TT")) (element SYMBOL (make element gi: "TT")) (element LITERALLAYOUT (make element gi: "PRE")) (element FOREIGNPHRASE (make element gi: "I")) (element ABBREV (process-children-trim)) (element EMAIL (if %email-element% (make element gi: %email-element% (process-children-trim)) (process-children-trim))) (element QUOTE (make sequence (make entity-ref name: "quot") (process-children-trim) (make entity-ref name: "quot"))) (element ADDRESS (make element gi: "ADDRESS" (process-children-trim))) (element (ADDRESS CITY) (make sequence (make empty-element gi: "BR") (process-children-trim))) (element (ADDRESS COUNTRY) (make sequence (make empty-element gi: "BR") (process-children-trim))) (element (ADDRESS EMAIL) (make sequence (make empty-element gi: "BR") (if %email-element% (make element gi: %email-element% (process-children-trim)) (process-children-trim)))) (element (ADDRESS FAX) (make sequence (make empty-element gi: "BR") (process-children-trim))) (element (ADDRESS OTHERADDR) (make sequence (make empty-element gi: "BR") (process-children-trim))) (element (ADDRESS POB) (make sequence (make empty-element gi: "BR") (process-children-trim))) (element (ADDRESS PHONE) (make sequence (make empty-element gi: "BR") (process-children-trim))) (element (ADDRESS POSTCODE) (process-children-trim)) (element (ADDRESS STATE) (process-children-trim)) (element (ADDRESS STREET) (make sequence (make empty-element gi: "BR") (process-children-trim))) (element PROGRAMLISTING (make element gi: "PRE")) (element SECT2INFO (empty-sosofo)) (element SYNOPSIS (make element gi: "PRE")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; paragraph like things (element CAUTION (if %caution-color% (make-color-para %caution-color%) (make-special-para))) (element IMPORTANT (if %important-color% (make-color-para %important-color%) (make-special-para))) (element WARNING (if %warning-color% (make-color-para %warning-color%) (make-special-para))) (element NOTE (if %note-color% (make-color-para %note-color%) (make-special-para))) (element TIP (if %tip-color% (make-color-para %tip-color%) (make-special-para))) (element EXAMPLE (if %example-color% (make-color-para %example-color%) (make-special-para))) (element COMMENT (if %show-comments% (make-color-para "red") (empty-sosofo))) (element PARA (make sequence (make empty-element gi: "P") (make-anchor) (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: (append (list '("border" "0") '("bgcolor" "#E0E0E0")) (if %shade-width% (list (list "width" %shade-width%)) '())) (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))))) (element (CAUTION TITLE) (make element gi: "H5")) (element (IMPORTANT TITLE) (make element gi: "H5")) (element (WARNING TITLE) (make element gi: "H5")) (element (NOTE TITLE) (make element gi: "H5")) (element (TIP TITLE) (make element gi: "H5")) (element (EXAMPLE TITLE) (make element gi: "H5")) (element (BIBLIOENTRY TITLE) (make element gi: "H3")) (element (SIDEBAR) (make sequence (make empty-element gi: "P") (make element gi: "TABLE" attributes: '(("border" "1") ("bgcolor" "#f0f0f0") ("width" "100%")) (make element gi: "TR" (make element gi: "TD" (process-children)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; lists (element ITEMIZEDLIST (make sequence (make empty-element gi: "P") (make-anchor) (make element gi: "UL"))) (element ORDEREDLIST (make sequence (make empty-element gi: "P") (make-anchor) (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-anchor) (make element gi: "DL"))) (element VARLISTENTRY (process-children)) (element (VARLISTENTRY LISTITEM) (make sequence (make empty-element gi: "DD") (process-children) (make empty-element gi: "P"))) (element (VARLISTENTRY TERM) (make sequence (make empty-element gi: "DT") (make-anchor) (maybe-bold-children))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; glossary (element GLOSSDIV (make sequence (make empty-element gi: "P") (make element gi: "DL"))) (element (GLOSSENTRY GLOSSSEE) (make sequence (make empty-element gi: "DD") (literal "See ") (make element gi: "A" attributes: (list (list "href" (string-append "#" (if (string? (attribute-string "otherterm")) (attribute-string "otherterm") (gloss-entry-name (current-node)))))) (if (string? (attribute-string "otherterm")) (with-mode glosssee (process-element-with-id (attribute-string "OTHERTERM"))) (process-children-trim))) (make empty-element gi: "P"))) (define (gloss-entry-name glossterm) (string-append "gloss-" (data glossterm))) (element (GLOSSENTRY GLOSSTERM) (make sequence (make empty-element gi: "DT") (make empty-element gi: "A" attributes: (list (list "name" (if (string? (inherited-attribute-string "ID")) (inherited-attribute-string "ID") (gloss-entry-name (current-node)))))) (process-children))) (element GLOSSENTRY (process-children)) (element (GLOSSENTRY GLOSSDEF) (make sequence (make empty-element gi: "DD") (process-children) (make empty-element gi: "P"))) (element GLOSSSEEALSO (make sequence (if (first-sibling?) (make sequence (make empty-element gi: "P") (make element gi: "EM" (literal "See also "))) (make sequence (make element gi: "EM" (literal ", ")))) (make element gi: "a" attributes: (list (list "href" (string-append "#" (attribute-string "OTHERTERM")))) (with-mode glosssee (process-element-with-id (attribute-string "OTHERTERM")))))) ;; This is referenced within the GLOSSSEE and GLOSSSEEALSO element ;; construction expressions. The OTHERTERM attributes on GLOSSSEE and ;; GLOSSSEEALSO (should) refer to GLOSSENTRY elements but we're only ;; interested in the text within the GLOSSTERM. Discard the revision ;; history and the definition from the referenced term. (mode glosssee (element glossterm (process-children)) (element revhistory (empty-sosofo)) (element glossdef (empty-sosofo))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; index (define (index-entry-name indexterm) (string-append "index." (format-number (element-number indexterm) "1"))) (element INDEXTERM (make sequence (make-anchor) (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 (equal-ci? s1 s2) (let ((len1 (string-length s1)) (len2 (string-length s2))) (if (= len1 len2) (let loop ((i 0)) (if (= i len1) #t (let ((c1 (index-char-val (string-ref s1 i))) (c2 (index-char-val (string-ref s2 i)))) (if (= c1 c2) (loop (+ i 1)) #f)))) #f))) (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"))) ((equal? (gi target) "ARTICLE") (string-append "-" (format-number (child-number target) "1"))) ((ancestor-child-number "ARTICLE" target) (string-append "-" (format-number (ancestor-child-number "ARTICLE" target) "1"))) (#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 (let ((gubbins (make sequence (make empty-element gi: "P") (make-anchor) (process-children) (make empty-element gi: "P")))) (if %centre-figures% (make element gi: "CENTER" gubbins) gubbins))) (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" (string-append (attribute-string "fileref") "." (or (attribute-string "format") %default-graphic-format%)))))))) (if (equal? (attribute-string "align") "CENTER") (make element gi: "CENTER" img) img))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; tables (element INFORMALTABLE (make sequence (make empty-element gi: "P") (let ((tab (make element gi: "TABLE" attributes: (if (equal? (attribute-string "frame") "ALL") '(("border" "2") ("cellpadding" "2")) '()))) (roleattr (or (attribute-string "role") ""))) (if (or (equal-ci? roleattr "centre") (equal-ci? roleattr "center")) (make element gi: "CENTER" tab) tab)) (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)) "EDITOR") reducer (empty-sosofo)) (node-list-reduce (select-elements (descendants (current-node)) "CORPAUTHOR") reducer (empty-sosofo))))) (element (BIBLIOENTRY AUTHORGROUP) (let ((reducer (lambda (sofar new) (sosofo-append sofar (make element gi: "H3" (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)) "EDITOR") reducer (empty-sosofo)) (node-list-reduce (select-elements (descendants (current-node)) "CORPAUTHOR") reducer (empty-sosofo))))) (element (BOOKINFO DATE) (process-children-trim)) (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 EDITOR (process-children-trim)) (element CONFGROUP (process-children-trim)) (element CONFTITLE (make sequence (make empty-element gi: "BR") (make element gi: "I" (process-children)))) (element CONFDATES (make sequence (make empty-element gi: "BR") (process-children))) (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 RELEASEINFO (make sequence (make empty-element gi: "BR") (make element gi: "B"))) (element AFFILIATION (make sequence (make element gi: "I"))) (element ORGNAME (make sequence (make empty-element gi: "BR") (process-children))) (element JOBTITLE (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))) (element REVHISTORY (empty-sosofo)) (element LEGALNOTICE (make sequence (make element gi: "DIV" attributes: '(("align" "left"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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 (ARTICLE) (process-matching-children "SECT1")) (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-color-para color) (make element gi: "FONT" attributes: (list (list "color" color)) (make-special-para))) (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
Current Thread |
---|
|
<- Previous | Index | Next -> |
---|---|---|
Re: DAVENPORT: explanation of index, Matthias Clasen | Thread | Re: DAVENPORT: explanation of index, Chris Maden |
Re: Processing CDATA content with D, Sebastian Rahtz | Date | Re: DAVENPORT: explanation of index, Chris Maden |
Month |