Mercurial > hg > xemacs-beta

comparison lisp/w3/html32.dsl @ 14:9ee227acff29 r19-15b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents
children 34a5b81f86ba
comparison
equal deleted inserted replaced
13:13c6d0aaafe5 14:9ee227acff29
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))))