html/dbsect.dsl

   1 ;; $Id: dbsect.dsl,v 1.8 2003/03/25 19:53:41 adicarlo Exp $
   2 ;;
   3 ;; This file is part of the Modular DocBook Stylesheet distribution.
   4 ;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
   5 ;;
   6
   7 ;; ============================== SECTIONS ==============================
   8
   9 (define (SECTLEVEL #!optional (sect (current-node)))
  10   (section-level-by-node (not nochunks) sect))
  11
  12 ;; BRIDGEHEAD isn't a proper section, but appears to be a section title
  13 (element bridgehead
  14   (let* ((renderas (attribute-string "renderas"))
  15          ;; the apparent section level
  16          (hlevel
  17           ;; if not real section level, then get the apparent level
  18           ;; from "renderas"
  19           (if renderas
  20               (section-level-by-gi (not nochunks) (normalize renderas))
  21               ;; else use the real level
  22               (SECTLEVEL)))
  23          (helem
  24           (string-append "H" (number->string hlevel))))
  25     (make element gi: helem
  26           attributes: '(("CLASS" "BRIDGEHEAD"))
  27           (make element gi: "A"
  28                 attributes: (list (list "NAME" (element-id)))
  29                 (empty-sosofo))
  30           (process-children))))
  31
  32 (define ($section-separator$)
  33   (let* (;; There are several situations in which we don't want a
  34          ;; separator here:
  35          ;; 1. This document is being chunked:
  36          (chunks (not nochunks))
  37          ;; 2. This node is the root element of the document:
  38          (isroot (node-list=? (current-node) (sgml-root-element)))
  39          ;; 3. This node is the first section in the root element
  40          ;;    and no other content (except the *info elements and
  41          ;;    the title) precedes it.  This means that the
  42          ;;    titlepage-separator was the last thing we put out.
  43          ;;    No one expects two separators in a row, or the Spanish
  44          ;;    inquisition.
  45          (s1ofrt  (node-list=? (parent (current-node)) (sgml-root-element)))
  46          (precnd  (ipreced (current-node)))
  47          (infond  (info-element (parent (current-node))))
  48          (isfirst (or (equal? (gi precnd) (normalize "title"))
  49                       (node-list=? precnd infond))))
  50     (if (or chunks isroot isfirst)
  51         (empty-sosofo)
  52         (make empty-element gi: "HR"))))
  53
  54 (define ($section$)
  55   (html-document (with-mode head-title-mode
  56                    (literal (element-title-string (current-node))))
  57                  ($section-body$)))
  58
  59 (define ($section-body$)
  60   (make element gi: "DIV"
  61         attributes: (list (list "CLASS" (gi)))
  62         ($section-separator$)
  63         ($section-title$)
  64
  65         (if (not (node-list-empty? (select-elements (children (current-node))
  66                                                     (normalize "refentry"))))
  67             (build-toc (current-node) 1)
  68             (empty-sosofo))
  69
  70         (process-children)))
  71
  72 (define ($section-title$)
  73   (let* ((sect (current-node))
  74          (info (info-element))
  75          (subtitles (select-elements (children info) (normalize "subtitle")))
  76          (renderas (inherited-attribute-string (normalize "renderas") sect))
  77          ;; the apparent section level
  78          (hlevel
  79           ;; if not real section level, then get the apparent level
  80           ;; from "renderas"
  81           (if renderas
  82               (section-level-by-gi (not nochunks) (normalize renderas))
  83               ;; else use the real level
  84               (SECTLEVEL)))
  85          (h1elem
  86           (string-append "H" (number->string hlevel)))
  87          (h2elem
  88           (string-append "H" (number->string (+ hlevel 1))))
  89          (name (element-id))
  90          (isep (gentext-intra-label-sep (gi sect)))
  91          (nsep (gentext-label-title-sep (gi sect))))
  92     (make sequence
  93       (make element gi: h1elem
  94             attributes: (list (list "CLASS" (gi sect)))
  95             (make element gi: "A"
  96                   attributes: (list (list "NAME" name))
  97                   (make sequence
  98                     (if (string=? (element-label (current-node)) "")
  99                         (empty-sosofo)
 100                         (literal (element-label (current-node)) nsep))
 101                     (element-title-sosofo sect))))
 102       (if (node-list-empty? subtitles)
 103           (empty-sosofo)
 104           (with-mode subtitle-mode
 105             (make element gi: h2elem
 106                   (process-node-list subtitles))))
 107       ($proc-section-info$ info))))
 108
 109 (define ($proc-section-info$ info)
 110   (cond ((equal? (gi) (normalize "sect1"))
 111          ($sect1-info$ info))
 112         ((equal? (gi) (normalize "sect2"))
 113          ($sect2-info$ info))
 114         ((equal? (gi) (normalize "sect3"))
 115          ($sect3-info$ info))
 116         ((equal? (gi) (normalize "sect4"))
 117          ($sect4-info$ info))
 118         ((equal? (gi) (normalize "sect5"))
 119          ($sect5-info$ info))
 120         ((equal? (gi) (normalize "section"))
 121          ($section-info$ info))
 122         ((equal? (gi) (normalize "refsect1"))
 123          ($refsect1-info$ info))
 124         ((equal? (gi) (normalize "refsect2"))
 125          ($refsect2-info$ info))
 126         ((equal? (gi) (normalize "refsect3"))
 127          ($refsect3-info$ info))
 128         (else (empty-sosofo))))
 129
 130 (define ($sect1-info$ info) (empty-sosofo))
 131 (define ($sect2-info$ info) (empty-sosofo))
 132 (define ($sect3-info$ info) (empty-sosofo))
 133 (define ($sect4-info$ info) (empty-sosofo))
 134 (define ($sect5-info$ info) (empty-sosofo))
 135 (define ($section-info$ info) (empty-sosofo))
 136 (define ($refsect1-info$ info) (empty-sosofo))
 137 (define ($refsect2-info$ info) (empty-sosofo))
 138 (define ($refsect3-info$ info) (empty-sosofo))
 139
 140 (element section ($section$))
 141 (element (section title) (empty-sosofo))
 142
 143 (element sect1 ($section$))
 144 (element (sect1 title) (empty-sosofo))
 145
 146 (element sect2 ($section$))
 147 (element (sect2 title) (empty-sosofo))
 148
 149 (element sect3 ($section$))
 150 (element (sect3 title) (empty-sosofo))
 151
 152 (element sect4 ($section$))
 153 (element (sect4 title) (empty-sosofo))
 154
 155 (element sect5 ($section$))
 156 (element (sect5 title) (empty-sosofo))
 157
 158 (element simplesect ($section$))
 159 (element (simplesect title) (empty-sosofo))
 160