blob: 633b26e57d2d10b254e606f0f7299b152b318968 (
plain)
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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
;; $Id: dbqanda.dsl,v 1.1 2003/03/25 19:53:41 adicarlo Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;
;; ============================== QANDASET ==============================
(define (qanda-defaultlabel)
(normalize "number"))
(define (qanda-section-level)
;; FIXME: what if they nest inside each other?
(let* ((enclsect (ancestor-member (current-node)
(list (normalize "section")
(normalize "simplesect")
(normalize "sect5")
(normalize "sect4")
(normalize "sect3")
(normalize "sect2")
(normalize "sect1")
(normalize "refsect3")
(normalize "refsect2")
(normalize "refsect1")))))
(SECTLEVEL enclsect)))
(define (qandadiv-section-level)
(let ((depth (length (hierarchical-number-recursive
(normalize "qandadiv")))))
(+ (qanda-section-level) depth)))
(element qandaset
(let ((title (select-elements (children (current-node))
(normalize "title")))
;; process title and rest separately so that we can put the TOC
;; in the rigth place...
(rest (node-list-filter-by-not-gi (children (current-node))
(list (normalize "title")))))
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi)))
(process-node-list title)
(if ($generate-qandaset-toc$)
(process-qanda-toc)
(empty-sosofo))
(process-node-list rest))))
(element (qandaset title)
(let* ((htmlgi (string-append "H" (number->string
(+ (qanda-section-level) 1)))))
(make element gi: htmlgi
attributes: (list (list "CLASS" (gi (current-node))))
(process-children))))
(element qandadiv
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi)))
(process-children)))
(element (qandadiv title)
(let* ((hnr (hierarchical-number-recursive (normalize "qandadiv")
(current-node)))
(number (let loop ((numlist hnr) (number "") (sep ""))
(if (null? numlist)
number
(loop (cdr numlist)
(string-append number
sep
(number->string (car numlist)))
"."))))
(htmlgi (string-append "H" (number->string
(+ (qandadiv-section-level) 1)))))
(make element gi: htmlgi
(make element gi: "A"
attributes: (list (list "NAME" (element-id
(parent (current-node)))))
(empty-sosofo))
(literal number ". ")
(process-children))))
(element qandaentry
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi)))
(process-children)))
(element question
(let* ((chlist (children (current-node)))
(firstch (node-list-first chlist))
(restch (node-list-rest chlist)))
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi)))
(make element gi: "P"
(make element gi: "A"
attributes: (list (list "NAME" (element-id)))
(empty-sosofo))
(make element gi: "B"
(literal (question-answer-label (current-node)) " "))
(process-node-list (children firstch)))
(process-node-list restch))))
(element answer
(let* ((inhlabel (inherited-attribute-string (normalize "defaultlabel")))
(deflabel (if inhlabel inhlabel (qanda-defaultlabel)))
(label (attribute-string (normalize "label")))
(chlist (children (current-node)))
(firstch (node-list-first chlist))
(restch (node-list-rest chlist)))
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi)))
(make element gi: "P"
(make element gi: "B"
(literal (question-answer-label (current-node)) " "))
(process-node-list (children firstch)))
(process-node-list restch))))
;; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
(define (process-qanda-toc #!optional (node (current-node)))
(let* ((divs (node-list-filter-by-gi (children node)
(list (normalize "qandadiv"))))
(entries (node-list-filter-by-gi (children node)
(list (normalize "qandaentry"))))
(inhlabel (inherited-attribute-string (normalize "defaultlabel")))
(deflabel (if inhlabel inhlabel (qanda-defaultlabel))))
(make element gi: "DL"
(with-mode qandatoc
(process-node-list divs))
(with-mode qandatoc
(process-node-list entries)))))
(mode qandatoc
(element qandadiv
(let ((title (select-elements (children (current-node))
(normalize "title"))))
(make sequence
(make element gi: "DT"
(process-node-list title))
(make element gi: "DD"
(process-qanda-toc)))))
(element (qandadiv title)
(let* ((hnr (hierarchical-number-recursive (normalize "qandadiv")
(current-node)))
(number (let loop ((numlist hnr) (number "") (sep ""))
(if (null? numlist)
number
(loop (cdr numlist)
(string-append number
sep
(number->string (car numlist)))
".")))))
(make sequence
(literal number ". ")
(make element gi: "A"
attributes: (list (list "HREF"
(href-to (parent (current-node)))))
(process-children)))))
(element qandaentry
(process-children))
(element question
(let* ((chlist (children (current-node)))
(firstch (node-list-first chlist)))
(make element gi: "DT"
(literal (question-answer-label (current-node)) " ")
(make element gi: "A"
attributes: (list (list "HREF" (href-to (current-node))))
(process-node-list (children firstch))))))
(element answer
(empty-sosofo))
)
|
