mirror of
https://github.com/smarty-php/smarty.git
synced 2025-10-30 20:01:37 +01:00
1905 lines
67 KiB
Plaintext
Executable File
1905 lines
67 KiB
Plaintext
Executable File
;; $Id$
|
|
;;
|
|
;; This file is part of the Modular DocBook Stylesheet distribution.
|
|
;; See ../README or http://nwalsh.com/docbook/dsssl/
|
|
;;
|
|
;; This file contains general functions common to both print and HTML
|
|
;; versions of the DocBook stylesheets.
|
|
;;
|
|
|
|
;; If **ANY** change is made to this file, you _MUST_ alter the
|
|
;; following definition:
|
|
|
|
(define %docbook-common-version%
|
|
"Modular DocBook Stylesheet Common Functions")
|
|
|
|
;; === element lists ====================================================
|
|
|
|
;; these have to be functions because they have to be evaluated when
|
|
;; there is a current-node so that normalize can know what declaration
|
|
;; is in effect
|
|
|
|
(define (set-element-list)
|
|
(list (normalize "set")))
|
|
|
|
(define (book-element-list)
|
|
(list (normalize "book")))
|
|
|
|
(define (division-element-list)
|
|
(list (normalize "part")))
|
|
|
|
(define (component-element-list)
|
|
(list (normalize "preface")
|
|
(normalize "chapter")
|
|
(normalize "appendix")
|
|
(normalize "article")
|
|
(normalize "glossary")
|
|
(normalize "bibliography")
|
|
(normalize "index")
|
|
(normalize "colophon")
|
|
(normalize "setindex")
|
|
(normalize "reference")
|
|
(normalize "refentry")
|
|
(normalize "book"))) ;; just in case nothing else matches...
|
|
|
|
(define (major-component-element-list)
|
|
(list (normalize "preface")
|
|
(normalize "chapter")
|
|
(normalize "appendix")
|
|
(normalize "article")
|
|
(normalize "glossary")
|
|
(normalize "bibliography")
|
|
(normalize "index")
|
|
(normalize "colophon")
|
|
(normalize "setindex")
|
|
(normalize "reference")
|
|
(normalize "refentry")
|
|
(normalize "part")
|
|
(normalize "book"))) ;; just in case nothing else matches...
|
|
|
|
(define (section-element-list)
|
|
(list (normalize "sect1")
|
|
(normalize "sect2")
|
|
(normalize "sect3")
|
|
(normalize "sect4")
|
|
(normalize "sect5")
|
|
(normalize "section")
|
|
(normalize "simplesect")
|
|
(normalize "refsect1")
|
|
(normalize "refsect2")
|
|
(normalize "refsect3")))
|
|
|
|
(define (block-element-list)
|
|
(list (normalize "example")
|
|
(normalize "figure")
|
|
(normalize "table")
|
|
(normalize "equation")
|
|
(normalize "procedure")))
|
|
|
|
(define (outer-parent-list)
|
|
(list (normalize "toc")
|
|
(normalize "lot")
|
|
(normalize "appendix")
|
|
(normalize "chapter")
|
|
(normalize "part")
|
|
(normalize "preface")
|
|
(normalize "reference")
|
|
(normalize "bibliography")
|
|
(normalize "glossary")
|
|
(normalize "index")
|
|
(normalize "setindex")
|
|
(normalize "sect1")
|
|
(normalize "sect2")
|
|
(normalize "sect3")
|
|
(normalize "sect4")
|
|
(normalize "sect5")
|
|
(normalize "simplesect")
|
|
(normalize "partintro")
|
|
(normalize "bibliodiv")
|
|
(normalize "glossdiv")
|
|
(normalize "indexdiv")
|
|
(normalize "refentry")
|
|
(normalize "refsect1")
|
|
(normalize "refsect2")
|
|
(normalize "refsect3")
|
|
(normalize "msgtext")
|
|
(normalize "msgexplan")))
|
|
|
|
(define (list-element-list)
|
|
(list (normalize "orderedlist")
|
|
(normalize "itemizedlist")
|
|
(normalize "variablelist")
|
|
(normalize "segmentedlist")
|
|
(normalize "simplelist")
|
|
(normalize "calloutlist")
|
|
(normalize "step")))
|
|
|
|
(define (info-element-list)
|
|
(list (normalize "appendixinfo")
|
|
(normalize "articleinfo")
|
|
(normalize "bibliographyinfo")
|
|
(normalize "bookinfo")
|
|
(normalize "chapterinfo")
|
|
(normalize "glossaryinfo")
|
|
(normalize "indexinfo")
|
|
(normalize "objectinfo")
|
|
(normalize "partinfo")
|
|
(normalize "prefaceinfo")
|
|
(normalize "refentryinfo")
|
|
(normalize "referenceinfo")
|
|
(normalize "refsect1info")
|
|
(normalize "refsect2info")
|
|
(normalize "refsect3info")
|
|
(normalize "refsynopsisdivinfo")
|
|
(normalize "sect1info")
|
|
(normalize "sect2info")
|
|
(normalize "sect3info")
|
|
(normalize "sect4info")
|
|
(normalize "sect5info")
|
|
(normalize "sectioninfo")
|
|
(normalize "setindexinfo")
|
|
(normalize "setinfo")
|
|
(normalize "sidebarinfo")
|
|
;; historical
|
|
(normalize "artheader")
|
|
(normalize "docinfo")))
|
|
|
|
;; === automatic TOC ====================================================
|
|
|
|
;; Returns #t if nd should appear in the auto TOC
|
|
(define (appears-in-auto-toc? nd)
|
|
(if (or (equal? (gi nd) (normalize "refsect1"))
|
|
(have-ancestor? (normalize "refsect1") nd))
|
|
#f
|
|
#t))
|
|
|
|
;; # return elements of nl for which appears-in-auto-toc? is #t
|
|
(define (toc-list-filter nodelist)
|
|
(let loop ((toclist (empty-node-list)) (nl nodelist))
|
|
(if (node-list-empty? nl)
|
|
toclist
|
|
(if (appears-in-auto-toc? (node-list-first nl))
|
|
(loop (node-list toclist (node-list-first nl))
|
|
(node-list-rest nl))
|
|
(loop toclist (node-list-rest nl))))))
|
|
|
|
;; === common ===========================================================
|
|
|
|
(define (INLIST?)
|
|
(has-ancestor-member? (current-node) (list-element-list)))
|
|
|
|
(define (INBLOCK?)
|
|
(has-ancestor-member? (current-node)
|
|
(list (normalize "example")
|
|
(normalize "informalexample")
|
|
(normalize "figure")
|
|
(normalize "informalfigure")
|
|
(normalize "equation")
|
|
(normalize "informalequation")
|
|
(normalize "funcsynopsis")
|
|
(normalize "programlistingco")
|
|
(normalize "screenco")
|
|
(normalize "graphicco"))))
|
|
|
|
(define (PARNUM)
|
|
(child-number (parent (current-node))))
|
|
|
|
(define (NESTEDFNUM n fmt)
|
|
(if (number? n)
|
|
(format-number n fmt)
|
|
#f))
|
|
|
|
(define (FNUM n) (NESTEDFNUM n "1"))
|
|
|
|
(define (book-start?)
|
|
;; Returns #t if the current-node is in the first division or
|
|
;; component of a book.
|
|
(let ((book (ancestor (normalize "book")))
|
|
(nd (ancestor-member
|
|
(current-node)
|
|
(append (component-element-list) (division-element-list)))))
|
|
(let loop ((ch (children book)))
|
|
(if (node-list-empty? ch)
|
|
#f
|
|
(if (member (gi (node-list-first ch))
|
|
(append (component-element-list) (division-element-list)))
|
|
(node-list=? (node-list-first ch) nd)
|
|
(loop (node-list-rest ch)))))))
|
|
|
|
(define (first-chapter?)
|
|
;; Returns #t if the current-node is in the first chapter of a book
|
|
(let* ((book (ancestor (normalize "book")))
|
|
(nd (ancestor-member
|
|
(current-node)
|
|
(append (component-element-list) (division-element-list))))
|
|
(bookch (children book))
|
|
(bookcomp (expand-children bookch (list (normalize "part")))))
|
|
(let loop ((nl bookcomp))
|
|
(if (node-list-empty? nl)
|
|
#f
|
|
(if (equal? (gi (node-list-first nl)) (normalize "chapter"))
|
|
(if (node-list=? (node-list-first nl) nd)
|
|
#t
|
|
#f)
|
|
(loop (node-list-rest nl)))))))
|
|
|
|
;; === bibliographic ====================================================
|
|
|
|
;; Localized author-string
|
|
|
|
(define (author-list-string #!optional (author (current-node)))
|
|
;; Return a formatted string representation of the contents of AUTHOR
|
|
;; *including appropriate punctuation* if the AUTHOR occurs in a list
|
|
;; of AUTHORs in an AUTHORGROUP:
|
|
;;
|
|
;; John Doe
|
|
;; or
|
|
;; John Doe and Jane Doe
|
|
;; or
|
|
;; John Doe, Jane Doe, and A. Nonymous
|
|
;;
|
|
|
|
(let* ((author-node-list (select-elements
|
|
(descendants
|
|
(ancestor (normalize "authorgroup") author))
|
|
(normalize "author")))
|
|
(corpauthor-node-list (select-elements
|
|
(descendants
|
|
(ancestor (normalize "authorgroup") author))
|
|
(normalize "corpauthor")))
|
|
(othercredit-node-list (select-elements
|
|
(descendants
|
|
(ancestor (normalize "authorgroup") author))
|
|
(normalize "othercredit")))
|
|
(editor-node-list (select-elements
|
|
(descendants
|
|
(ancestor (normalize "authorgroup")))
|
|
(normalize "editor")))
|
|
(author-count (if (have-ancestor? (normalize "authorgroup") author)
|
|
(+ (node-list-length author-node-list)
|
|
(node-list-length corpauthor-node-list)
|
|
(node-list-length othercredit-node-list)
|
|
(node-list-length editor-node-list))
|
|
1))
|
|
(this-count (if (have-ancestor? (normalize "authorgroup") author)
|
|
(+ (node-list-length (preced author)) 1)
|
|
1)))
|
|
(string-append
|
|
(if (and (> author-count 1)
|
|
(last-sibling? author))
|
|
(string-append (gentext-and) " ")
|
|
"")
|
|
|
|
(author-string author)
|
|
|
|
(if (> author-count 2)
|
|
(if (> (- author-count this-count) 1)
|
|
(gentext-listcomma)
|
|
(if (= (- author-count this-count) 1)
|
|
(gentext-lastlistcomma)
|
|
""))
|
|
"")
|
|
(if (and (> author-count 1)
|
|
(not (last-sibling? author)))
|
|
" "
|
|
""))))
|
|
|
|
;; === procedures =======================================================
|
|
|
|
(define ($proc-hierarch-number-format$ depth)
|
|
(case (modulo depth 5)
|
|
((1) "1")
|
|
((2) "a")
|
|
((3) "i")
|
|
((4) "A")
|
|
(else "I")))
|
|
|
|
(define ($proc-hierarch-number$ nd seperator)
|
|
(if (equal? (gi nd) (normalize "step"))
|
|
(string-append
|
|
(format-number
|
|
(child-number nd)
|
|
($proc-hierarch-number-format$ ($proc-step-depth$ nd)))
|
|
seperator)
|
|
""))
|
|
|
|
(define ($proc-step-depth$ nd)
|
|
(let loop ((step nd) (depth 0))
|
|
(if (equal? (gi step) (normalize "procedure"))
|
|
depth
|
|
(loop (parent step)
|
|
(if (equal? (gi step) (normalize "step"))
|
|
(+ depth 1)
|
|
depth)))))
|
|
|
|
(define ($proc-step-number$ nd)
|
|
(let* ((step (if (equal? (gi nd) (normalize "step")) nd (parent nd)))
|
|
(str ($proc-hierarch-number$ step "")))
|
|
(string-append str (gentext-label-title-sep (normalize "step")))))
|
|
|
|
(define ($proc-step-xref-number$ nd)
|
|
(let loop ((step nd) (str "") (first #t))
|
|
(if (equal? (gi step) (normalize "procedure"))
|
|
str
|
|
(loop (parent step)
|
|
(if (equal? (gi step) (normalize "step"))
|
|
(string-append
|
|
($proc-hierarch-number$ step
|
|
(if first
|
|
""
|
|
(gentext-intra-label-sep (normalize "step"))))
|
|
str)
|
|
str)
|
|
(if (equal? (gi step) (normalize "step"))
|
|
#f
|
|
first)))))
|
|
|
|
;; === sections =========================================================
|
|
|
|
(define (section-level-by-gi chunked? gi)
|
|
;; Figure out the heading level of an element by its name. We need
|
|
;; to distinguish between the chunked processing mode (for HTML) and
|
|
;; the non-chunked (print or HTML). It is important that no heading
|
|
;; level is skipped in a document structure (e.g., sect1 = 2, sect2
|
|
;; = 4); this results in broken PDF bookmarks.
|
|
(if chunked?
|
|
(cond
|
|
((equal? gi (normalize "sect5")) 5)
|
|
((equal? gi (normalize "sect4")) 4)
|
|
((equal? gi (normalize "sect3")) 3)
|
|
((equal? gi (normalize "sect2")) 2)
|
|
((equal? gi (normalize "sect1")) 1)
|
|
((equal? gi (normalize "refsect3")) 4)
|
|
((equal? gi (normalize "refsect2")) 3)
|
|
((equal? gi (normalize "refsect1")) 2)
|
|
((equal? gi (normalize "refsynopsisdiv")) 2)
|
|
((equal? gi (normalize "bibliography")) 1)
|
|
((equal? gi (normalize "bibliodiv")) 2)
|
|
((equal? gi (normalize "index")) 1)
|
|
((equal? gi (normalize "setindex")) 1)
|
|
((equal? gi (normalize "indexdiv")) 2)
|
|
(else 1))
|
|
(cond
|
|
((equal? gi (normalize "sect5")) 6)
|
|
((equal? gi (normalize "sect4")) 5)
|
|
((equal? gi (normalize "sect3")) 4)
|
|
((equal? gi (normalize "sect2")) 3)
|
|
((equal? gi (normalize "sect1")) 2)
|
|
;; The next four are not used by the HTML stylesheets.
|
|
((equal? gi (normalize "refsect3")) 5)
|
|
((equal? gi (normalize "refsect2")) 4)
|
|
((equal? gi (normalize "refsect1")) 3)
|
|
((equal? gi (normalize "refsynopsisdiv")) 3)
|
|
((equal? gi (normalize "bibliography")) 1)
|
|
((equal? gi (normalize "bibliodiv")) 2)
|
|
((equal? gi (normalize "index")) 1)
|
|
((equal? gi (normalize "setindex")) 1)
|
|
((equal? gi (normalize "indexdiv")) 2)
|
|
(else 1))))
|
|
|
|
(define (section-level-by-node chunked? sect)
|
|
(if (equal? (gi sect) (normalize "section"))
|
|
;; Section is special, it is recursive.
|
|
(let ((depth (length (hierarchical-number-recursive
|
|
(normalize "section")))))
|
|
(if (> depth 5)
|
|
6
|
|
(+ depth 1)))
|
|
(if (equal? (gi sect) (normalize "simplesect"))
|
|
;; SimpleSect is special, it should be level "n+1", where "n" is
|
|
;; the level of the numbered section that contains it. If it is
|
|
;; the *first* sectioning element in a chapter, make it
|
|
;; %default-simplesect-level%
|
|
(cond
|
|
((have-ancestor? (normalize "sect5"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "sect5"))))
|
|
((have-ancestor? (normalize "sect4"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "sect4"))))
|
|
((have-ancestor? (normalize "sect3"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "sect3"))))
|
|
((have-ancestor? (normalize "sect2"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "sect2"))))
|
|
((have-ancestor? (normalize "sect1"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "sect1"))))
|
|
((have-ancestor? (normalize "refsect3"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "refsect3"))))
|
|
((have-ancestor? (normalize "refsect2"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "refsect2"))))
|
|
((have-ancestor? (normalize "refsect1"))
|
|
(+ 1 (section-level-by-gi chunked? (normalize "refsect1"))))
|
|
(else %default-simplesect-level%))
|
|
;; the rest of the section elements can be identified by name
|
|
(section-level-by-gi chunked? (gi sect)))))
|
|
|
|
;; === synopsis =========================================================
|
|
|
|
;; The following definitions match those given in the reference
|
|
;; documentation for DocBook V3.0
|
|
(define %arg-choice-opt-open-str% "[")
|
|
(define %arg-choice-opt-close-str% "]")
|
|
(define %arg-choice-req-open-str% "{")
|
|
(define %arg-choice-req-close-str% "}")
|
|
(define %arg-choice-plain-open-str% " ")
|
|
(define %arg-choice-plain-close-str% " ")
|
|
(define %arg-choice-def-open-str% "[")
|
|
(define %arg-choice-def-close-str% "]")
|
|
(define %arg-rep-repeat-str% "...")
|
|
(define %arg-rep-norepeat-str% "")
|
|
(define %arg-rep-def-str% "")
|
|
(define %arg-or-sep% " | ")
|
|
(define %cmdsynopsis-hanging-indent% 4pi)
|
|
|
|
;; === linking ==========================================================
|
|
|
|
;; From the DocBook V3.0 Reference entry for element XREF:
|
|
;;
|
|
;; Description
|
|
;;
|
|
;; Cross reference link to another part of the document. XRef is empty,
|
|
;; and has common, Linkend, and Endterm attributes.
|
|
;;
|
|
;; Processing Expectations
|
|
;;
|
|
;; XRef must have a Linkend, but the Endterm is optional. If it is used,
|
|
;; the content of the element it points to is displayed as the text of
|
|
;; the cross reference; if it is absent, the XRefLabel of the
|
|
;; cross-referenced object is displayed.
|
|
;;
|
|
;; If neither the ENDTERM nor the XREFLABEL is present, then the cross
|
|
;; reference text is taken from the (gentext-xref-strings) function
|
|
;; in the localization file, like this
|
|
;;
|
|
;; A cross reference to an element, the target, begins with the
|
|
;; text returned by (gentext-xref-strings (gi target)). Within
|
|
;; that text, the following substitutions are made:
|
|
;;
|
|
;; %p is replaced by the number of the page on which target occurs
|
|
;; %g is replaced by the (gentext-element-name)
|
|
;; %n is replaced by the label
|
|
;; %t is replaced by the title
|
|
;;
|
|
;; After the "direct" cross reference, a number of indirect references
|
|
;; are possible. If the target element is in a different block, section,
|
|
;; component, division, or book an indirect cross reference may be made.
|
|
;;
|
|
;; The indirect cross reference will only be made if
|
|
;;
|
|
;; (auto-xref-indirect? target ancestor)
|
|
;;
|
|
;; returns #t. The indirect reference is created by appending the
|
|
;; connect returned by (auto-xref-indirect-connector) to the direct
|
|
;; reference and then adding a direct refernce to the ancestor.
|
|
;; The process is repeated for each ancestral element.
|
|
;;
|
|
;; For example, if a direct reference to a section returns
|
|
;;
|
|
;; "the section called %t"
|
|
;;
|
|
;; and a direct reference to a chapter returns
|
|
;;
|
|
;; "Chapter %n"
|
|
;;
|
|
;; and (auto-xref-indirect? sect1 chapter) returns #t, and
|
|
;; (auto-xref-indirect-connector chapter) returns "in", then
|
|
;; an xref to a section in another chapter will be:
|
|
;;
|
|
;; "the section called %t in Chapter %n"
|
|
;;
|
|
;; Where %t and %n will be filled in accordingly.
|
|
;;
|
|
;; ======================================================================
|
|
|
|
(define (auto-xref-indirect? target ancestor)
|
|
;; This function answers the question: should an indirect reference
|
|
;; to ancestor be made for target? For example:
|
|
;;
|
|
;; (auto-xref-indirect? SECT1 CHAP)
|
|
;;
|
|
;; should return #t iff a reference of the form "in [CHAP-xref]" should
|
|
;; be generated for a reference to SECT1 if SECT1 is in a different
|
|
;; chapter than the XREF to SECT1.
|
|
;;
|
|
;; This function _does not_ have to consider the case of whether or
|
|
;; not target and the xref are in the same ancestor.
|
|
;;
|
|
(cond
|
|
;; Always add indirect references to another book
|
|
((member (gi ancestor) (book-element-list))
|
|
#t)
|
|
;; Add indirect references to the section or component a block
|
|
;; is in iff chapters aren't autolabelled. (Otherwise "Figure 1-3"
|
|
;; is sufficient)
|
|
((and (member (gi target) (block-element-list))
|
|
(not %chapter-autolabel%))
|
|
#t)
|
|
;; Add indirect references to the component a section is in if
|
|
;; the sections are not autolabelled
|
|
((and (member (gi target) (section-element-list))
|
|
(member (gi ancestor) (component-element-list))
|
|
(not %section-autolabel%))
|
|
#t)
|
|
(else #f)))
|
|
|
|
(define (auto-xref-direct target
|
|
#!optional
|
|
(xref-string (gentext-xref-strings target)))
|
|
(let* ((substitute (list
|
|
(list "%g" (element-gi-sosofo target))
|
|
(list "%n" (element-label-sosofo target))
|
|
(list "%p" (element-page-number-sosofo target))
|
|
(list "%t" (element-title-xref-sosofo target))))
|
|
(tlist (match-split-list xref-string (assoc-objs substitute))))
|
|
(string-list-sosofo tlist substitute)))
|
|
|
|
(define (auto-xref-indirect target
|
|
#!optional
|
|
(xref-string (gentext-xref-strings target)))
|
|
(make sequence
|
|
(auto-xref-indirect-connector target)
|
|
(auto-xref-direct target xref-string)))
|
|
|
|
(define (auto-xref target
|
|
#!optional (xref-string (gentext-xref-strings target)))
|
|
(let ((source (current-node))
|
|
(cont-blok (ancestor-member target (block-element-list)))
|
|
(cont-sect (ancestor-member target (section-element-list)))
|
|
(cont-comp (ancestor-member target (component-element-list)))
|
|
(cont-divn (ancestor-member target (division-element-list)))
|
|
(cont-book (ancestor-member target (book-element-list))))
|
|
(make sequence
|
|
(auto-xref-direct target xref-string)
|
|
(if (or (node-list=? cont-blok
|
|
(ancestor-member source (block-element-list)))
|
|
(node-list=? cont-blok target)
|
|
(not (auto-xref-indirect? target cont-blok)))
|
|
(empty-sosofo)
|
|
(auto-xref-indirect cont-blok))
|
|
(if (or (node-list=? cont-sect
|
|
(ancestor-member source (section-element-list)))
|
|
(node-list=? cont-sect target)
|
|
(not (auto-xref-indirect? target cont-sect)))
|
|
(empty-sosofo)
|
|
(auto-xref-indirect cont-sect))
|
|
(if (or (node-list=? cont-comp
|
|
(ancestor-member source (component-element-list)))
|
|
(node-list=? cont-comp target)
|
|
(not (auto-xref-indirect? target cont-comp)))
|
|
(empty-sosofo)
|
|
(auto-xref-indirect cont-comp))
|
|
(if (or (node-list=? cont-divn
|
|
(ancestor-member source (division-element-list)))
|
|
(node-list=? cont-divn target)
|
|
(not (auto-xref-indirect? target cont-divn)))
|
|
(empty-sosofo)
|
|
(auto-xref-indirect cont-divn))
|
|
(if (or (node-list=? cont-book
|
|
(ancestor-member source (book-element-list)))
|
|
(node-list=? cont-book target)
|
|
(not (auto-xref-indirect? target cont-book)))
|
|
(empty-sosofo)
|
|
(auto-xref-indirect cont-book)))))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (set-number-restart-list cmp) (list (normalize "set")))
|
|
(define (book-number-restart-list cmp) (list (normalize "set")))
|
|
(define (part-number-restart-list cmp) (list (normalize "book")))
|
|
(define (reference-number-restart-list cmp) (list (normalize "book")))
|
|
(define (preface-number-restart-list cmp) (list (normalize "book")))
|
|
(define (chapter-number-restart-list cmp) (list (normalize "book")))
|
|
(define (appendix-number-restart-list cmp) (list (normalize "book")
|
|
(normalize "article")))
|
|
(define (article-number-restart-list cmp) (list (normalize "book")))
|
|
(define (glossary-number-restart-list cmp) (list (normalize "book")))
|
|
(define (bibliography-number-restart-list cmp) (list (normalize "book")))
|
|
(define (index-number-restart-list cmp) (list (normalize "book")))
|
|
(define (setindex-number-restart-list cmp) (list (normalize "set")))
|
|
(define (refentry-number-restart-list cmp) (list (normalize "reference")))
|
|
(define (default-number-restart-list cmp) (list (normalize "book")))
|
|
|
|
(define (component-number-restart-list cmp)
|
|
;; Return the list of elements at which numbering of 'cmp' should reset.
|
|
;; For example, for CHAPTER, it might return '("BOOK") causing chapters
|
|
;; to be sequentially numbered across a book. If it returned
|
|
;; '("BOOK" "PART") then chapter numbering would restart at each
|
|
;; BOOK or PART.
|
|
(let ((name (gi cmp)))
|
|
(cond
|
|
((equal? name (normalize "set")) (set-number-restart-list cmp))
|
|
((equal? name (normalize "book")) (book-number-restart-list cmp))
|
|
((equal? name (normalize "part")) (part-number-restart-list cmp))
|
|
((equal? name (normalize "reference")) (reference-number-restart-list cmp))
|
|
((equal? name (normalize "preface")) (preface-number-restart-list cmp))
|
|
((equal? name (normalize "chapter")) (chapter-number-restart-list cmp))
|
|
((equal? name (normalize "appendix")) (appendix-number-restart-list cmp))
|
|
((equal? name (normalize "article")) (article-number-restart-list cmp))
|
|
((equal? name (normalize "glossary")) (glossary-number-restart-list cmp))
|
|
((equal? name (normalize "bibliography")) (bibliography-number-restart-list cmp))
|
|
((equal? name (normalize "index")) (index-number-restart-list cmp))
|
|
((equal? name (normalize "setindex")) (setindex-number-restart-list cmp))
|
|
((equal? name (normalize "refentry")) (refentry-number-restart-list cmp))
|
|
(else (default-number-restart-list cmp)))))
|
|
|
|
(define (set-number-ignore-list cmp) '())
|
|
(define (book-number-ignore-list cmp) '())
|
|
(define (part-number-ignore-list cmp) '())
|
|
(define (reference-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (preface-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (chapter-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (appendix-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (article-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (glossary-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (bibliography-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (index-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (setindex-number-ignore-list cmp) (list (normalize "part")))
|
|
(define (refentry-number-ignore-list cmp) '())
|
|
(define (default-number-ignore-list cmp) '())
|
|
|
|
(define (component-number-ignore-list cmp)
|
|
;; Return the list of elements (inside the restart list) which are
|
|
;; hierarchy levels which should be ignored. For example, for CHAPTER,
|
|
;; it might return '("PART") causing chapter numbering inside books
|
|
;; to ignore parts.
|
|
;;
|
|
;; Basically, if you skip up past a component/division element in
|
|
;; the restart list, you better put the element(s) you skipped in
|
|
;; the ignore list or the stylesheet may never see your component
|
|
;; when it's trying to do the numbering.
|
|
(let ((name (gi cmp)))
|
|
(cond
|
|
((equal? name (normalize "set")) (set-number-ignore-list cmp))
|
|
((equal? name (normalize "book")) (book-number-ignore-list cmp))
|
|
((equal? name (normalize "part")) (part-number-ignore-list cmp))
|
|
((equal? name (normalize "reference")) (reference-number-ignore-list cmp))
|
|
((equal? name (normalize "preface")) (preface-number-ignore-list cmp))
|
|
((equal? name (normalize "chapter")) (chapter-number-ignore-list cmp))
|
|
((equal? name (normalize "appendix")) (appendix-number-ignore-list cmp))
|
|
((equal? name (normalize "article")) (article-number-ignore-list cmp))
|
|
((equal? name (normalize "glossary")) (glossary-number-ignore-list cmp))
|
|
((equal? name (normalize "bibliography")) (bibliography-number-ignore-list cmp))
|
|
((equal? name (normalize "index")) (index-number-ignore-list cmp))
|
|
((equal? name (normalize "setindex")) (setindex-number-ignore-list cmp))
|
|
((equal? name (normalize "refentry")) (refentry-number-ignore-list cmp))
|
|
(else (default-number-ignore-list cmp)))))
|
|
|
|
(define (set-number-sibling-list cmp) '())
|
|
(define (book-number-sibling-list cmp) '())
|
|
(define (part-number-sibling-list cmp) '())
|
|
(define (reference-number-sibling-list cmp) '())
|
|
(define (preface-number-sibling-list cmp) '())
|
|
(define (chapter-number-sibling-list cmp) '())
|
|
(define (appendix-number-sibling-list cmp) '())
|
|
(define (article-number-sibling-list cmp) '())
|
|
(define (glossary-number-sibling-list cmp) '())
|
|
(define (bibliography-number-sibling-list cmp) '())
|
|
(define (index-number-sibling-list cmp) '())
|
|
(define (setindex-number-sibling-list cmp) '())
|
|
(define (refentry-number-sibling-list cmp) '())
|
|
(define (default-number-sibling-list cmp) '())
|
|
|
|
(define (component-number-sibling-list cmp)
|
|
;; Return the list of elements with which 'cmp' should be numbered.
|
|
;; For example, for PART it might return '("PART" "REFERENCE") causing
|
|
;; sibling parts and references to be numbered together.
|
|
(let ((name (gi cmp)))
|
|
(cond
|
|
((equal? name (normalize "set")) (set-number-sibling-list cmp))
|
|
((equal? name (normalize "book")) (book-number-sibling-list cmp))
|
|
((equal? name (normalize "part")) (part-number-sibling-list cmp))
|
|
((equal? name (normalize "reference")) (reference-number-sibling-list cmp))
|
|
((equal? name (normalize "preface")) (preface-number-sibling-list cmp))
|
|
((equal? name (normalize "chapter")) (chapter-number-sibling-list cmp))
|
|
((equal? name (normalize "appendix")) (appendix-number-sibling-list cmp))
|
|
((equal? name (normalize "article")) (article-number-sibling-list cmp))
|
|
((equal? name (normalize "glossary")) (glossary-number-sibling-list cmp))
|
|
((equal? name (normalize "bibliography")) (bibliography-number-sibling-list cmp))
|
|
((equal? name (normalize "index")) (index-number-sibling-list cmp))
|
|
((equal? name (normalize "setindex")) (setindex-number-sibling-list cmp))
|
|
((equal? name (normalize "refentry")) (refentry-number-sibling-list cmp))
|
|
(else (default-number-sibling-list cmp)))))
|
|
|
|
(define (component-number component-node)
|
|
(let* ((root (ancestor-member component-node
|
|
(component-number-restart-list
|
|
component-node)))
|
|
(clist (expand-children (children root)
|
|
(component-number-ignore-list
|
|
component-node)))
|
|
(slist (append (list (gi component-node))
|
|
(component-number-sibling-list component-node))))
|
|
(let loop ((nl clist) (count 1))
|
|
(if (node-list-empty? nl)
|
|
1
|
|
(if (node-list=? (node-list-first nl) component-node)
|
|
count
|
|
(if (member (gi (node-list-first nl)) slist)
|
|
(loop (node-list-rest nl) (+ count 1))
|
|
(loop (node-list-rest nl) count)))))))
|
|
|
|
;; == components and divisions ==
|
|
|
|
(define (set-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (book-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (part-autolabel nd #!optional (force-label? #f))
|
|
(format-number (component-number nd) (label-number-format nd)))
|
|
|
|
(define (reference-autolabel nd #!optional (force-label? #f))
|
|
(format-number (component-number nd) (label-number-format nd)))
|
|
|
|
(define (preface-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (chapter-autolabel nd #!optional (force-label? #f))
|
|
(if (or force-label? %chapter-autolabel%)
|
|
(format-number (component-number nd) (label-number-format nd))
|
|
""))
|
|
|
|
(define (appendix-autolabel nd #!optional (force-label? #f))
|
|
;; Abandoned special processing for appendixes in articles. Maybe
|
|
;; it's a good idea, but it can't be done here because it screws
|
|
;; up cross references to appendixes.
|
|
(if (or force-label? %chapter-autolabel%)
|
|
(format-number (component-number nd) (label-number-format nd))
|
|
""))
|
|
|
|
(define (article-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (glossary-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (bibliography-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (index-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (indexdiv-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (colophon-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (setindex-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (refentry-autolabel nd #!optional (force-label? #f))
|
|
(let* ((isep (gentext-intra-label-sep nd))
|
|
(refnamediv (select-elements (children nd)
|
|
(normalize "refnamediv")))
|
|
(refd (select-elements (children refnamediv)
|
|
(normalize "refdescriptor")))
|
|
(refnames (select-elements (children refnamediv)
|
|
(normalize "refname"))))
|
|
""))
|
|
|
|
;; == /components and divisions ==
|
|
|
|
(define (dedication-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (bibliodiv-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (glossdiv-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (section-autolabel-prefix nd)
|
|
(let* ((isep (gentext-intra-label-sep nd))
|
|
(haschn (not (node-list-empty? (ancestor (normalize "chapter") nd))))
|
|
(hasapn (not (node-list-empty? (ancestor (normalize "appendix") nd)))))
|
|
(cond
|
|
(haschn (string-append
|
|
(element-label (ancestor (normalize "chapter") nd)) isep))
|
|
(hasapn (string-append
|
|
(element-label (ancestor (normalize "appendix") nd)) isep))
|
|
(else ""))))
|
|
|
|
(define (section-autolabel nd #!optional (force-label? #f))
|
|
(let* ((isep (gentext-intra-label-sep nd))
|
|
(hasprf (not (node-list-empty? (ancestor (normalize "preface") nd))))
|
|
(prefix (section-autolabel-prefix nd)))
|
|
(if (and (or force-label? %section-autolabel%)
|
|
(or %label-preface-sections%
|
|
(not hasprf)))
|
|
(cond
|
|
((equal? (gi nd) (normalize "sect1"))
|
|
(string-append prefix (format-number (child-number nd)
|
|
(label-number-format nd))))
|
|
((equal? (gi nd) (normalize "sect2"))
|
|
(string-append
|
|
(element-label (ancestor (normalize "sect1") nd) force-label?)
|
|
isep
|
|
(format-number (child-number nd) (label-number-format nd))))
|
|
((equal? (gi nd) (normalize "sect3"))
|
|
(string-append
|
|
(element-label (ancestor (normalize "sect2") nd) force-label?)
|
|
isep
|
|
(format-number (child-number nd) (label-number-format nd))))
|
|
((equal? (gi nd) (normalize "sect4"))
|
|
(string-append
|
|
(element-label (ancestor (normalize "sect3") nd) force-label?)
|
|
isep
|
|
(format-number (child-number nd) (label-number-format nd))))
|
|
((equal? (gi nd) (normalize "sect5"))
|
|
(string-append
|
|
(element-label (ancestor (normalize "sect4") nd) force-label?)
|
|
isep
|
|
(format-number (child-number nd) (label-number-format nd))))
|
|
|
|
((equal? (gi nd) (normalize "simplesect"))
|
|
(let* ((possible-sect-ancestors
|
|
(node-list (ancestor (normalize "section") nd)
|
|
(ancestor (normalize "sect5") nd)
|
|
(ancestor (normalize "sect4") nd)
|
|
(ancestor (normalize "sect3") nd)
|
|
(ancestor (normalize "sect2") nd)
|
|
(ancestor (normalize "sect1") nd)))
|
|
(section-ancestor (node-list-first possible-sect-ancestors)))
|
|
(if (node-list-empty? section-ancestor)
|
|
(string-append prefix (format-number (child-number nd)
|
|
(label-number-format nd)))
|
|
(string-append
|
|
(element-label section-ancestor force-label?)
|
|
isep
|
|
(format-number (child-number nd) (label-number-format nd))))))
|
|
|
|
((equal? (gi nd) (normalize "section"))
|
|
(if (node-list-empty? (ancestor (normalize "section") nd))
|
|
(string-append prefix (format-number (child-number nd)
|
|
(label-number-format nd)))
|
|
(string-append
|
|
(element-label (ancestor (normalize "section") nd) force-label?)
|
|
isep
|
|
(format-number (child-number nd) (label-number-format nd)))))
|
|
(else (string-append (gi nd) " IS NOT A SECTION!")))
|
|
"")))
|
|
|
|
(define (refsection-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (step-autolabel nd #!optional (force-label? #f))
|
|
($proc-step-xref-number$ nd))
|
|
|
|
(define (listitem-autolabel nd #!optional (force-label? #f))
|
|
(if (equal? (gi (parent nd)) (normalize "orderedlist"))
|
|
(number->string (child-number nd))
|
|
"[xref to LISTITEM only supported in ORDEREDLIST]"))
|
|
|
|
(define (sidebar-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (legalnotice-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (abstract-autolabel nd #!optional (force-label? #f))
|
|
"")
|
|
|
|
(define (block-autolabel nd #!optional (force-label? #f))
|
|
(let* ((chn (element-label (ancestor (normalize "chapter") nd)))
|
|
(apn (element-label (ancestor (normalize "appendix") nd)))
|
|
(rfn (element-label (ancestor (normalize "refentry") nd)))
|
|
;; If the root of this document isn't in component-element-list, these
|
|
;; things all wind up being numbered 0. To avoid that, we force the
|
|
;; root element to be in the list of components if it isn't already
|
|
;; a component.
|
|
(incomp (member (gi (sgml-root-element)) (component-element-list)))
|
|
;; In articles in books, number blocks from book not from article.
|
|
;; Otherwise you get 1, 1, 1, 1, etc. for the first figure in each
|
|
;; article.
|
|
(artinbook (and (not (node-list-empty? (ancestor (normalize "article") nd)))
|
|
(not (node-list-empty? (ancestor (normalize "book") nd)))))
|
|
|
|
(bkn (if artinbook
|
|
(format-number (component-child-number
|
|
nd
|
|
(list (normalize "book")))
|
|
(label-number-format nd))
|
|
(if incomp
|
|
(format-number (component-child-number
|
|
nd
|
|
(component-element-list))
|
|
(label-number-format nd))
|
|
(format-number (component-child-number
|
|
nd
|
|
(append (component-element-list)
|
|
(list (gi (sgml-root-element)))))
|
|
(label-number-format nd))))))
|
|
(if (equal? chn "")
|
|
(if (equal? apn "")
|
|
(if (equal? rfn "")
|
|
bkn
|
|
(string-append rfn (gentext-intra-label-sep nd) bkn))
|
|
(string-append apn (gentext-intra-label-sep nd) bkn))
|
|
(string-append chn (gentext-intra-label-sep nd) bkn))))
|
|
|
|
;; For all elements, if a LABEL attribute is present, that is the label
|
|
;; that they get. Otherwise:
|
|
;; BOOK gets the Book volume, by book-autolabel
|
|
;; PREFACE gets "", by preface-autolabel
|
|
;; CHAPTER gets the Chapter number, by chapter-autolabel
|
|
;; APPENDIX gets the Appendix letter, by appendix-autolabel
|
|
;; REFERENCE gets "", by reference-autolabel
|
|
;; REFENTRY gets "", by refentry-autolabel
|
|
;; SECT* gets the nested section number (e.g., 1.3.5), by section-autolabel
|
|
;; REFSECT* gets the nested section number, by refsection-autolabel
|
|
;; everything else gets numbered by block-autolabel
|
|
;;
|
|
(define (element-label #!optional (nd (current-node)) (force-label? #f))
|
|
(if (node-list-empty? nd)
|
|
""
|
|
(let ((label (attribute-string (normalize "label") nd)))
|
|
(if label
|
|
label
|
|
(cond
|
|
;; Use a seperately defined assoc list?
|
|
((equal? (gi nd) (normalize "abstract"))
|
|
(abstract-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "appendix"))
|
|
(appendix-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "article"))
|
|
(article-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "bibliodiv"))
|
|
(bibliodiv-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "bibliography"))
|
|
(bibliography-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "book"))
|
|
(book-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "chapter"))
|
|
(chapter-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "dedication"))
|
|
(dedication-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "glossary"))
|
|
(glossary-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "glossdiv"))
|
|
(glossdiv-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "index"))
|
|
(index-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "colophon"))
|
|
(colophon-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "indexdiv"))
|
|
(indexdiv-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "setindex"))
|
|
(setindex-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "legalnotice"))
|
|
(legalnotice-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "listitem"))
|
|
(listitem-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "part"))
|
|
(part-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "preface"))
|
|
(preface-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "refentry"))
|
|
(refentry-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "reference"))
|
|
(reference-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "refsynopsisdiv"))
|
|
(refsection-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "refsect1"))
|
|
(refsection-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "refsect2"))
|
|
(refsection-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "refsect3"))
|
|
(refsection-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "sect1"))
|
|
(section-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "sect2"))
|
|
(section-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "sect3"))
|
|
(section-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "sect4"))
|
|
(section-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "sect5"))
|
|
(section-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "section"))
|
|
(section-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "simplesect"))
|
|
(section-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "set"))
|
|
(set-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "sidebar"))
|
|
(sidebar-autolabel nd force-label?))
|
|
((equal? (gi nd) (normalize "step"))
|
|
(step-autolabel nd force-label?))
|
|
(else (block-autolabel nd force-label?)))))))
|
|
|
|
;; ======================================================================
|
|
|
|
;; Returns the element label as a sosofo
|
|
;;
|
|
(define (element-label-sosofo nd #!optional (force-label? #f))
|
|
(if (string=? (element-label nd force-label?) "")
|
|
(empty-sosofo)
|
|
(make sequence
|
|
(literal (element-label nd force-label?)))))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (set-title nd)
|
|
(let* ((setinfo (select-elements (children nd) (normalize "setinfo")))
|
|
(sititles (select-elements
|
|
(expand-children (children setinfo)
|
|
(list (normalize "bookbiblio")
|
|
(normalize "bibliomisc")
|
|
(normalize "biblioset")))
|
|
(normalize "title")))
|
|
(settitles (select-elements (children nd) (normalize "title")))
|
|
(titles (if (node-list-empty? settitles)
|
|
sititles
|
|
settitles)))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
(define (book-title nd)
|
|
(let* ((bookinfo (select-elements (children nd) (normalize "bookinfo")))
|
|
(bititles (select-elements
|
|
(expand-children (children bookinfo)
|
|
(list (normalize "bookbiblio")
|
|
(normalize "bibliomisc")
|
|
(normalize "biblioset")))
|
|
(normalize "title")))
|
|
(chtitles (select-elements (children nd) (normalize "title")))
|
|
(titles (if (node-list-empty? chtitles)
|
|
bititles
|
|
chtitles)))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
(define (part-title nd)
|
|
(let* ((docinfo (select-elements (children nd) (normalize "docinfo")))
|
|
(dititles (select-elements
|
|
(expand-children (children docinfo)
|
|
(list (normalize "bookbiblio")
|
|
(normalize "bibliomisc")
|
|
(normalize "biblioset")))
|
|
(normalize "title")))
|
|
(chtitles (select-elements (children nd) (normalize "title")))
|
|
(titles (if (node-list-empty? chtitles)
|
|
dititles
|
|
chtitles)))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
(define (article-title nd)
|
|
(let* ((artchild (children nd))
|
|
(artheader (select-elements artchild (normalize "artheader")))
|
|
(ahtitles (select-elements (children artheader)
|
|
(normalize "title")))
|
|
(artitles (select-elements artchild (normalize "title")))
|
|
(titles (if (node-list-empty? artitles)
|
|
ahtitles
|
|
artitles)))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
(define (preface-title nd)
|
|
(chapter-title nd))
|
|
|
|
(define (chapter-title nd)
|
|
(let* ((docinfo (select-elements (children nd) (normalize "docinfo")))
|
|
(dititles (select-elements
|
|
(expand-children (children docinfo)
|
|
(list (normalize "bookbiblio")
|
|
(normalize "bibliomisc")
|
|
(normalize "biblioset")))
|
|
(normalize "title")))
|
|
(chtitles (select-elements (children nd) (normalize "title")))
|
|
(titles (if (node-list-empty? chtitles)
|
|
dititles
|
|
chtitles)))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
(define (appendix-title nd)
|
|
(chapter-title nd))
|
|
|
|
(define (reference-title nd)
|
|
(chapter-title nd))
|
|
|
|
(define (refsynopsisdiv-title nd)
|
|
(optional-title nd))
|
|
|
|
;; Returns either the REFENTRYTITLE or the first REFNAME.
|
|
;;
|
|
(define (refentry-title nd)
|
|
(let* ((refmeta (select-elements (descendants nd) (normalize "refmeta")))
|
|
(refttl (select-elements (descendants refmeta) (normalize "refentrytitle")))
|
|
(refndiv (select-elements (descendants nd) (normalize "refnamediv")))
|
|
(refname (select-elements (descendants refndiv) (normalize "refname"))))
|
|
(if (node-list-empty? refttl)
|
|
(if (node-list-empty? refname)
|
|
""
|
|
(node-list-first refname))
|
|
(node-list-first refttl))))
|
|
|
|
(define (optional-title nd)
|
|
(let* ((docinfo (select-elements (children nd) (normalize "docinfo")))
|
|
(dititles (select-elements (children docinfo) (normalize "title")))
|
|
(chtitles (select-elements (children nd) (normalize "title")))
|
|
(titles (if (node-list-empty? chtitles)
|
|
dititles
|
|
chtitles)))
|
|
(if (node-list-empty? titles)
|
|
(gentext-element-name nd)
|
|
(node-list-first titles))))
|
|
|
|
(define (glossary-title nd)
|
|
(optional-title nd))
|
|
|
|
(define (bibliography-title nd)
|
|
(optional-title nd))
|
|
|
|
(define (index-title nd)
|
|
(optional-title nd))
|
|
|
|
(define (setindex-title nd)
|
|
(optional-title nd))
|
|
|
|
(define (dedication-title nd)
|
|
(optional-title nd))
|
|
|
|
(define (colophon-title nd)
|
|
(gentext-element-name nd))
|
|
|
|
(define (section-title nd)
|
|
(let* ((info (select-elements (children nd)
|
|
(list (normalize "sect1info")
|
|
(normalize "sect2info")
|
|
(normalize "sect3info")
|
|
(normalize "sect4info")
|
|
(normalize "sect5info")
|
|
(normalize "section"))))
|
|
(ititles (select-elements (children info) (normalize "title")))
|
|
(ctitles (select-elements (children nd) (normalize "title")))
|
|
(titles (if (node-list-empty? ctitles)
|
|
ititles
|
|
ctitles)))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
(define (refsection-title nd)
|
|
(let* ((info (select-elements (children nd)
|
|
(list (normalize "refsect1info")
|
|
(normalize "refsect2info")
|
|
(normalize "refsect3info"))))
|
|
(ititles (select-elements (children info) (normalize "title")))
|
|
(ctitles (select-elements (children nd) (normalize "title")))
|
|
(titles (if (node-list-empty? ctitles)
|
|
ititles
|
|
ctitles)))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
(define (block-title nd)
|
|
(let ((titles (select-elements (children nd) (normalize "title"))))
|
|
(if (node-list-empty? titles)
|
|
""
|
|
(node-list-first titles))))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (set-title-sosofo nd)
|
|
(let ((title (set-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (book-title-sosofo nd)
|
|
(let ((title (book-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (part-title-sosofo nd)
|
|
(let ((title (part-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (article-title-sosofo nd)
|
|
(let ((title (article-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (preface-title-sosofo nd)
|
|
(let ((title (preface-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (chapter-title-sosofo nd)
|
|
(let ((title (chapter-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (appendix-title-sosofo nd)
|
|
(let ((title (appendix-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (reference-title-sosofo nd)
|
|
(let ((title (reference-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (refsynopsisdiv-title-sosofo nd)
|
|
(optional-title-sosofo nd))
|
|
|
|
(define (refentry-title-sosofo nd)
|
|
(let ((title (refentry-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (optional-title-sosofo nd)
|
|
(let ((title (optional-title nd)))
|
|
(if (string? title)
|
|
(literal title)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (glossary-title-sosofo nd)
|
|
(optional-title-sosofo nd))
|
|
|
|
(define (bibliography-title-sosofo nd)
|
|
(optional-title-sosofo nd))
|
|
|
|
(define (index-title-sosofo nd)
|
|
(optional-title-sosofo nd))
|
|
|
|
(define (setindex-title-sosofo nd)
|
|
(optional-title-sosofo nd))
|
|
|
|
(define (dedication-title-sosofo nd)
|
|
(optional-title-sosofo nd))
|
|
|
|
(define (colophon-title-sosofo nd)
|
|
(literal (gentext-element-name nd)))
|
|
|
|
(define (section-title-sosofo nd)
|
|
(let ((title (section-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (refsection-title-sosofo nd)
|
|
(let ((title (refsection-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(define (block-title-sosofo nd)
|
|
(let ((title (block-title nd)))
|
|
(if (string? title)
|
|
(empty-sosofo)
|
|
(with-mode title-sosofo-mode
|
|
(process-node-list title)))))
|
|
|
|
(mode title-sosofo-mode
|
|
(element title
|
|
(process-children-trim))
|
|
|
|
(element citetitle
|
|
(process-children-trim))
|
|
|
|
(element refname
|
|
(process-children-trim))
|
|
|
|
(element refentrytitle
|
|
(process-children-trim)))
|
|
|
|
;; Returns the title of the element as a sosofo.
|
|
;;
|
|
(define (element-title-sosofo #!optional (nd (current-node)))
|
|
(if (node-list-empty? nd)
|
|
(empty-sosofo)
|
|
(cond
|
|
;; Use a seperately defined assoc list?
|
|
((equal? (gi nd) (normalize "appendix")) (appendix-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "article")) (article-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "bibliography")) (bibliography-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "book")) (book-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "chapter")) (chapter-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "dedication")) (dedication-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "glossary")) (glossary-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "index")) (index-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "colophon")) (colophon-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "setindex")) (index-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "part")) (part-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "preface")) (preface-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "refentry")) (refentry-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "reference")) (reference-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "refsect1")) (refsection-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "refsect2")) (refsection-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "refsect3")) (refsection-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "refsynopsisdiv")) (refsynopsisdiv-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "sect1")) (section-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "sect2")) (section-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "sect3")) (section-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "sect4")) (section-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "sect5")) (section-title-sosofo nd))
|
|
((equal? (gi nd) (normalize "set")) (set-title-sosofo nd))
|
|
(else (block-title-sosofo nd)))))
|
|
|
|
;; ======================================================================
|
|
|
|
;; Returns the title of the element; returns a node if possible, or a string
|
|
(define (element-title nd)
|
|
(if (node-list-empty? nd)
|
|
""
|
|
(cond
|
|
;; Use a seperately defined assoc list?
|
|
((equal? (gi nd) (normalize "appendix")) (appendix-title nd))
|
|
((equal? (gi nd) (normalize "article")) (article-title nd))
|
|
((equal? (gi nd) (normalize "bibliography")) (bibliography-title nd))
|
|
((equal? (gi nd) (normalize "book")) (book-title nd))
|
|
((equal? (gi nd) (normalize "chapter")) (chapter-title nd))
|
|
((equal? (gi nd) (normalize "dedication")) (dedication-title nd))
|
|
((equal? (gi nd) (normalize "glossary")) (glossary-title nd))
|
|
((equal? (gi nd) (normalize "index")) (index-title nd))
|
|
((equal? (gi nd) (normalize "colophon")) (colophon-title nd))
|
|
((equal? (gi nd) (normalize "setindex")) (setindex-title nd))
|
|
((equal? (gi nd) (normalize "part")) (part-title nd))
|
|
((equal? (gi nd) (normalize "preface")) (preface-title nd))
|
|
((equal? (gi nd) (normalize "refentry")) (refentry-title nd))
|
|
((equal? (gi nd) (normalize "reference")) (reference-title nd))
|
|
((equal? (gi nd) (normalize "refsect1")) (refsection-title nd))
|
|
((equal? (gi nd) (normalize "refsect2")) (refsection-title nd))
|
|
((equal? (gi nd) (normalize "refsect3")) (refsection-title nd))
|
|
((equal? (gi nd) (normalize "refsynopsisdiv")) (refsynopsisdiv-title nd))
|
|
((equal? (gi nd) (normalize "sect1")) (section-title nd))
|
|
((equal? (gi nd) (normalize "sect2")) (section-title nd))
|
|
((equal? (gi nd) (normalize "sect3")) (section-title nd))
|
|
((equal? (gi nd) (normalize "sect4")) (section-title nd))
|
|
((equal? (gi nd) (normalize "sect5")) (section-title nd))
|
|
((equal? (gi nd) (normalize "set")) (set-title nd))
|
|
(else (block-title nd)))))
|
|
|
|
;; ======================================================================
|
|
;; Returns the data of a node, carefully excising INDEXTERMs from
|
|
;; the data content
|
|
;;
|
|
|
|
(define (data-of node)
|
|
;; return the data characters of a node, except for the content of
|
|
;; indexterms which are suppressed.
|
|
(let loop ((nl (children node)) (result ""))
|
|
(if (node-list-empty? nl)
|
|
result
|
|
(if (equal? (node-property 'class-name (node-list-first nl)) 'element)
|
|
(if (or (equal? (gi (node-list-first nl)) (normalize "indexterm"))
|
|
(equal? (gi (node-list-first nl)) (normalize "comment"))
|
|
(equal? (gi (node-list-first nl)) (normalize "remark")))
|
|
(loop (node-list-rest nl) result)
|
|
(loop (node-list-rest nl)
|
|
(string-append result (data-of (node-list-first nl)))))
|
|
(if (or (equal? (node-property 'class-name (node-list-first nl))
|
|
'data-char)
|
|
(equal? (node-property 'class-name (node-list-first nl))
|
|
'sdata))
|
|
(loop (node-list-rest nl)
|
|
(string-append result (data (node-list-first nl))))
|
|
(loop (node-list-rest nl) result))))))
|
|
|
|
;; ======================================================================
|
|
;; Returns the element title data of nd
|
|
;;
|
|
(define (element-title-string nd)
|
|
(let ((title (element-title nd)))
|
|
(if (string? title)
|
|
title
|
|
(data-of title))))
|
|
|
|
;; ======================================================================
|
|
;; Returns the element gi as a sosofo
|
|
;;
|
|
(define (element-gi-sosofo nd)
|
|
(if (node-list-empty? nd)
|
|
(empty-sosofo)
|
|
(make sequence
|
|
(literal (gentext-element-name nd)))))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (titlepage-info-elements node info #!optional (intro (empty-node-list)))
|
|
;; Returns a node-list of the elements that might appear on a title
|
|
;; page. This node-list is constructed as follows:
|
|
;;
|
|
;; 1. The "title" child of node is considered as a possibility
|
|
;; 2. If info is not empty, then node-list starts as the children
|
|
;; of info. If the children of info don't include a title, then
|
|
;; the title from the node is added.
|
|
;; 3. If info is empty, then node-list starts as the children of node,
|
|
;; but with "partintro" filtered out.
|
|
|
|
(let* ((title (select-elements (children node) (normalize "title")))
|
|
(nl (if (node-list-empty? info)
|
|
(node-list-filter-by-not-gi (children node)
|
|
(list (normalize "partintro")))
|
|
(children info)))
|
|
(nltitle (node-list-filter-by-gi nl (list (normalize "title")))))
|
|
(if (node-list-empty? info)
|
|
(node-list nl
|
|
intro)
|
|
(node-list (if (node-list-empty? nltitle)
|
|
title
|
|
(empty-node-list))
|
|
nl
|
|
intro))))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (info-element #!optional (nd (current-node)))
|
|
;; Returns the *INFO element for the nd or (empty-node-list) if no
|
|
;; such node exists...
|
|
(cond
|
|
((equal? (gi nd) (normalize "set"))
|
|
(select-elements (children nd) (normalize "setinfo")))
|
|
((equal? (gi nd) (normalize "book"))
|
|
(select-elements (children nd) (normalize "bookinfo")))
|
|
((equal? (gi nd) (normalize "section"))
|
|
(select-elements (children nd) (normalize "sectioninfo")))
|
|
((equal? (gi nd) (normalize "sect1"))
|
|
(select-elements (children nd) (normalize "sect1info")))
|
|
((equal? (gi nd) (normalize "sect2"))
|
|
(select-elements (children nd) (normalize "sect2info")))
|
|
((equal? (gi nd) (normalize "sect3"))
|
|
(select-elements (children nd) (normalize "sect3info")))
|
|
((equal? (gi nd) (normalize "sect4"))
|
|
(select-elements (children nd) (normalize "sect4info")))
|
|
((equal? (gi nd) (normalize "sect5"))
|
|
(select-elements (children nd) (normalize "sect5info")))
|
|
((equal? (gi nd) (normalize "refsect1"))
|
|
(select-elements (children nd) (normalize "refsect1info")))
|
|
((equal? (gi nd) (normalize "refsect2"))
|
|
(select-elements (children nd) (normalize "refsect2info")))
|
|
((equal? (gi nd) (normalize "refsect3"))
|
|
(select-elements (children nd) (normalize "refsect3info")))
|
|
((equal? (gi nd) (normalize "refsynopsisdiv"))
|
|
(select-elements (children nd) (normalize "refsynopsisdivinfo")))
|
|
((equal? (gi nd) (normalize "article"))
|
|
(node-list-filter-by-gi (children nd) (list
|
|
(normalize "artheader")
|
|
(normalize "articleinfo"))))
|
|
(else ;; BIBLIODIV, GLOSSDIV, INDEXDIV, PARTINTRO, SIMPLESECT
|
|
(select-elements (children nd) (normalize "docinfo")))))
|
|
|
|
;; ======================================================================
|
|
;;
|
|
;; Bibliography filtering...
|
|
|
|
(define (biblio-filter allentries)
|
|
(let* ((all (descendants (sgml-root-element)))
|
|
(link (select-elements all (normalize "link")))
|
|
(xref (select-elements all (normalize "xref")))
|
|
(cite (select-elements all (normalize "citation")))
|
|
(xref-elements (node-list link xref)))
|
|
(let loop ((entries allentries) (used (empty-node-list)))
|
|
(if (node-list-empty? entries)
|
|
used
|
|
(if (or (cited-by-xref (node-list-first entries) xref-elements)
|
|
(cited-by-citation (node-list-first entries) cite))
|
|
(loop (node-list-rest entries)
|
|
(node-list used (node-list-first entries)))
|
|
(loop (node-list-rest entries) used))))))
|
|
|
|
(define (cited-by-xref bib xref-elements)
|
|
(let* ((id (attribute-string (normalize "id") bib)))
|
|
(if id
|
|
(let loop ((links xref-elements))
|
|
(if (node-list-empty? links)
|
|
#f
|
|
(if (equal? (attribute-string (normalize "linkend")
|
|
(node-list-first links)) id)
|
|
#t
|
|
(loop (node-list-rest links)))))
|
|
#f)))
|
|
|
|
(define (cited-by-citation bib citations)
|
|
(let loop ((links citations))
|
|
(if (node-list-empty? links)
|
|
#f
|
|
(if (citation-matches-target? (node-list-first links) bib)
|
|
#t
|
|
(loop (node-list-rest links))))))
|
|
|
|
(define (citation-matches-target? citation target)
|
|
(let* ((fchild (node-list-first
|
|
(node-list-filter-out-pis
|
|
(children target))))
|
|
(abbrev (if (equal? (gi fchild) (normalize "abbrev"))
|
|
fchild
|
|
(empty-node-list)))
|
|
(cite (data-of citation)))
|
|
(or (equal? (attribute-string "id" target) (normalize cite))
|
|
(equal? (attribute-string "xreflabel" target) (normalize cite))
|
|
(equal? (normalize cite) (normalize (data-of abbrev))))))
|
|
|
|
(define (bibentry-number bibentry)
|
|
(let* ((bgraphy (ancestor-member bibentry
|
|
(list (normalize "bibliography"))))
|
|
(comps (expand-children (children bgraphy)
|
|
(list (normalize "bibliodiv")))))
|
|
(let loop ((nl comps) (count 1))
|
|
(if (node-list-empty? nl)
|
|
0
|
|
(if (node-list=? (node-list-first nl) bibentry)
|
|
count
|
|
(if (or (equal? (gi (node-list-first nl))
|
|
(normalize "biblioentry"))
|
|
(equal? (gi (node-list-first nl))
|
|
(normalize "bibliomixed")))
|
|
(loop (node-list-rest nl) (+ count 1))
|
|
(loop (node-list-rest nl) count)))))))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (olink-resource-title pubid sysid)
|
|
;; This version of olink-resource-title expects public identifiers
|
|
;; with the following format:
|
|
;;
|
|
;; -//owner//TEXT title Vx.x//EN
|
|
;;
|
|
;; Specifically the title is the description field of the public
|
|
;; identifier minus the first word (TEXT, the type) and the last
|
|
;; word, in my case a version string. Words are blank delimited.
|
|
;; The parsing will fail if a "/" appears anywhere in any field.
|
|
;; The system identifier is ignored
|
|
;;
|
|
(let* ((pubidparts (if pubid
|
|
(split pubid '(#\/))
|
|
(split "-//none//type version//la" '(#\/))))
|
|
(description (car (cdr (cdr pubidparts))))
|
|
(descparts (split description))
|
|
(titleparts (list-head (cdr descparts) (- (length descparts) 2))))
|
|
(join titleparts)))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (orderedlist-listitem-number listitem)
|
|
;; return the number of listitem, taking continuation into account
|
|
(let* ((orderedlist (parent listitem))
|
|
(listitems (select-elements (children orderedlist)
|
|
(normalize "listitem")))
|
|
(continue? (equal? (attribute-string (normalize "continuation")
|
|
orderedlist)
|
|
(normalize "continues")))
|
|
|
|
;; If a list is the continuation of a previous list, we must find the
|
|
;; list that is continued in order to calculate the starting
|
|
;; item number of this list.
|
|
;;
|
|
;; Of all the lists in this component, only the following are candidates:
|
|
;; 1. Lists which precede this list
|
|
;; 2. Lists which are not ancestors of this list
|
|
;; 3. Lists that do not have ancestors that are lists which precede this one
|
|
;;
|
|
;; Of the candidates, the last one, in document order, is the preceding
|
|
;; list
|
|
(all-lists (select-elements
|
|
(descendants (ancestor-member orderedlist
|
|
(component-element-list)))
|
|
(normalize "orderedlist")))
|
|
|
|
(cand1 (if continue?
|
|
(let loop ((nl all-lists)
|
|
(prec (empty-node-list)))
|
|
(if (node-list-empty? nl)
|
|
prec
|
|
(if (node-list=? (node-list-first nl)
|
|
orderedlist)
|
|
prec
|
|
(loop (node-list-rest nl)
|
|
(node-list prec
|
|
(node-list-first nl))))))
|
|
(empty-node-list)))
|
|
|
|
(cand2 (let loop ((nl cand1)
|
|
(cand2lists (empty-node-list)))
|
|
(if (node-list-empty? nl)
|
|
cand2lists
|
|
(loop (node-list-rest nl)
|
|
(if (descendant-of? (node-list-first nl)
|
|
orderedlist)
|
|
cand2lists
|
|
(node-list cand2lists
|
|
(node-list-first nl)))))))
|
|
|
|
;; now find the last item of cand2 that is not a descendant
|
|
;; of some other element of the cand2 list.
|
|
(preclist (let loop ((nl (node-list-reverse cand2)))
|
|
(if (node-list-empty? nl)
|
|
(empty-node-list)
|
|
(if (descendant-member-of?
|
|
(node-list-first nl)
|
|
(node-list-rest nl))
|
|
(loop (node-list-rest nl))
|
|
(node-list-first nl)))))
|
|
|
|
(precitem (if (node-list-empty? preclist)
|
|
(empty-node-list)
|
|
(node-list-last (children preclist))))
|
|
(precitem-number (if (and continue? (not (node-list-empty? precitem)))
|
|
(orderedlist-listitem-number precitem)
|
|
0)))
|
|
|
|
(+ precitem-number (child-number listitem))))
|
|
|
|
(define (descendant-member-of? node node-list)
|
|
;; return true if node is a descedant of any member of node-list
|
|
(let loop ((nl node-list))
|
|
(if (node-list-empty? nl)
|
|
#f
|
|
(if (descendant-of? (node-list-first nl) node)
|
|
#t
|
|
(loop (node-list-rest nl))))))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (orderedlist-listitem-label listitem)
|
|
;; return the formatted number of listitem
|
|
(let* ((number (orderedlist-listitem-number listitem))
|
|
(depth (length (hierarchical-number-recursive
|
|
(normalize "orderedlist")
|
|
listitem)))
|
|
(numeration (inherited-attribute-string (normalize "numeration")
|
|
listitem))
|
|
;; rawnum allows for numbering to alternate
|
|
(rawnum (cond
|
|
((equal? numeration (normalize "arabic")) 1)
|
|
((equal? numeration (normalize "loweralpha")) 2)
|
|
((equal? numeration (normalize "lowerroman")) 3)
|
|
((equal? numeration (normalize "upperalpha")) 4)
|
|
((equal? numeration (normalize "upperroman")) 0)
|
|
(else (modulo depth 5)))))
|
|
(case rawnum
|
|
((1) (format-number number "1"))
|
|
((2) (format-number number "a"))
|
|
((3) (format-number number "i"))
|
|
((4) (format-number number "A"))
|
|
((0) (format-number number "I")))))
|
|
|
|
(define (orderedlist-listitem-label-recursive listitem)
|
|
;; return the recursively formatted number of the listitem.
|
|
;; In other words, something of the form 1.2.3 for a third level
|
|
;; nested ordered list
|
|
(let loop ((li (parent listitem))
|
|
(label (orderedlist-listitem-label listitem)))
|
|
(if (or (node-list-empty? li)
|
|
(node-list-empty? (ancestor (normalize "orderedlist") li)))
|
|
label
|
|
(if (and (equal? (gi li) (normalize "listitem"))
|
|
(equal? (gi (parent li)) (normalize "orderedlist")))
|
|
(loop (parent li)
|
|
(string-append
|
|
(orderedlist-listitem-label li)
|
|
(gentext-intra-label-sep li)
|
|
label))
|
|
(loop (parent li) label)))))
|
|
|
|
(define (question-answer-label #!optional (node (current-node)))
|
|
(let* ((inhlabel (inherited-attribute-string (normalize "defaultlabel")
|
|
node))
|
|
(deflabel (if inhlabel inhlabel (qanda-defaultlabel)))
|
|
(label (attribute-string (normalize "label") node))
|
|
(hnr (hierarchical-number-recursive (normalize "qandadiv")
|
|
node))
|
|
|
|
(parsect (ancestor-member node (section-element-list)))
|
|
|
|
(defnum (if (and %qanda-inherit-numeration%
|
|
%section-autolabel%)
|
|
(if (node-list-empty? parsect)
|
|
(section-autolabel-prefix node)
|
|
(section-autolabel parsect))
|
|
""))
|
|
|
|
(hnumber (let loop ((numlist hnr) (number defnum)
|
|
(sep (if (equal? defnum "") "" ".")))
|
|
(if (null? numlist)
|
|
number
|
|
(loop (cdr numlist)
|
|
(string-append number
|
|
sep
|
|
(number->string (car numlist)))
|
|
"."))))
|
|
(cnumber (child-number (parent node)))
|
|
(number (string-append hnumber
|
|
(if (equal? hnumber "")
|
|
""
|
|
".")
|
|
(number->string cnumber))))
|
|
(cond
|
|
((equal? deflabel (normalize "qanda"))
|
|
(gentext-element-name node))
|
|
((equal? deflabel (normalize "label"))
|
|
label)
|
|
;; Note: only questions are numbered...
|
|
((and (equal? deflabel (normalize "number"))
|
|
(equal? (gi node) (normalize "question")))
|
|
(string-append number "."))
|
|
(else ""))))
|
|
|
|
;; ======================================================================
|
|
;; Calculate term lengths...
|
|
|
|
(define (varlistentry-term-too-long? vle termlength)
|
|
(let loop ((nl (select-elements (children vle) (normalize "term")))
|
|
(too-long? #f))
|
|
(if (or too-long? (node-list-empty? nl))
|
|
too-long?
|
|
(loop (node-list-rest nl)
|
|
(> (string-length (data (node-list-first nl)))
|
|
termlength)))))
|
|
|
|
(define (variablelist-term-too-long? termlength)
|
|
(let loop ((nl (select-elements (children (current-node))
|
|
(normalize "varlistentry")))
|
|
(too-long? #f))
|
|
(if (or too-long? (node-list-empty? nl))
|
|
too-long?
|
|
(loop (node-list-rest nl)
|
|
(varlistentry-term-too-long? (node-list-first nl) termlength)))))
|
|
|
|
;; ======================================================================
|
|
;; bibliography elements
|
|
|
|
(define (biblioentry-inline-elements)
|
|
(list (normalize "abbrev")
|
|
(normalize "affiliation")
|
|
(normalize "artpagenums")
|
|
(normalize "author")
|
|
(normalize "authorgroup")
|
|
(normalize "authorinitials")
|
|
(normalize "citetitle")
|
|
(normalize "collab")
|
|
(normalize "confgroup")
|
|
(normalize "contractnum")
|
|
(normalize "contractsponsor")
|
|
(normalize "contrib")
|
|
(normalize "copyright")
|
|
(normalize "corpauthor")
|
|
(normalize "corpname")
|
|
(normalize "date")
|
|
(normalize "edition")
|
|
(normalize "editor")
|
|
(normalize "firstname")
|
|
(normalize "honorific")
|
|
(normalize "invpartnumber")
|
|
(normalize "isbn")
|
|
(normalize "issn")
|
|
(normalize "issuenum")
|
|
(normalize "lineage")
|
|
(normalize "orgname")
|
|
(normalize "othercredit")
|
|
(normalize "othername")
|
|
(normalize "pagenums")
|
|
(normalize "productname")
|
|
(normalize "productnumber")
|
|
(normalize "pubdate")
|
|
(normalize "publisher")
|
|
(normalize "publishername")
|
|
(normalize "pubsnumber")
|
|
(normalize "releaseinfo")
|
|
(normalize "seriesvolnums")
|
|
(normalize "subtitle")
|
|
(normalize "surname")
|
|
(normalize "title")
|
|
(normalize "titleabbrev")
|
|
(normalize "volumenum")))
|
|
|
|
(define (biblioentry-block-elements)
|
|
(list (normalize "abstract")
|
|
(normalize "address")
|
|
(normalize "authorblurb")
|
|
(normalize "printhistory")
|
|
(normalize "revhistory")
|
|
(normalize "seriesinfo")))
|
|
|
|
(define (biblioentry-flatten-elements)
|
|
(list (normalize "artheader")
|
|
(normalize "biblioset")
|
|
(normalize "bookbiblio")))
|
|
|
|
;; === db31 common ======================================================
|
|
|
|
(define (data-filename dataobj)
|
|
(let* ((entityref (attribute-string (normalize "entityref") dataobj))
|
|
(fileref (attribute-string (normalize "fileref") dataobj))
|
|
(filename (if fileref
|
|
fileref
|
|
(system-id-filename entityref)))
|
|
(ext (file-extension filename)))
|
|
(if (or (not filename)
|
|
(not %graphic-default-extension%)
|
|
(member ext %graphic-extensions%))
|
|
filename
|
|
(string-append filename "." %graphic-default-extension%))))
|
|
|
|
(define (normalized-member string string-list)
|
|
(if (string? string)
|
|
(let loop ((sl string-list))
|
|
(if (null? sl)
|
|
#f
|
|
(if (string=? (normalize string) (normalize (car sl)))
|
|
#t
|
|
(loop (cdr sl)))))
|
|
#f))
|
|
|
|
(define (find-displayable-object objlist notlist extlist)
|
|
(let loop ((nl objlist))
|
|
(if (node-list-empty? nl)
|
|
(empty-node-list)
|
|
(let* ((objdata (node-list-filter-by-gi
|
|
(children (node-list-first nl))
|
|
(list (normalize "videodata")
|
|
(normalize "audiodata")
|
|
(normalize "imagedata"))))
|
|
(filename (data-filename objdata))
|
|
(extension (file-extension filename))
|
|
(notation (attribute-string (normalize "format") objdata)))
|
|
(if (or (normalized-member notation notlist)
|
|
(normalized-member extension extlist)
|
|
(and notation
|
|
(string=? notation (normalize "linespecific"))))
|
|
(node-list-first nl)
|
|
(loop (node-list-rest nl)))))))
|
|
|
|
(define (select-displayable-object objlist)
|
|
(let ((pref (find-displayable-object objlist
|
|
preferred-mediaobject-notations
|
|
preferred-mediaobject-extensions))
|
|
(ok (find-displayable-object objlist
|
|
acceptable-mediaobject-notations
|
|
acceptable-mediaobject-extensions)))
|
|
(if (node-list-empty? pref)
|
|
ok
|
|
pref)))
|
|
|
|
(define ($mediaobject$)
|
|
(let* ((objects (node-list-filter-by-gi
|
|
(children (current-node))
|
|
(list (normalize "videoobject")
|
|
(normalize "imageobject")
|
|
(normalize "audioobject"))))
|
|
(dobject (select-displayable-object objects))
|
|
(textobj (select-elements (children (current-node))
|
|
(normalize "textobject")))
|
|
(caption (select-elements (children (current-node))
|
|
(normalize "caption"))))
|
|
(make sequence
|
|
(if (node-list-empty? dobject)
|
|
(if (node-list-empty? textobj)
|
|
(empty-sosofo)
|
|
(process-node-list (node-list-first textobj)))
|
|
(process-node-list dobject))
|
|
(process-node-list caption))))
|
|
|
|
;; ======================================================================
|