File: dbautoc.dsl

package info (click to toggle)
docbook-dsssl 1.79-9.2
  • links: PTS
  • area: main
  • in suites: bullseye, sid
  • size: 3,288 kB
  • sloc: perl: 496; xml: 126; javascript: 61; makefile: 33
file content (128 lines) | stat: -rw-r--r-- 3,952 bytes parent folder | download | duplicates (6)
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
;; $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))))))))))