;; $Id: dbautoc.dsl,v 1.3 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/
;;
;; ========================== TABLE OF CONTENTS =========================
;; Returns the depth of auto TOC that should be made at the nd-level
(define (toc-depth nd)
(if (string=? (gi nd) (normalize "book"))
3
1))
(define (toc-entry tocentry)
(make element gi: "DT"
(make sequence
(if (equal? (element-label tocentry) "")
(empty-sosofo)
(make sequence
(literal (element-label tocentry))
(literal (gentext-label-title-sep
(gi tocentry)))))
;; If the tocentry isn't in its own
;; chunk, don't make a link...
(if (and #f (not (chunk? tocentry)))
(element-title-sosofo tocentry)
(make element gi: "A"
attributes: (list
(list "HREF"
(href-to tocentry)))
(element-title-sosofo tocentry)))
;; Maybe annotate...
(if (and %annotate-toc%
(equal? (gi tocentry) (normalize "refentry")))
(make sequence
(dingbat-sosofo "nbsp");
(dingbat-sosofo "em-dash");
(dingbat-sosofo "nbsp");
(toc-annotation tocentry))
(empty-sosofo)))))
(define (toc-annotation tocentry)
;; only handles refentry at the moment
(let* ((refnamediv (select-elements (children tocentry)
(normalize "refnamediv")))
(refpurpose (select-elements (children refnamediv)
(normalize "refpurpose"))))
(process-node-list (children refpurpose))))
(define (build-toc nd depth #!optional (chapter-toc? #f) (first? #t))
(let ((toclist (toc-list-filter
(node-list-filter-by-gi (children nd)
(append (division-element-list)
(component-element-list)
(section-element-list)))))
(wrappergi (if first? "DIV" "DD"))
(wrapperattr (if first? '(("CLASS" "TOC")) '())))
(if (or (<= depth 0)
(node-list-empty? toclist)
(and chapter-toc?
(not %force-chapter-toc%)
(<= (node-list-length toclist) 1)))
(empty-sosofo)
(make element gi: wrappergi
attributes: wrapperattr
(make element gi: "DL"
(if first?
(make element gi: "DT"
(make element gi: "B"
(literal (gentext-element-name (normalize "toc")))))
(empty-sosofo))
(let loop ((nl toclist))
(if (node-list-empty? nl)
(empty-sosofo)
(sosofo-append
(toc-entry (node-list-first nl))
(build-toc (node-list-first nl)
(- depth 1) chapter-toc? #f)
(loop (node-list-rest nl))))))))))
;; Print the LOT entry
(define (lot-entry tocentry)
(make element gi: "DT"
(make sequence
(if (equal? (element-label tocentry) "")
(empty-sosofo)
(make sequence
(literal (element-label tocentry))
(literal (gentext-label-title-sep
(gi tocentry)))))
;; If the tocentry isn't in its own
;; chunk, don't make a link...
(if (and #f (not (chunk? tocentry)))
(element-title-sosofo tocentry)
(make element gi: "A"
attributes: (list
(list "HREF"
(href-to tocentry)))
(element-title-sosofo tocentry))))))
;; Build a LOT starting at nd for all the lotgi's it contains.
;; The optional arguments are used on recursive calls to build-toc
;; and shouldn't be set by the initial caller...
;;
(define (build-lot nd lotgi)
(let* ((lotlist (select-elements (descendants nd)
(normalize lotgi))))
(if (node-list-empty? lotlist)
(empty-sosofo)
(make element gi: "DIV"
attributes: '(("CLASS" "LOT"))
(make element gi: "DL"
attributes: '(("CLASS" "LOT"))
(make element gi: "DT"
(make element gi: "B"
(literal ($lot-title$
(gi (node-list-first lotlist))))))
(let loop ((lote lotlist))
(if (node-list-empty? lote)
(empty-sosofo)
(make sequence
(lot-entry (node-list-first lote))
(loop (node-list-rest lote))))))))))