;; $Id: dbfootn.dsl,v 1.4 2003/01/15 08:24:13 adicarlo Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;
;; ======================================================================
;; Handle footnotes in body text
(element footnote ;; A footnote inserts a reference to itself
(let ((id (if (attribute-string (normalize "id"))
(attribute-string (normalize "id"))
(generate-anchor))))
(make element gi: "A"
attributes: (list
(list "NAME" id)
(list "HREF" (string-append "#FTN." id)))
($footnote-literal$ (current-node)))))
(element footnoteref
(let* ((target (element-with-id (attribute-string (normalize "linkend"))))
(id (if (attribute-string (normalize "id") target)
(attribute-string (normalize "id") target)
(generate-anchor target)))
(curdepth (directory-depth (html-file (current-node))))
(entfile (html-file target))
;; can't use (href-to) here because we tinker with the fragid
(href (if nochunks
(string-append "#FTN." id)
(string-append (copy-string "../" curdepth)
entfile "#FTN." id))))
(make element gi: "A"
attributes: (list
(list "HREF" href))
($footnote-literal$ target))))
(define (count-footnote? footnote)
;; don't count footnotes in comments (unless you're showing comments)
;; or footnotes in tables which are handled locally in the table
(if (or (and (has-ancestor-member? footnote (list (normalize "comment")))
(not %show-comments%))
(has-ancestor-member? footnote (list (normalize "tgroup"))))
#f
#t))
(define ($chunk-footnote-number$ footnote)
;; This is more complex than it at first appears because footnotes
;; can be in Comments which may be suppressed.
(let* ((footnotes (select-elements
(descendants (chunk-parent footnote))
(normalize "footnote"))))
(let loop ((nl footnotes) (num 1))
(if (node-list-empty? nl)
0
(if (node-list=? (node-list-first nl) footnote)
num
(if (count-footnote? (node-list-first nl))
(loop (node-list-rest nl) (+ num 1))
(loop (node-list-rest nl) num)))))))
(define ($footnote-literal$ node)
(make element gi: "SPAN"
attributes: (list
(list "CLASS" "footnote"))
(literal
(string-append
"[" ($footnote-number$ node) "]"))))
(define ($table-footnote-number$ footnote)
(let* ((chunk (ancestor (normalize "tgroup") footnote))
(footnotes (select-elements (descendants chunk) (normalize "footnote"))))
(let loop ((nl footnotes) (num 1))
(if (node-list-empty? nl)
0
(if (node-list=? footnote (node-list-first nl))
num
(loop (node-list-rest nl)
(+ num 1)))))))
(define ($footnote-number$ footnote)
(if (node-list-empty? (ancestor (normalize "tgroup") footnote))
(format-number ($chunk-footnote-number$ footnote) "1")
(format-number ($table-footnote-number$ footnote) "a")))
(mode footnote-mode
(element footnote
(process-children))
(element (footnote para)
(let ((id (if (attribute-string (normalize "id") (parent (current-node)))
(attribute-string (normalize "id") (parent (current-node)))
(generate-anchor (parent (current-node))))))
(make element gi: "P"
(if (= (child-number) 1)
(make sequence
(make element gi: "A"
attributes: (list
(list "NAME" (string-append "FTN." id))
(list "HREF" (href-to (parent (current-node)))))
($footnote-literal$ (parent (current-node))))
(literal " "))
(literal ""))
(process-children))))
)
(define (non-table-footnotes footnotenl)
(let loop ((nl footnotenl) (result (empty-node-list)))
(if (node-list-empty? nl)
result
(if (has-ancestor-member? (node-list-first nl)
(list (normalize "tgroup")))
(loop (node-list-rest nl)
result)
(loop (node-list-rest nl)
(node-list result (node-list-first nl)))))))
(define (make-endnotes #!optional (node (current-node)))
(if %footnotes-at-end%
(let* ((allfootnotes (select-elements (descendants node)
(normalize "footnote")))
(allntfootnotes (non-table-footnotes allfootnotes))
(this-chunk (chunk-parent node))
(chunkfootnotes (let loop ((fn allntfootnotes)
(chunkfn (empty-node-list)))
(if (node-list-empty? fn)
chunkfn
(if (node-list=? this-chunk
(chunk-parent
(node-list-first fn)))
(loop (node-list-rest fn)
(node-list chunkfn
(node-list-first fn)))
(loop (node-list-rest fn)
chunkfn)))))
(footnotes (let loop ((nl chunkfootnotes)
(fnlist (empty-node-list)))
(if (node-list-empty? nl)
fnlist
(if (count-footnote? (node-list-first nl))
(loop (node-list-rest nl)
(node-list fnlist
(node-list-first nl)))
(loop (node-list-rest nl)
fnlist))))))
(if (node-list-empty? footnotes)
(empty-sosofo)
(if (and #f
;; there was a time when make-endnotes was called in
;; more places, and this code prevented footnotes from
;; being output more than once. now that it's only
;; called in footer-navigation, this code isn't necessary
;; and does the wrong thing if -V nochunks is specified.
(or (equal? (gi node) (normalize "reference"))
(equal? (gi node) (normalize "part"))
(equal? (gi node) (normalize "set"))
(equal? (gi node) (normalize "book"))))
(empty-sosofo) ;; Each RefEntry/Component does its own...
(make sequence
(make-endnote-header)
(make element gi: "TABLE"
attributes: '(("BORDER" "0")
("CLASS" "FOOTNOTES")
("WIDTH" "100%"))
(with-mode endnote-mode
(process-node-list footnotes)))))))
(empty-sosofo)))
(define (make-endnote-header)
(let ((headsize (if (equal? (gi) (normalize "refentry")) "H2" "H3")))
(make element gi: headsize
attributes: '(("CLASS" "FOOTNOTES"))
(literal (gentext-endnotes)))))
(mode endnote-mode
(element footnote
(let ((id (if (attribute-string (normalize "id") (current-node))
(attribute-string (normalize "id") (current-node))
(generate-anchor (current-node)))))
(make sequence
(make element gi: "TR"
(make element gi: "TD"
attributes: '(("ALIGN" "LEFT")
("VALIGN" "TOP")
("WIDTH" "5%"))
(make element gi: "A"
attributes: (list
(list "NAME" (string-append "FTN." id))
(list "HREF" (href-to (current-node))))
($footnote-literal$ (current-node))))
(make element gi: "TD"
attributes: '(("ALIGN" "LEFT")
("VALIGN" "TOP")
("WIDTH" "95%"))
(process-children))))))
)
;; ======================================================================
;; Handle table footnotes
(define (table-footnote-number footnote)
(format-number (component-child-number footnote
(list (normalize "table")
(normalize "informaltable")))
"a"))
(element (entry para footnote)
(make element gi: "SUP"
(literal (table-footnote-number (current-node)))))
(define (make-table-endnote-header)
(make sequence
(literal (gentext-table-endnotes))
(make empty-element gi: "BR")))
(define (make-table-endnotes)
(let* ((footnotes (select-elements (descendants (current-node))
(normalize "footnote")))
(tgroup (ancestor-member (current-node) (list (normalize "tgroup"))))
(cols (string->number (attribute-string (normalize "cols") tgroup))))
(if (node-list-empty? footnotes)
(empty-sosofo)
(make element gi: "TR"
(make element gi: "TD"
attributes: (list
(list "COLSPAN" (number->string cols)))
(make-table-endnote-header)
(with-mode table-footnote-mode
(process-node-list footnotes)))))))
(mode table-footnote-mode
(element footnote
(process-children))
(element (footnote para)
(let* ((target (parent (current-node)))
(fnnum (table-footnote-number target))
(idstr (if (attribute-string (normalize "id") target)
(attribute-string (normalize "id") target)
(generate-anchor target))))
(make sequence
(if (= (child-number) 1)
(make element gi: "A"
attributes: (list (list "NAME" (string-append "FTN." idstr)))
(literal fnnum
(gentext-label-title-sep (normalize "footnote"))))
(empty-sosofo))
(process-children)
(make empty-element gi: "BR")))))