1;; $Id: dbcompon.dsl,v 1.5 2003/04/29 06:33:10 adicarlo Exp $
2;;
3;; This file is part of the Modular DocBook Stylesheet distribution.
4;; See ../README or http://nwalsh.com/docbook/dsssl/
5;;
6
7;; ============================= COMPONENTS =============================
8;;
9;; in docbook, components are containers at the chapter/appendix level
10
11(define ($title-header-footer-element$)
12  (let* ((firstchild (node-list-first (children (current-node))))
13	 (metainfo   (if (node-list-empty? firstchild)
14			 (empty-node-list)
15			 (if (member (gi firstchild) (info-element-list))
16			     firstchild
17			     (empty-node-list))))
18	 (metatitle  (select-elements (children metainfo) (normalize "title")))
19	 (metatabb   (select-elements (children metainfo) (normalize "titleabbrev")))
20	 (title      (select-elements (children (current-node))
21				      (normalize "title")))
22	 (titleabb   (select-elements (children (current-node))
23				      (normalize "titleabbrev"))))
24    (if (node-list-empty? metatabb)
25	(if (node-list-empty? titleabb)
26	    (if (node-list-empty? metatitle)
27		title
28		metatitle)
29	    titleabb)
30	metatabb)))
31
32(define ($refentry-header-footer-element$)
33  (let* ((refdescriptor (node-list-first
34			 (select-elements
35			  (descendants (current-node)) (normalize "refdescriptor"))))
36	 (refname       (node-list-first
37			 (select-elements
38			  (descendants (current-node)) (normalize "refname"))))
39         (refentrytitle (node-list-first
40			 (select-elements
41			  (descendants (current-node)) (normalize "refentrytitle")))))
42    (if (node-list-empty? refentrytitle)
43	(if (node-list-empty? refdescriptor)
44	    refname
45	    refdescriptor)
46	refentrytitle)))
47
48(define ($title-header-footer$)
49  (let* ((title (if (equal? (gi) (normalize "refentry"))
50		   ($refentry-header-footer-element$)
51		   ($title-header-footer-element$))))
52    (make sequence
53      font-posture: 'italic
54      (with-mode hf-mode
55	(process-node-list title)))))
56
57(define ($page-number-header-footer$)
58  (let ((component (ancestor-member (current-node)
59				    (append (division-element-list)
60					    (component-element-list)))))
61    (make sequence
62      font-posture: 'italic
63      (literal
64       (gentext-page)
65       (if %page-number-restart%
66	   (if (or (equal? (gi component) (normalize "chapter"))
67		   (equal? (gi component) (normalize "appendix")))
68	       (string-append
69		(element-label component #t)
70		(gentext-intra-label-sep "_pagenumber"))
71	       "")
72	   ""))
73      (page-number-sosofo))))
74
75(define (first-page-inner-header gi)
76  (empty-sosofo))
77
78(define (first-page-center-header gi)
79  (empty-sosofo))
80
81(define (first-page-outer-header gi)
82  (empty-sosofo))
83
84(define (page-inner-header gi)
85  (empty-sosofo))
86
87(define (page-center-header gi)
88  (empty-sosofo))
89
90(define (page-outer-header gi)
91  (cond
92   ((equal? (normalize gi) (normalize "dedication")) (empty-sosofo))
93   ((equal? (normalize gi) (normalize "lot")) (empty-sosofo))
94   ((equal? (normalize gi) (normalize "part")) (empty-sosofo))
95   ((equal? (normalize gi) (normalize "toc")) (empty-sosofo))
96   (else ($title-header-footer$))))
97
98(define (first-page-inner-footer gi)
99  (empty-sosofo))
100
101(define (first-page-center-footer gi)
102  (empty-sosofo))
103
104(define (first-page-outer-footer gi)
105  (cond
106   ((equal? (normalize gi) (normalize "dedication")) (empty-sosofo))
107   ((equal? (normalize gi) (normalize "part")) (empty-sosofo))
108   (else ($page-number-header-footer$))))
109
110(define (page-inner-footer gi)
111  (empty-sosofo))
112
113(define (page-center-footer gi)
114  (empty-sosofo))
115
116(define (page-outer-footer gi)
117  ($page-number-header-footer$))
118
119(define ($page-number-format$ #!optional (gi (gi)))
120  (cond
121   ((equal? (normalize gi) (normalize "toc")) "i")
122   ((equal? (normalize gi) (normalize "lot")) "i")
123   ((equal? (normalize gi) (normalize "preface")) "i")
124   (else "1")))
125
126(define ($left-header$ #!optional (gi (gi)))
127  (if-first-page
128   (if (equal? %writing-mode% 'left-to-right)
129       (first-page-inner-header gi)
130       (first-page-outer-header gi))
131   (if %two-side%
132       (if-front-page
133	(if (equal? %writing-mode% 'left-to-right)
134	    (page-inner-header gi)
135	    (page-outer-header gi))
136	(if (equal? %writing-mode% 'left-to-right)
137	    (page-outer-header gi)
138	    (page-inner-header gi)))
139       (if (equal? %writing-mode% 'left-to-right)
140	   (page-inner-header gi)
141	   (page-outer-header gi)))))
142
143(define ($center-header$ #!optional (gi (gi)))
144  (if-first-page
145   (first-page-center-header gi)
146   (page-center-header gi)))
147
148(define ($right-header$ #!optional (gi (gi)))
149  (if-first-page
150   (if (equal? %writing-mode% 'left-to-right)
151       (first-page-outer-header gi)
152       (first-page-inner-header gi))
153   (if %two-side%
154       (if-front-page
155	(if (equal? %writing-mode% 'left-to-right)
156	    (page-outer-header gi)
157	    (page-inner-header gi))
158	(if (equal? %writing-mode% 'left-to-right)
159	    (page-inner-header gi)
160	    (page-outer-header gi)))
161       (if (equal? %writing-mode% 'left-to-right)
162	   (page-outer-header gi)
163	   (page-inner-header gi)))))
164
165(define ($left-footer$ #!optional (gi (gi)))
166  (if-first-page
167   (if (equal? %writing-mode% 'left-to-right)
168       (first-page-inner-footer gi)
169       (first-page-outer-footer gi))
170   (if %two-side%
171       (if-front-page
172	(if (equal? %writing-mode% 'left-to-right)
173	    (page-inner-footer gi)
174	    (page-outer-footer gi))
175	(if (equal? %writing-mode% 'left-to-right)
176	    (page-outer-footer gi)
177	    (page-inner-footer gi)))
178       (if (equal? %writing-mode% 'left-to-right)
179	   (page-inner-footer gi)
180	   (page-outer-footer gi)))))
181
182(define ($center-footer$ #!optional (gi (gi)))
183  (if-first-page
184   (first-page-center-footer gi)
185   (page-center-footer gi)))
186
187(define ($right-footer$ #!optional (gi (gi)))
188  (if-first-page
189   (if (equal? %writing-mode% 'left-to-right)
190       (first-page-outer-footer gi)
191       (first-page-inner-footer gi))
192   (if %two-side%
193       (if-front-page
194	(if (equal? %writing-mode% 'left-to-right)
195	    (page-outer-footer gi)
196	    (page-inner-footer gi))
197	(if (equal? %writing-mode% 'left-to-right)
198	    (page-inner-footer gi)
199	    (page-outer-footer gi)))
200       (if (equal? %writing-mode% 'left-to-right)
201	   (page-outer-footer gi)
202	   (page-inner-footer gi)))))
203
204(define ($component$)
205  (make simple-page-sequence
206    page-n-columns: %page-n-columns%
207    page-number-restart?: (or %page-number-restart%
208			      (first-chapter?))
209    page-number-format: ($page-number-format$)
210    use: default-text-style
211    left-header:   ($left-header$)
212    center-header: ($center-header$)
213    right-header:  ($right-header$)
214    left-footer:   ($left-footer$)
215    center-footer: ($center-footer$)
216    right-footer:  ($right-footer$)
217    start-indent: %body-start-indent%
218    input-whitespace-treatment: 'collapse
219    quadding: %default-quadding%
220    (make sequence
221      ($component-title$)
222      (process-children))
223    (make-endnotes)))
224
225(define ($component-title$)
226  (let* ((info (cond
227		((equal? (gi) (normalize "appendix"))
228		 (select-elements (children (current-node)) (normalize "docinfo")))
229		((equal? (gi) (normalize "article"))
230		 (node-list-filter-by-gi (children (current-node))
231					 (list (normalize "artheader")
232					       (normalize "articleinfo"))))
233		((equal? (gi) (normalize "bibliography"))
234		 (select-elements (children (current-node)) (normalize "docinfo")))
235		((equal? (gi) (normalize "chapter"))
236		 (select-elements (children (current-node)) (normalize "docinfo")))
237		((equal? (gi) (normalize "dedication"))
238		 (empty-node-list))
239		((equal? (gi) (normalize "glossary"))
240		 (select-elements (children (current-node)) (normalize "docinfo")))
241		((equal? (gi) (normalize "index"))
242		 (select-elements (children (current-node)) (normalize "docinfo")))
243		((equal? (gi) (normalize "preface"))
244		 (select-elements (children (current-node)) (normalize "docinfo")))
245		((equal? (gi) (normalize "reference"))
246		 (select-elements (children (current-node)) (normalize "docinfo")))
247		((equal? (gi) (normalize "setindex"))
248		 (select-elements (children (current-node)) (normalize "docinfo")))
249		(else
250		 (empty-node-list))))
251	 (exp-children (if (node-list-empty? info)
252			   (empty-node-list)
253			   (expand-children (children info)
254					    (list (normalize "bookbiblio")
255						  (normalize "bibliomisc")
256						  (normalize "biblioset")))))
257	 (parent-titles (select-elements (children (current-node)) (normalize "title")))
258	 (titles	(if (node-list-empty? parent-titles)
259			    (select-elements exp-children (normalize "title"))
260			    parent-titles))
261	 (parent-subttl (select-elements (children (current-node)) (normalize "subtitle")))
262	 (subtitles	(if (node-list-empty? parent-subttl)
263			    (select-elements exp-children (normalize "subtitle"))
264			    parent-subttl)))
265    (make sequence
266      (make paragraph
267	font-family-name: %title-font-family%
268	font-weight: 'bold
269	font-size: (HSIZE 4)
270	line-spacing: (* (HSIZE 4) %line-spacing-factor%)
271	space-before: (* (HSIZE 4) %head-before-factor%)
272	start-indent: 0pt
273	first-line-start-indent: 0pt
274	quadding: %component-title-quadding%
275	heading-level: (if %generate-heading-level% 1 0)
276	keep-with-next?: #t
277
278	(if (string=? (element-label) "")
279	    (empty-sosofo)
280	    (literal (gentext-element-name-space (current-node))
281		     (element-label)
282		     (gentext-label-title-sep (gi))))
283
284	(if (node-list-empty? titles)
285	    (element-title-sosofo) ;; get a default!
286	    (with-mode component-title-mode
287	      (make sequence
288		(process-node-list titles)))))
289
290      (make paragraph
291	font-family-name: %title-font-family%
292	font-weight: 'bold
293	font-posture: 'italic
294	font-size: (HSIZE 3)
295	line-spacing: (* (HSIZE 3) %line-spacing-factor%)
296	space-before: (* 0.5 (* (HSIZE 3) %head-before-factor%))
297	space-after: (* (HSIZE 4) %head-after-factor%)
298	start-indent: 0pt
299	first-line-start-indent: 0pt
300	quadding: %component-subtitle-quadding%
301	keep-with-next?: #t
302
303	(with-mode component-title-mode
304	  (make sequence
305	    (process-node-list subtitles)))))))
306
307(mode component-title-mode
308  (element title
309    (process-children))
310
311  (element subtitle
312    (process-children))
313)
314
315;; this is how we prevent the title in the header from acquiring the
316;;   display treatment that it receives in the body of the document
317;;
318(mode hf-mode
319  (element title
320    (let* ((component (ancestor-member (current-node)
321				       (component-element-list)))
322	   (chaporapp (or (equal? (gi component) (normalize "chapter"))
323			  (equal? (gi component) (normalize "appendix")))))
324      (if %chap-app-running-heads%
325	  (make sequence
326	    (if (and chaporapp
327		     %chapter-autolabel%
328		     (or %chap-app-running-head-autolabel%
329			 (attribute-string (normalize "label") component)))
330		(literal (gentext-element-name-space component)
331			 (element-label component)
332			 (gentext-label-title-sep (gi component)))
333		(empty-sosofo))
334	    (process-children-trim))
335	  (empty-sosofo))))
336
337  (element titleabbrev
338    (if %chap-app-running-heads%
339	(make sequence
340	  (if (or (have-ancestor? (normalize "chapter"))
341		  (have-ancestor? (normalize "appendix")))
342	      (literal (gentext-element-name-space (parent))
343		       (element-label (parent))
344		       (gentext-label-title-sep (gi (parent))))
345	      (empty-sosofo))
346	  (process-children-trim))
347	(empty-sosofo)))
348
349  (element refentrytitle
350    (if %chap-app-running-heads%
351	(process-children-trim)
352	(empty-sosofo)))
353
354  (element refdescriptor
355    (if %chap-app-running-heads%
356	(process-children-trim)
357	(empty-sosofo)))
358
359  (element refname
360    (if %chap-app-running-heads%
361	(process-children-trim)
362	(empty-sosofo)))
363
364  ;; Graphics aren't allowed in headers and footers...
365  (element graphic
366    (empty-sosofo))
367
368  (element inlinegraphic
369    (empty-sosofo))
370)
371
372(element appendix ($component$))
373(element (article appendix) ($section$)) ;; this is a special case
374(element (appendix title) (empty-sosofo))
375
376(element chapter ($component$))
377(element (chapter title) (empty-sosofo))
378
379(element preface ($component$))
380(element (preface title) (empty-sosofo))
381
382(element colophon ($component$))
383
384;; Dedication is empty except in a special mode so that it can be
385;; reordered (made to come before the TOCs)
386(element dedication (empty-sosofo))
387(mode dedication-page-mode
388  (element dedication ($component$))
389  (element (dedication title) (empty-sosofo))
390)
391
392;; Articles are like components, except that if they may have much
393;; more formal title pages (created with article-titlepage).
394;;
395(element article
396  (let* ((info (node-list-filter-by-gi (children (current-node))
397				       (list (normalize "artheader")
398					     (normalize "articleinfo"))))
399	 (nl   (titlepage-info-elements (current-node) info))
400	 (article-titlepage (if %generate-article-titlepage-on-separate-page%
401				(make sequence
402				  (if (article-titlepage-content? nl 'recto)
403				      (make simple-page-sequence
404					page-n-columns: %page-n-columns%
405					use: default-text-style
406					quadding: %default-quadding%
407					(article-titlepage nl 'recto))
408				      (empty-sosofo))
409				  (if (article-titlepage-content? nl 'verso)
410				      (make simple-page-sequence
411					page-n-columns: %page-n-columns%
412					use: default-text-style
413					quadding: %default-quadding%
414					(article-titlepage nl 'verso))
415				      (empty-sosofo)))
416				(make sequence
417				  (article-titlepage nl 'recto)
418				  (article-titlepage nl 'verso)))))
419    (make sequence
420
421      ;; make the titlepage first if its on a separate page
422      (if (and %generate-article-titlepage%
423	       %generate-article-titlepage-on-separate-page%)
424	  article-titlepage
425	  (empty-sosofo))
426
427      ;; make the TOC on a separate page if requested and it's not
428      ;; already on the title page and it's supposed to be in front
429      (if (and %generate-article-toc%
430	       (not %generate-article-toc-on-titlepage%)
431	       %generate-article-titlepage-on-separate-page%
432	       (generate-toc-in-front))
433	  (make simple-page-sequence
434	    page-n-columns: %page-n-columns%
435            ;; FIXME: page restarting here and below is ill-considered
436	    page-number-restart?: %article-page-number-restart%
437	    page-number-format: ($page-number-format$ (normalize "toc"))
438	    left-header:   ($left-header$ (normalize "toc"))
439	    center-header: ($center-header$ (normalize "toc"))
440	    right-header:  ($right-header$ (normalize "toc"))
441	    left-footer:   ($left-footer$ (normalize "toc"))
442	    center-footer: ($center-footer$ (normalize "toc"))
443	    right-footer:  ($right-footer$ (normalize "toc"))
444	    input-whitespace-treatment: 'collapse
445	    use: default-text-style
446	    quadding: %default-quadding%
447	    (build-toc (current-node)
448		       (toc-depth (current-node))))
449	  (empty-sosofo))
450
451      ;; start a new page for the article itself
452      (make simple-page-sequence
453	page-n-columns: %page-n-columns%
454	page-number-restart?: (or %article-page-number-restart%
455				  (book-start?))
456	page-number-format: ($page-number-format$)
457	use: default-text-style
458	left-header:   ($left-header$)
459	center-header: ($center-header$)
460	right-header:  ($right-header$)
461	left-footer:   ($left-footer$)
462	center-footer: ($center-footer$)
463	right-footer:  ($right-footer$)
464	start-indent: %body-start-indent%
465	input-whitespace-treatment: 'collapse
466	quadding: %default-quadding%
467
468	;; ... and include the titlepage if there is one and it's not
469	;; already generated on a separate page
470	(if (and %generate-article-titlepage%
471		 (not %generate-article-titlepage-on-separate-page%))
472	    article-titlepage
473	    (empty-sosofo))
474
475	;; ... and include the TOC if it is in front and not already
476	;; generated
477	(if (and %generate-article-toc%
478		 (generate-toc-in-front)
479		 (not %generate-article-toc-on-titlepage%)
480		 (not %generate-article-titlepage-on-separate-page%))
481	    (make display-group
482	      space-after: (* (HSIZE 3) %head-after-factor%)
483	      (build-toc (current-node)
484			 (toc-depth (current-node))))
485	    (empty-sosofo))
486
487	;; .. and the contents of the article
488	(process-children)
489
490        ;; ... and the endnotes
491	(make-endnotes)
492
493	;; ... and the TOC if it is supposed to be on the back and not
494	;; on the titlepage nor on a separate pagee
495	(if (and %generate-article-toc%
496		 (not (generate-toc-in-front))
497		 (not %generate-article-toc-on-titlepage%)
498		 (not %generate-article-titlepage-on-separate-page%))
499	    (make display-group
500	      space-after: (* (HSIZE 3) %head-after-factor%)
501	      (build-toc (current-node)
502			 (toc-depth (current-node))))
503	    (empty-sosofo)))
504
505      ;; finally, produce the TOC if it is supposed to be at the end
506      ;; and on its own page
507      (if (and %generate-article-toc%
508	       (not %generate-article-toc-on-titlepage%)
509	       %generate-article-titlepage-on-separate-page%
510	       (not (generate-toc-in-front)))
511	  (make simple-page-sequence
512	    page-n-columns: %page-n-columns%
513	    use: default-text-style
514	    quadding: %default-quadding%
515	    (build-toc (current-node)
516		       (toc-depth (current-node))))
517	  (empty-sosofo)))))
518
519(element (article title) (empty-sosofo))
520
521