|
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 |