1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
;; $Id: dbautoc.dsl,v 1.5 1999/03/01 11:35:13 nwalsh Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://www.berkshire.net/~norm/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
(literal " \em-dash; ")
(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))))))))))
|
