14
|
1 <!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN">
|
|
2
|
|
3 ;; ######################################################################
|
|
4 ;;
|
|
5 ;; DSSSL style sheet for HTML 3.2 print output
|
|
6 ;;
|
|
7 ;; 1996.11.17
|
|
8 ;;
|
|
9 ;; Base version, August 1996: Jon Bosak, Sun Microsystems, based on work
|
|
10 ;; by Anders Berglund, EBT, with critical assistance from James Clark
|
|
11 ;; TOC section and recto/verso page treatments based on models by James
|
|
12 ;; Clark, October 1996
|
|
13 ;;
|
|
14 ;; ######################################################################
|
|
15
|
|
16 ;; Features in HTML 3.2 that are not implemented in the style sheet:
|
|
17 ;;
|
|
18 ;; automatic table column widths
|
|
19 ;; % on width attribute for TABLE
|
|
20 ;; attributes on TH and TD: align, valign, rowspan, colspan
|
|
21 ;; attributes on TABLE: width, align, border, cellspacing, cellpadding
|
|
22 ;; start attribute on OL
|
|
23 ;; value attribute on LI
|
|
24 ;; noshade attribute on HR
|
|
25 ;;
|
|
26 ;; See also "Non-Printing Elements" below
|
|
27 ;;
|
|
28 ;; Features in the style sheet that are not in HTML 3.2:
|
|
29 ;;
|
|
30 ;; page headers that display the HEAD TITLE content
|
|
31 ;; page footers that display the page number
|
|
32 ;; autonumbering of heads and table captions
|
|
33 ;; support for named units (pt, pi, cm, mm) in size attributes
|
|
34 ;; automatic TOC generation
|
|
35
|
|
36 ;; ============================== UNITS ================================
|
|
37
|
|
38 (define-unit pi (/ 1in 6))
|
|
39 (define-unit pt (/ 1in 72))
|
|
40 (define-unit px (/ 1in 96))
|
|
41
|
|
42 ;; see below for definition of "em"
|
|
43
|
|
44
|
|
45 ;; ============================ PARAMETERS ==============================
|
|
46
|
|
47 ;; ........................... Basic "look" .............................
|
|
48
|
|
49 ;; Visual acuity levels are "normal", "presbyopic", and
|
|
50 ;; "large-type"; set the line following to choose the level
|
|
51
|
|
52 (define %visual-acuity% "normal")
|
|
53 ;; (define %visual-acuity% "presbyopic")
|
|
54 ;; (define %visual-acuity% "large-type")
|
|
55
|
|
56 (define %bf-size%
|
|
57 (case %visual-acuity%
|
|
58 (("normal") 11pt)
|
|
59 (("presbyopic") 12pt)
|
|
60 (("large-type") 24pt)))
|
|
61 (define %mf-size% (- %bf-size% 1pt))
|
|
62 (define %hf-size% %bf-size%)
|
|
63
|
|
64 (define-unit em %bf-size%)
|
|
65
|
|
66 (define %autonum-level% 6) ;; zero disables autonumbering
|
|
67 (define %flushtext-headlevel% ;; heads above this hang out on the left
|
|
68 (if (equal? %visual-acuity% "large-type") 6 4))
|
|
69 (define %body-start-indent% ;; sets the white space on the left
|
|
70 (if (equal? %visual-acuity% "large-type") 0pi 4pi))
|
|
71 (define %toc?% #t) ;; enables TOC after H1
|
|
72
|
|
73 ;; ........................ Basic page geometry .........................
|
|
74
|
|
75 (define %page-width% 8.5in)
|
|
76 (define %page-height% 11in)
|
|
77
|
|
78 (define %left-right-margin% 6pi)
|
|
79 (define %top-margin%
|
|
80 (if (equal? %visual-acuity% "large-type") 7.5pi 6pi))
|
|
81 (define %bottom-margin%
|
|
82 (if (equal? %visual-acuity% "large-type") 7.5pi 6pi))
|
|
83 (define %header-margin%
|
|
84 (if (equal? %visual-acuity% "large-type") 4.5pi 3pi))
|
|
85 (define %footer-margin% 3.5pi)
|
|
86
|
|
87 (define %text-width% (- %page-width% (* %left-right-margin% 2)))
|
|
88 (define %body-width% (- %text-width% %body-start-indent%))
|
|
89
|
|
90 ;; .......................... Spacing factors ...........................
|
|
91
|
|
92 (define %para-sep% (/ %bf-size% 2.0))
|
|
93 (define %block-sep% (* %para-sep% 2.0))
|
|
94
|
|
95 (define %line-spacing-factor% 1.2)
|
|
96 (define %bf-line-spacing% (* %bf-size% %line-spacing-factor%))
|
|
97 (define %mf-line-spacing% (* %mf-size% %line-spacing-factor%))
|
|
98 (define %hf-line-spacing% (* %hf-size% %line-spacing-factor%))
|
|
99
|
|
100 (define %head-before-factor% 1.0)
|
|
101 (define %head-after-factor% 0.6)
|
|
102 (define %hsize-bump-factor% 1.2)
|
|
103
|
|
104 (define %ss-size-factor% 0.6)
|
|
105 (define %ss-shift-factor% 0.4)
|
|
106 (define %smaller-size-factor% 0.9)
|
|
107 (define %bullet-size-factor% 0.8)
|
|
108
|
|
109 ;; ......................... Fonts and bullets ..........................
|
|
110
|
|
111 ;; these font selections are for Windows 95
|
|
112
|
|
113 (define %title-font-family% "Arial")
|
|
114 (define %body-font-family% "Times New Roman")
|
|
115 (define %mono-font-family% "Courier New")
|
|
116 (define %dingbat-font-family% "Wingdings")
|
|
117
|
|
118 ;; these "bullet strings" are a hack that is completely dependent on
|
|
119 ;; the Wingdings font family selected above; consider this a
|
|
120 ;; placeholder for suitable ISO 10646 characters
|
|
121
|
|
122 (define %disk-bullet% "l")
|
|
123 (define %circle-bullet% "¡")
|
|
124 (define %square-bullet% "o")
|
|
125
|
|
126 (define %bullet-size% (* %bf-size% %bullet-size-factor%))
|
|
127
|
|
128
|
|
129 ;; ========================== COMMON FUNCTIONS ==========================
|
|
130
|
|
131 (define (expt b n)
|
|
132 (if (= n 0)
|
|
133 1
|
|
134 (* b (expt b (- n 1)))))
|
|
135
|
|
136 ;; per ISO/IEC 10179
|
|
137 (define (node-list-reduce nl proc init)
|
|
138 (if (node-list-empty? nl)
|
|
139 init
|
|
140 (node-list-reduce (node-list-rest nl)
|
|
141 proc
|
|
142 (proc init (node-list-first nl)))))
|
|
143
|
|
144 ;; per ISO/IEC 10179
|
|
145 (define (node-list-length nl)
|
|
146 (node-list-reduce nl
|
|
147 (lambda (result snl)
|
|
148 (+ result 1))
|
|
149 0))
|
|
150
|
|
151 (define if-front-page
|
|
152 (external-procedure "UNREGISTERED::James Clark//Procedure::if-front-page"))
|
|
153
|
|
154 (define if-first-page
|
|
155 (external-procedure "UNREGISTERED::James Clark//Procedure::if-first-page"))
|
|
156
|
|
157 (define upperalpha
|
|
158 '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
|
|
159 #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
|
|
160
|
|
161 (define loweralpha
|
|
162 '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
|
|
163 #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
|
|
164
|
|
165 (define (char-downcase ch)
|
|
166 (case ch
|
|
167 ((#\A) #\a) ((#\B) #\b) ((#\C) #\c) ((#\D) #\d) ((#\E) #\e)
|
|
168 ((#\F) #\f) ((#\G) #\g) ((#\H) #\h) ((#\I) #\i) ((#\J) #\j)
|
|
169 ((#\K) #\k) ((#\L) #\l) ((#\M) #\m) ((#\N) #\n) ((#\O) #\o)
|
|
170 ((#\P) #\p) ((#\Q) #\q) ((#\R) #\r) ((#\S) #\s) ((#\T) #\t)
|
|
171 ((#\U) #\u) ((#\V) #\v) ((#\W) #\w) ((#\X) #\x) ((#\Y) #\y)
|
|
172 ((#\Z) #\z) (else ch)))
|
|
173
|
|
174 (define (LOCASE slist)
|
|
175 (if (null? slist)
|
|
176 '()
|
|
177 (cons (char-downcase (car slist)) (LOCASE (cdr slist)))))
|
|
178
|
|
179 (define (STR2LIST s)
|
|
180 (let ((len (string-length s)))
|
|
181 (let loop ((i 0) (ln len))
|
|
182 (if (= i len)
|
|
183 '()
|
|
184 (cons (string-ref s i) (loop (+ i 1) ln))))))
|
|
185
|
|
186 (define (STRING-DOWNCASE s)
|
|
187 (apply string (LOCASE (STR2LIST s))))
|
|
188
|
|
189 (define (UNAME-START-INDEX u last)
|
|
190 (let ((c (string-ref u last)))
|
|
191 (if (or (member c upperalpha) (member c loweralpha))
|
|
192 (if (= last 0)
|
|
193 0
|
|
194 (UNAME-START-INDEX u (- last 1)))
|
|
195 (+ last 1))))
|
|
196
|
|
197 (define (PARSEDUNIT u) ;; this doesn't deal with "%" yet
|
|
198 (if (string? u)
|
|
199 (let ((strlen (string-length u)))
|
|
200 (if (> strlen 2)
|
|
201 (let ((u-s-i (UNAME-START-INDEX u (- strlen 1))))
|
|
202 (if (= u-s-i 0) ;; there's no number here
|
|
203 1pi ;; so return something that might work
|
|
204 (if (= u-s-i strlen) ;; there's no unit name here
|
|
205 (* (string->number u) 1px) ;; so default to pixels (3.2)
|
|
206 (let* ((unum (string->number
|
|
207 (substring u 0 u-s-i)))
|
|
208 (uname (STRING-DOWNCASE
|
|
209 (substring u u-s-i strlen))))
|
|
210 (case uname
|
|
211 (("mm") (* unum 1mm))
|
|
212 (("cm") (* unum 1cm))
|
|
213 (("in") (* unum 1in))
|
|
214 (("pi") (* unum 1pi))
|
|
215 (("pc") (* unum 1pi))
|
|
216 (("pt") (* unum 1pt))
|
|
217 (("px") (* unum 1px))
|
|
218 (("barleycorn") (* unum 2pi)) ;; extensible!
|
|
219 (else
|
|
220 (cond
|
|
221 ((number? unum)
|
|
222 (* unum 1px))
|
|
223 ((number? (string->number u))
|
|
224 (* (string->number u) 1px))
|
|
225 (else u))))))))
|
|
226 (if (number? (string->number u))
|
|
227 (* (string->number u) 1px)
|
|
228 1pi)))
|
|
229 1pi))
|
|
230
|
|
231 (define (INLIST?)
|
|
232 (or
|
|
233 (have-ancestor? "OL")
|
|
234 (have-ancestor? "UL")
|
|
235 (have-ancestor? "DIR")
|
|
236 (have-ancestor? "MENU")
|
|
237 (have-ancestor? "DL")))
|
|
238
|
|
239 (define (INHEAD?)
|
|
240 (or
|
|
241 (have-ancestor? "H1")
|
|
242 (have-ancestor? "H2")
|
|
243 (have-ancestor? "H3")
|
|
244 (have-ancestor? "H4")
|
|
245 (have-ancestor? "H5")
|
|
246 (have-ancestor? "H6")))
|
|
247
|
|
248 (define (HSIZE n)
|
|
249 (* %bf-size%
|
|
250 (expt %hsize-bump-factor% n)))
|
|
251
|
|
252 (define (OLSTEP)
|
|
253 (case (modulo (length (hierarchical-number-recursive "OL")) 4)
|
|
254 ((1) 1.2em)
|
|
255 ((2) 1.2em)
|
|
256 ((3) 1.6em)
|
|
257 ((0) 1.4em)))
|
|
258
|
|
259 (define (ULSTEP) 1em)
|
|
260
|
|
261 (define (PQUAD)
|
|
262 (case (attribute-string "align")
|
|
263 (("LEFT") 'start)
|
|
264 (("CENTER") 'center)
|
|
265 (("RIGHT") 'end)
|
|
266 (else (inherited-quadding))))
|
|
267
|
|
268 (define (HQUAD)
|
|
269 (cond
|
|
270 ((string? (attribute-string "align")) (PQUAD))
|
|
271 ((have-ancestor? "CENTER") 'center)
|
|
272 ((have-ancestor? "DIV") (inherited-quadding))
|
|
273 (else 'start)))
|
|
274
|
|
275 (define (BULLSTR sty)
|
|
276 (case sty
|
|
277 (("circle") %circle-bullet%)
|
|
278 (("square") %square-bullet%)
|
|
279 (else %disk-bullet%)))
|
|
280
|
|
281
|
|
282 ;; ======================= NON-PRINTING ELEMENTS ========================
|
|
283
|
|
284 ;; Note that HEAD includes TITLE, ISINDEX, BASE, META, STYLE,
|
|
285 ;; SCRIPT, and LINK as possible children
|
|
286
|
|
287 (element HEAD (empty-sosofo))
|
|
288 (element FORM (empty-sosofo))
|
|
289 (element APPLET (empty-sosofo))
|
|
290 (element PARAM (empty-sosofo))
|
|
291 (element TEXTFLOW (empty-sosofo))
|
|
292 (element MAP (empty-sosofo))
|
|
293 (element AREA (empty-sosofo))
|
|
294
|
|
295
|
|
296 ;; ========================== TABLE OF CONTENTS =========================
|
|
297
|
|
298 ;; Container elements in which to look for headings
|
|
299 (define %clist% '("BODY" "DIV" "CENTER" "BLOCKQUOTE" "FORM"))
|
|
300
|
|
301 (mode toc
|
|
302 (element h1 (empty-sosofo))
|
|
303 (element h2 ($toc-entry$ 2))
|
|
304 (element h3 ($toc-entry$ 3))
|
|
305 (element h4 ($toc-entry$ 4))
|
|
306 (element h5 ($toc-entry$ 5))
|
|
307 (element h6 ($toc-entry$ 6))
|
|
308 (default (apply process-matching-children
|
|
309 (append %hlist% %clist%)))
|
|
310 )
|
|
311
|
|
312 (define %toc-indent% 1em)
|
|
313
|
|
314 (define ($toc-entry$ level)
|
|
315 (make paragraph
|
|
316 use: para-style
|
|
317 start-indent: (+ %body-start-indent%
|
|
318 (* %toc-indent% (+ 1 level)))
|
|
319 first-line-start-indent: (* -3 %toc-indent%)
|
|
320 quadding: 'start
|
|
321 (literal (NUMLABEL level))
|
|
322 (make link
|
|
323 destination: (current-node-address)
|
|
324 (with-mode #f (process-children-trim)))
|
|
325 (make leader (literal "."))
|
|
326 (current-node-page-number-sosofo)))
|
|
327
|
|
328 (define (MAKEBODYRULE)
|
|
329 (make rule
|
|
330 orientation: 'horizontal
|
|
331 space-before: (* 2 %block-sep%)
|
|
332 space-after: (* 2 %block-sep%)
|
|
333 line-thickness: 1pt
|
|
334 length: %body-width%
|
|
335 start-indent: %body-start-indent%
|
|
336 display-alignment: 'start))
|
|
337
|
|
338 (define (MAKETOC)
|
|
339 (if %toc?%
|
|
340 (sosofo-append
|
|
341 (MAKEBODYRULE)
|
|
342 (make paragraph
|
|
343 font-family-name: %title-font-family%
|
|
344 font-weight: 'bold
|
|
345 font-posture: 'upright
|
|
346 font-size: (HSIZE 2)
|
|
347 line-spacing: (* (HSIZE 2) %line-spacing-factor%)
|
|
348 space-before: (* (HSIZE 2) %head-before-factor%)
|
|
349 space-after: (* (HSIZE 2) %head-after-factor%)
|
|
350 start-indent: %body-start-indent%
|
|
351 quadding: 'start
|
|
352 keep-with-next?: #t
|
|
353 (literal "Table of Contents"))
|
|
354 (with-mode toc
|
|
355 (process-node-list (ancestor "BODY")))
|
|
356 (MAKEBODYRULE))
|
|
357 (empty-sosofo)))
|
|
358
|
|
359 ;; ============================ TOP LEVEL ===============================
|
|
360
|
|
361 (define page-style
|
|
362 (style
|
|
363 page-width: %page-width%
|
|
364 page-height: %page-height%
|
|
365 left-margin: %left-right-margin%
|
|
366 right-margin: %left-right-margin%
|
|
367 top-margin: %top-margin%
|
|
368 bottom-margin: %bottom-margin%
|
|
369 header-margin: %header-margin%
|
|
370 footer-margin: %footer-margin%
|
|
371 font-family-name: %body-font-family%
|
|
372 font-size: %bf-size%
|
|
373 line-spacing: %bf-line-spacing%))
|
|
374
|
|
375 (element HTML
|
|
376 (let ((page-footer
|
|
377 (make sequence
|
|
378 font-size: %hf-size%
|
|
379 line-spacing: %hf-line-spacing%
|
|
380 font-posture: 'italic
|
|
381 (literal "Page ")
|
|
382 (page-number-sosofo)))
|
|
383 (page-header
|
|
384 (make sequence
|
|
385 font-size: %hf-size%
|
|
386 line-spacing: %hf-line-spacing%
|
|
387 font-posture: 'italic
|
|
388 (process-first-descendant "TITLE"))))
|
|
389 (make simple-page-sequence
|
|
390 use: page-style
|
|
391 left-header: (if-first-page
|
|
392 (empty-sosofo)
|
|
393 (if-front-page (empty-sosofo) page-header))
|
|
394 right-header: (if-first-page
|
|
395 (empty-sosofo)
|
|
396 (if-front-page page-header (empty-sosofo)))
|
|
397 left-footer: (if-first-page
|
|
398 (empty-sosofo)
|
|
399 (if-front-page (empty-sosofo) page-footer))
|
|
400 right-footer: (if-first-page
|
|
401 (empty-sosofo)
|
|
402 (if-front-page page-footer (empty-sosofo)))
|
|
403 input-whitespace-treatment: 'collapse
|
|
404 quadding: 'justify
|
|
405 (process-children-trim))))
|
|
406
|
|
407 (element BODY (process-children-trim))
|
|
408
|
|
409 ;; ========================== BLOCK ELEMENTS ============================
|
|
410
|
|
411 ;; ............................ Generic DIV .............................
|
|
412
|
|
413 (element DIV
|
|
414 (let ((align (attribute-string "align")))
|
|
415 (make display-group
|
|
416 quadding:
|
|
417 (case align
|
|
418 (("LEFT") 'start)
|
|
419 (("CENTER") 'center)
|
|
420 (("RIGHT") 'end)
|
|
421 (else 'justify))
|
|
422 (process-children-trim))))
|
|
423
|
|
424 (element CENTER
|
|
425 (make display-group
|
|
426 quadding: 'center
|
|
427 (process-children-trim)))
|
|
428
|
|
429
|
|
430 ;; .............................. Headings ..............................
|
|
431
|
|
432 (define %hlist% '("H1" "H2" "H3" "H4" "H5" "H6"))
|
|
433
|
|
434 (define (NUMLABEL hlvl)
|
|
435 (let ((enl (element-number-list
|
|
436 (reverse (list-tail (reverse %hlist%) (- 6 hlvl))))))
|
|
437 (let loop ((idx 1))
|
|
438 (if (or (= idx %autonum-level%) (= idx hlvl))
|
|
439 (if (= idx 2) ". " " ")
|
|
440 (let ((thisnum (list-ref enl idx)))
|
|
441 (string-append
|
|
442 (if (> idx 1) "." "")
|
|
443 (format-number thisnum "1")
|
|
444 (loop (+ idx 1))))))))
|
|
445
|
|
446 (define ($heading$ headlevel)
|
|
447 (let ((headsize (if (= headlevel 6) 0 (- 5 headlevel))))
|
|
448 (make paragraph
|
|
449 font-family-name: %title-font-family%
|
|
450 font-weight: (if (< headlevel 6) 'bold 'medium)
|
|
451 font-posture: (if (< headlevel 6) 'upright 'italic)
|
|
452 font-size: (HSIZE headsize)
|
|
453 line-spacing: (* (HSIZE headsize) %line-spacing-factor%)
|
|
454 space-before: (* (HSIZE headsize) %head-before-factor%)
|
|
455 space-after: (if (and %toc?% (= headlevel 1))
|
|
456 4em ;; space if H1 before TOC
|
|
457 (* (HSIZE headsize) %head-after-factor%))
|
|
458 start-indent:
|
|
459 (if (< headlevel %flushtext-headlevel%)
|
|
460 0pt
|
|
461 %body-start-indent%)
|
|
462 quadding: (HQUAD)
|
|
463 keep-with-next?: #t
|
|
464 break-before: (if (and
|
|
465 %toc?%
|
|
466 (= headlevel 2)
|
|
467 (= (child-number) 1))
|
|
468 'page #f) ;; if TOC on, break before first H2
|
|
469 (literal
|
|
470 (if (and (<= headlevel %autonum-level%) (> headlevel 1))
|
|
471 (NUMLABEL headlevel)
|
|
472 (string-append "")))
|
|
473 (process-children-trim))))
|
|
474
|
|
475 (element H1
|
|
476 (sosofo-append
|
|
477 ($heading$ 1)
|
|
478 (MAKETOC)))
|
|
479
|
|
480 (element H2 ($heading$ 2))
|
|
481 (element H3 ($heading$ 3))
|
|
482 (element H4 ($heading$ 4))
|
|
483 (element H5 ($heading$ 5))
|
|
484 (element H6 ($heading$ 6))
|
|
485
|
|
486
|
|
487 ;; ............................ Paragraphs ..............................
|
|
488
|
|
489 (define para-style
|
|
490 (style
|
|
491 font-size: %bf-size%
|
|
492 font-weight: 'medium
|
|
493 font-posture: 'upright
|
|
494 font-family-name: %body-font-family%
|
|
495 line-spacing: %bf-line-spacing%))
|
|
496
|
|
497 (element P
|
|
498 (make paragraph
|
|
499 use: para-style
|
|
500 space-before: %para-sep%
|
|
501 start-indent: %body-start-indent%
|
|
502 quadding: (PQUAD)
|
|
503 (process-children-trim)))
|
|
504
|
|
505 (element ADDRESS
|
|
506 (make paragraph
|
|
507 use: para-style
|
|
508 font-posture: 'italic
|
|
509 space-before: %para-sep%
|
|
510 start-indent: %body-start-indent%
|
|
511 (process-children-trim)))
|
|
512
|
|
513 (element BLOCKQUOTE
|
|
514 (make paragraph
|
|
515 font-size: (- %bf-size% 1pt)
|
|
516 line-spacing: (- %bf-line-spacing% 1pt)
|
|
517 space-before: %para-sep%
|
|
518 start-indent: (+ %body-start-indent% 1em)
|
|
519 end-indent: 1em
|
|
520 (process-children-trim)))
|
|
521
|
|
522 (define ($monopara$)
|
|
523 (make paragraph
|
|
524 use: para-style
|
|
525 space-before: %para-sep%
|
|
526 start-indent: %body-start-indent%
|
|
527 lines: 'asis
|
|
528 font-family-name: %mono-font-family%
|
|
529 font-size: %mf-size%
|
|
530 input-whitespace-treatment: 'preserve
|
|
531 quadding: 'start
|
|
532 (process-children-trim)))
|
|
533
|
|
534 (element PRE ($monopara$))
|
|
535 (element XMP ($monopara$))
|
|
536 (element LISTING ($monopara$))
|
|
537 (element PLAINTEXT ($monopara$))
|
|
538
|
|
539 (element BR
|
|
540 (make display-group
|
|
541 (empty-sosofo)))
|
|
542
|
|
543
|
|
544 ;; ................... Lists: UL, OL, DIR, MENU, DL .....................
|
|
545
|
|
546 (define ($list-container$)
|
|
547 (make display-group
|
|
548 space-before: (if (INLIST?) %para-sep% %block-sep%)
|
|
549 space-after: (if (INLIST?) %para-sep% %block-sep%)
|
|
550 start-indent: (if (INLIST?)
|
|
551 (inherited-start-indent)
|
|
552 %body-start-indent%)))
|
|
553
|
|
554 (define ($li-para$)
|
|
555 (make paragraph
|
|
556 use: para-style
|
|
557 start-indent: (+ (inherited-start-indent) (OLSTEP))
|
|
558 first-line-start-indent: (- (OLSTEP))
|
|
559 (process-children-trim)))
|
|
560
|
|
561 (element UL ($list-container$))
|
|
562
|
|
563 (element (UL LI)
|
|
564 (let ((isnested (> (length (hierarchical-number-recursive "UL")) 1)))
|
|
565 (make paragraph
|
|
566 use: para-style
|
|
567 space-before:
|
|
568 (if (attribute-string "compact" (ancestor "UL")) 0pt %para-sep%)
|
|
569 start-indent: (+ (inherited-start-indent) (ULSTEP))
|
|
570 first-line-start-indent: (- (ULSTEP))
|
|
571 (make line-field
|
|
572 font-family-name: %dingbat-font-family%
|
|
573 font-size: (if isnested
|
|
574 (* %bullet-size% %bullet-size-factor%)
|
|
575 %bullet-size%)
|
|
576 field-width: (ULSTEP)
|
|
577 (literal
|
|
578 (let
|
|
579 ((litype
|
|
580 (attribute-string "type"))
|
|
581 (ultype
|
|
582 (attribute-string "type" (ancestor "UL"))))
|
|
583 (cond
|
|
584 ((string? litype) (BULLSTR (STRING-DOWNCASE litype)))
|
|
585 ((string? ultype) (BULLSTR (STRING-DOWNCASE ultype)))
|
|
586 (else %disk-bullet%)))))
|
|
587 (process-children-trim))))
|
|
588
|
|
589 (element (UL LI P) ($li-para$))
|
|
590
|
|
591 (element OL ($list-container$))
|
|
592
|
|
593 (element (OL LI)
|
|
594 (make paragraph
|
|
595 use: para-style
|
|
596 space-before:
|
|
597 (if (attribute-string "compact" (ancestor "OL")) 0pt %para-sep%)
|
|
598 start-indent: (+ (inherited-start-indent) (OLSTEP))
|
|
599 first-line-start-indent: (- (OLSTEP))
|
|
600 (make line-field
|
|
601 field-width: (OLSTEP)
|
|
602 (literal
|
|
603 (case (modulo
|
|
604 (length (hierarchical-number-recursive "OL")) 4)
|
|
605 ((1) (string-append
|
|
606 (format-number (child-number) "1") "."))
|
|
607 ((2) (string-append
|
|
608 (format-number (child-number) "a") "."))
|
|
609 ((3) (string-append
|
|
610 "(" (format-number (child-number) "i") ")"))
|
|
611 ((0) (string-append
|
|
612 "(" (format-number (child-number) "a") ")")))))
|
|
613 (process-children-trim)))
|
|
614
|
|
615 (element (OL LI P) ($li-para$))
|
|
616
|
|
617 ;; Note that DIR cannot properly have block children. Here DIR is
|
|
618 ;; interpreted as an unmarked list without extra vertical
|
|
619 ;; spacing.
|
|
620
|
|
621 (element DIR ($list-container$))
|
|
622
|
|
623 (element (DIR LI)
|
|
624 (make paragraph
|
|
625 use: para-style
|
|
626 start-indent: (+ (inherited-start-indent) (* 2.0 (ULSTEP)))
|
|
627 first-line-start-indent: (- (ULSTEP))
|
|
628 (process-children-trim)))
|
|
629
|
|
630 ;; Note that MENU cannot properly have block children. Here MENU is
|
|
631 ;; interpreted as a small-bulleted list with no extra vertical
|
|
632 ;; spacing.
|
|
633
|
|
634 (element MENU ($list-container$))
|
|
635
|
|
636 (element (MENU LI)
|
|
637 (make paragraph
|
|
638 use: para-style
|
|
639 start-indent: (+ (inherited-start-indent) (ULSTEP))
|
|
640 first-line-start-indent: (- (ULSTEP))
|
|
641 (make line-field
|
|
642 font-family-name: %dingbat-font-family%
|
|
643 font-size: %bullet-size%
|
|
644 field-width: (ULSTEP)
|
|
645 (literal %disk-bullet%))
|
|
646 (process-children-trim)))
|
|
647
|
|
648 ;; This treatment of DLs doesn't apply a "compact" attribute set at one
|
|
649 ;; level to any nested DLs. To change this behavior so that nested
|
|
650 ;; DLs inherit the "compact" attribute from an ancestor DL, substitute
|
|
651 ;; "inherited-attribute-string" for "attribute-string" in the
|
|
652 ;; construction rules for DT and DD.
|
|
653
|
|
654
|
|
655 (element DL
|
|
656 (make display-group
|
|
657 space-before: (if (INLIST?) %para-sep% %block-sep%)
|
|
658 space-after: (if (INLIST?) %para-sep% %block-sep%)
|
|
659 start-indent: (if (INLIST?)
|
|
660 (+ (inherited-start-indent) 2em)
|
|
661 (+ %body-start-indent% 2em))
|
|
662 (make paragraph)))
|
|
663
|
|
664 (element DT
|
|
665 (let ((compact (attribute-string "compact" (ancestor "DL"))))
|
|
666 (if compact
|
|
667 (make line-field
|
|
668 field-width: 3em
|
|
669 (process-children-trim))
|
|
670 (make paragraph
|
|
671 use: para-style
|
|
672 space-before: %para-sep%
|
|
673 first-line-start-indent: -1em
|
|
674 (process-children-trim)))))
|
|
675
|
|
676 (element DD
|
|
677 (let ((compact (attribute-string "compact" (ancestor "DL"))))
|
|
678 (if compact
|
|
679 (sosofo-append
|
|
680 (process-children-trim)
|
|
681 (make paragraph-break))
|
|
682 (make paragraph
|
|
683 use: para-style
|
|
684 start-indent: (+ (inherited-start-indent) 2em)
|
|
685 (process-children-trim)))))
|
|
686
|
|
687
|
|
688 ;; ========================== INLINE ELEMENTS ===========================
|
|
689
|
|
690 (define ($bold-seq$)
|
|
691 (make sequence
|
|
692 font-weight: 'bold
|
|
693 (process-children-trim)))
|
|
694
|
|
695 (element B ($bold-seq$))
|
|
696 (element EM ($bold-seq$))
|
|
697 (element STRONG ($bold-seq$))
|
|
698
|
|
699 ;; ------------
|
|
700
|
|
701 (define ($italic-seq$)
|
|
702 (make sequence
|
|
703 font-posture: 'italic
|
|
704 (process-children-trim)))
|
|
705
|
|
706 (element I ($italic-seq$))
|
|
707 (element CITE ($italic-seq$))
|
|
708 (element VAR ($italic-seq$))
|
|
709
|
|
710 ;; ------------
|
|
711
|
|
712 (define ($bold-italic-seq$)
|
|
713 (make sequence
|
|
714 font-weight: 'bold
|
|
715 font-posture: 'italic
|
|
716 (process-children-trim)))
|
|
717
|
|
718 (element DFN ($bold-italic-seq$))
|
|
719 (element A
|
|
720 (if (INHEAD?)
|
|
721 (process-children-trim)
|
|
722 ($bold-italic-seq$)))
|
|
723
|
|
724 ;; ------------
|
|
725
|
|
726 (define ($mono-seq$)
|
|
727 (make sequence
|
|
728 font-family-name: %mono-font-family%
|
|
729 font-size: %mf-size%
|
|
730 (process-children-trim)))
|
|
731
|
|
732 (element TT ($mono-seq$))
|
|
733 (element CODE ($mono-seq$))
|
|
734 (element KBD ($mono-seq$))
|
|
735 (element SAMP ($mono-seq$))
|
|
736
|
|
737 ;; ------------
|
|
738
|
|
739 (define ($score-seq$ stype)
|
|
740 (make score
|
|
741 type: stype
|
|
742 (process-children-trim)))
|
|
743
|
|
744 (element STRIKE ($score-seq$ 'through))
|
|
745 (element U ($score-seq$ 'after))
|
|
746
|
|
747 ;; ------------
|
|
748
|
|
749 (define ($ss-seq$ plus-or-minus)
|
|
750 (make sequence
|
|
751 font-size:
|
|
752 (* (inherited-font-size) %ss-size-factor%)
|
|
753 position-point-shift:
|
|
754 (plus-or-minus (* (inherited-font-size) %ss-shift-factor%))
|
|
755 (process-children-trim)))
|
|
756
|
|
757 (element SUP ($ss-seq$ +))
|
|
758 (element SUB ($ss-seq$ -))
|
|
759
|
|
760 ;; ------------
|
|
761
|
|
762 (define ($bs-seq$ div-or-mult)
|
|
763 (make sequence
|
|
764 font-size:
|
|
765 (div-or-mult (inherited-font-size) %smaller-size-factor%)
|
|
766 line-spacing:
|
|
767 (div-or-mult (inherited-line-spacing) %smaller-size-factor%)))
|
|
768
|
|
769 (element BIG ($bs-seq$ /))
|
|
770 (element SMALL ($bs-seq$ *))
|
|
771
|
|
772 ;; ------------
|
|
773
|
|
774 (element FONT
|
|
775 (let ((fsize (attribute-string "SIZE")))
|
|
776 (make sequence
|
|
777 font-size:
|
|
778 (if fsize (PARSEDUNIT fsize) (inherited-font-size)))))
|
|
779
|
|
780
|
|
781 ;; ============================== RULES =================================
|
|
782
|
|
783 (element HR
|
|
784 (let ((align (attribute-string "ALIGN"))
|
|
785 (noshade (attribute-string "NOSHADE"))
|
|
786 (size (attribute-string "SIZE"))
|
|
787 (width (attribute-string "WIDTH")))
|
|
788 (make rule
|
|
789 orientation: 'horizontal
|
|
790 space-before: %block-sep%
|
|
791 space-after: %block-sep%
|
|
792 line-thickness: (if size (PARSEDUNIT size) 1pt)
|
|
793 length: (if width (PARSEDUNIT width) %body-width%)
|
|
794 display-alignment:
|
|
795 (case align
|
|
796 (("LEFT") 'start)
|
|
797 (("CENTER") 'center)
|
|
798 (("RIGHT") 'end)
|
|
799 (else 'end)))))
|
|
800
|
|
801
|
|
802 ;; ============================= GRAPHICS ===============================
|
|
803
|
|
804 ;; Note that DSSSL does not currently support text flowed around an
|
|
805 ;; object, so the action of the ALIGN attribute is merely to shift the
|
|
806 ;; image to the left or right. An extension to add runarounds to DSSSL
|
|
807 ;; has been proposed and should be incorporated here when it becomes
|
|
808 ;; final.
|
|
809
|
|
810 (element IMG
|
|
811 (make external-graphic
|
|
812 entity-system-id: (attribute-string "src")
|
|
813 display?: #t
|
|
814 space-before: 1em
|
|
815 space-after: 1em
|
|
816 display-alignment:
|
|
817 (case (attribute-string "align")
|
|
818 (("LEFT") 'start)
|
|
819 (("RIGHT") 'end)
|
|
820 (else 'center))))
|
|
821
|
|
822 ;; ============================== TABLES ================================
|
|
823
|
|
824 (element TABLE
|
|
825 ;; number-of-columns is for future use
|
|
826 (let ((number-of-columns
|
|
827 (node-list-reduce (node-list-rest (children (current-node)))
|
|
828 (lambda (cols nd)
|
|
829 (max cols
|
|
830 (node-list-length (children nd))))
|
|
831 0)))
|
|
832 (make display-group
|
|
833 space-before: %block-sep%
|
|
834 space-after: %block-sep%
|
|
835 start-indent: %body-start-indent%
|
|
836 ;; for debugging:
|
|
837 ;; (make paragraph
|
|
838 ;; (literal
|
|
839 ;; (string-append
|
|
840 ;; "Number of columns: "
|
|
841 ;; (number->string number-of-columns))))
|
|
842 (with-mode table-caption-mode (process-first-descendant "CAPTION"))
|
|
843 (make table
|
|
844 (process-children)))))
|
|
845
|
|
846 (mode table-caption-mode
|
|
847 (element CAPTION
|
|
848 (make paragraph
|
|
849 use: para-style
|
|
850 font-weight: 'bold
|
|
851 space-before: %block-sep%
|
|
852 space-after: %para-sep%
|
|
853 start-indent: (inherited-start-indent)
|
|
854 (literal
|
|
855 (string-append
|
|
856 "Table "
|
|
857 (format-number
|
|
858 (element-number) "1") ". "))
|
|
859 (process-children-trim))))
|
|
860
|
|
861 (element CAPTION (empty-sosofo)) ; don't show caption inside the table
|
|
862
|
|
863 (element TR
|
|
864 (make table-row
|
|
865 (process-children-trim)))
|
|
866
|
|
867 (element TH
|
|
868 (make table-cell
|
|
869 n-rows-spanned: (string->number (attribute-string "COLSPAN"))
|
|
870 (make paragraph
|
|
871 font-weight: 'bold
|
|
872 space-before: 0.25em
|
|
873 space-after: 0.25em
|
|
874 start-indent: 0.25em
|
|
875 end-indent: 0.25em
|
|
876 quadding: 'start
|
|
877 (process-children-trim))))
|
|
878
|
|
879 (element TD
|
|
880 (make table-cell
|
|
881 n-rows-spanned: (string->number (attribute-string "COLSPAN"))
|
|
882 (make paragraph
|
|
883 space-before: 0.25em
|
|
884 space-after: 0.25em
|
|
885 start-indent: 0.25em
|
|
886 end-indent: 0.25em
|
|
887 quadding: 'start
|
|
888 (process-children-trim))))
|