blob: e16f1c033d59cd7520005fb52260040e29c8be5b (
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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
;; $Id: dbcallou.dsl,v 1.4 2004/10/10 14:04:48 petere78 Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;
;; The support provided below is a little primitive because there's no way
;; to do line-addressing in Jade.
;;
;; CO's are supported with the CO element or, in SCREENCO and
;; PROGRAMLISTINGCO only, AREAs.
;;
;; Notes on the use of AREAs:
;;
;; - Processing is very slow. Jade loops through each AREA for
;; every column on every line.
;; - Only the LINECOLUMN units are supported, and they are #IMPLIED
;; - If a COORDS only specifies a line, the %callout-default-col% will
;; be used for the column.
;; - If the column is beyond the end of the line, that will work OK, but
;; if more than one callout has to get placed beyond the end of the same
;; line, that doesn't work so well.
;; - Embedded tabs foul up the column counting.
;; - Embedded markup fouls up the column counting.
;; - Embedded markup with embedded line breaks fouls up the line counting.
;; - The callout bugs occur immediately before the LINE COLUMN specified.
;; - You can't point to an AREASET, that doesn't make any sense
;; since it would imply a one-to-many link
;;
;; There's still no support for a stylesheet drawing the callouts on a
;; GRAPHIC, and I don't think there ever will be.
;;
(element areaspec (empty-sosofo))
(element area (empty-sosofo))
(element areaset (empty-sosofo))
(element co
($callout-mark$ (current-node)))
(element programlistingco ($informal-object$))
(element screenco ($informal-object$))
(element graphicco ($informal-object$))
(element (screenco screen)
($callout-verbatim-display$ %indent-screen-lines% %number-screen-lines%))
(element (programlistingco programlisting)
($callout-verbatim-display$ %indent-programlisting-lines%
%number-programlisting-lines%))
;; ----------------------------------------------------------------------
(define ($callout-bug$ conumber)
(if (and conumber %callout-fancy-bug%)
(case conumber
((1) (literal "\dingbat-negative-circled-sans-serif-digit-one;"))
((2) (literal "\dingbat-negative-circled-sans-serif-digit-two;"))
((3) (literal "\dingbat-negative-circled-sans-serif-digit-three;"))
((4) (literal "\dingbat-negative-circled-sans-serif-digit-four;"))
((5) (literal "\dingbat-negative-circled-sans-serif-digit-five;"))
((6) (literal "\dingbat-negative-circled-sans-serif-digit-six;"))
((7) (literal "\dingbat-negative-circled-sans-serif-digit-seven;"))
((8) (literal "\dingbat-negative-circled-sans-serif-digit-eight;"))
((9) (literal "\dingbat-negative-circled-sans-serif-digit-nine;"))
(else (make sequence
font-weight: 'bold
(literal "(" (format-number conumber "1") ")"))))
(make sequence
font-weight: 'bold
(if conumber
(literal "(" (format-number conumber "1") ")")
(literal "(??)")))))
(define ($callout-mark$ co)
;; Print the callout mark for co
(if (equal? (gi co) (normalize "co"))
($callout-bug$ (if (node-list-empty? co)
#f
(child-number co)))
(let ((areanum (if (node-list-empty? co)
#f
(if (equal? (gi (parent co)) (normalize "areaset"))
(absolute-child-number (parent co))
(absolute-child-number co)))))
($callout-bug$ (if (node-list-empty? co)
#f
areanum)))))
(define ($look-for-callout$ line col #!optional (eol? #f))
;; Look to see if a callout should be printed at line col, and print
;; it if it should
(let* ((areaspec (select-elements (children (parent (current-node)))
(normalize "areaspec")))
(areas (expand-children (children areaspec)
(list (normalize "areaset")))))
(let loop ((areanl areas))
(if (node-list-empty? areanl)
(empty-sosofo)
(make sequence
(if ($callout-area-match$ (node-list-first areanl) line col eol?)
($callout-area-format$ (node-list-first areanl) line col eol?)
(empty-sosofo))
(loop (node-list-rest areanl)))))))
(define ($callout-area-match$ area line col eol?)
;; Does AREA area match line col?
(let* ((coordlist (split (attribute-string (normalize "coords") area)))
(aline (string->number (car coordlist)))
(acol (if (null? (cdr coordlist))
#f
(string->number (car (cdr coordlist)))))
(units (if (inherited-attribute-string (normalize "units") area)
(inherited-attribute-string (normalize "units") area)
(normalize "linecolumn"))))
(and (equal? units (normalize "linecolumn"))
(or
(and (equal? line aline)
(equal? col acol))
(and (equal? line aline)
eol?
(or (not acol) (> acol col)))))))
(define ($callout-area-format$ area line col eol?)
;; Format AREA area at the appropriate place
(let* ((coordlist (split (attribute-string (normalize "coords") area)))
(aline (string->number (car coordlist)))
(acol (if (null? (cdr coordlist))
#f
(string->number (car (cdr coordlist))))))
(if (and (equal? line aline)
eol?
(or (not acol) (> acol col)))
(make sequence
(let loop ((atcol col))
(if (>= atcol (if acol acol %callout-default-col%))
(empty-sosofo)
(make sequence
(literal "\no-break-space;")
(loop (+ atcol 1)))))
($callout-mark$ area))
($callout-mark$ area))))
(define ($callout-linespecific-content$ indent line-numbers?)
;; Print linespecific content in a callout with line numbers
(make sequence
($line-start$ indent line-numbers? 1)
(let loop ((kl (children (current-node)))
(linecount 1)
(colcount 1)
(res (empty-sosofo)))
(if (node-list-empty? kl)
(sosofo-append res
($look-for-callout$ linecount colcount #t)
(empty-sosofo))
(loop
(node-list-rest kl)
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-000D)
(+ linecount 1)
linecount)
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-000D)
1
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-0000)
colcount
(+ colcount 1)))
(let ((c (node-list-first kl)))
(if (char=? (node-property 'char c default: #\U-0000)
#\U-000D)
(sosofo-append res
($look-for-callout$ linecount colcount #t)
(process-node-list c)
($line-start$ indent
line-numbers?
(+ linecount 1)))
(sosofo-append res
($look-for-callout$ linecount colcount)
(process-node-list c)))))))))
(define ($callout-verbatim-display$ indent line-numbers?)
(let* ((width-in-chars (if (attribute-string "width")
(string->number (attribute-string "width"))
%verbatim-default-width%))
(fsize (lambda () (if (or (attribute-string (normalize "width"))
(not %verbatim-size-factor%))
(/ (/ (- %text-width% (inherited-start-indent))
width-in-chars)
0.7)
(* (inherited-font-size)
%verbatim-size-factor%))))
(vspace-before (if (INBLOCK?)
0pt
(if (INLIST?)
%para-sep%
%block-sep%)))
(vspace-after (if (INBLOCK?)
0pt
(if (INLIST?)
0pt
%block-sep%))))
(make paragraph
use: verbatim-style
space-before: (if (and (string=? (gi (parent)) (normalize "entry"))
(absolute-first-sibling?))
0pt
vspace-before)
space-after: (if (and (string=? (gi (parent)) (normalize "entry"))
(absolute-last-sibling?))
0pt
vspace-after)
font-size: (fsize)
line-spacing: (* (fsize) %line-spacing-factor%)
start-indent: (if (INBLOCK?)
(inherited-start-indent)
(+ %block-start-indent% (inherited-start-indent)))
quadding: 'start
($callout-linespecific-content$ indent line-numbers?))))
;; EOF dbcallout.dsl
|
