Current File : //proc/thread-self/root/kunden/usr/share/sgml/docbook/dsssl-stylesheets/html/dbadmon.dsl |
;; $Id: dbadmon.dsl,v 1.5 2003/04/12 17:30:56 adicarlo Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;
;; ============================ ADMONITIONS =============================
(define ($graphical-admonition$)
(let* ((adm (current-node))
(id (attribute-string (normalize "id")))
(title (select-elements (children adm)
(normalize "title")))
(title? (not (node-list-empty? title)))
(adm-title (if title?
(with-mode title-sosofo-mode
(process-node-list (node-list-first title)))
(literal (gentext-element-name adm))))
(gr-cell (make element gi: "TD"
attributes: (list
(list "WIDTH"
($admon-graphic-width$))
(list "ALIGN" "CENTER")
(list "VALIGN" "TOP"))
(make empty-element gi: "IMG"
attributes: (list
(list "SRC"
(root-rel-path
($admon-graphic$)))
(list "HSPACE" "5")
(list "ALT"
(gentext-element-name adm))))))
(ttl-cell (make element gi: "TH"
attributes: '(("ALIGN" "LEFT")
("VALIGN" "MIDDLE"))
(make element gi: "B" adm-title)))
(body-cell (make element gi: "TD"
attributes: '(("ALIGN" "LEFT")
("VALIGN" "TOP"))
(process-children))))
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi adm)))
(if id
(make element gi: "A"
attributes: (list (list "NAME" id))
(empty-sosofo))
(empty-sosofo))
(if %spacing-paras%
(make element gi: "P" (empty-sosofo))
(empty-sosofo))
(make element gi: "TABLE"
attributes: (list (list "CLASS" (gi))
(list "WIDTH" ($table-width$))
(list "BORDER" "0"))
(if title?
(make sequence
(make element gi: "TR"
gr-cell
ttl-cell)
(make element gi: "TR"
(make element gi: "TD"
(make entity-ref name: "nbsp"))
body-cell))
(make sequence
(make element gi: "TR"
gr-cell
body-cell)))))))
(define ($admonition$)
(let ((id (attribute-string (normalize "id"))))
(if %admon-graphics%
($graphical-admonition$)
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi)))
;; The DIV isn't strictly necessary, of course, but it
;; is consistent with the graphical-admonition case.
(make element gi: "BLOCKQUOTE"
attributes: (list
(list "CLASS" (gi)))
(if id
(make element gi: "A"
attributes: (list (list "NAME" id))
(empty-sosofo))
(empty-sosofo))
(process-children))))))
(define ($admonpara$)
(let* ((title (select-elements
(children (parent (current-node))) (normalize "title")))
(has-title (not (node-list-empty? title)))
(adm-title (if has-title
(make sequence
(with-mode title-sosofo-mode
(process-node-list (node-list-first title)))
(literal (gentext-label-title-sep
(gi (parent (current-node))))))
(literal
(gentext-element-name
(gi (parent (current-node))))
(gentext-label-title-sep
(gi (parent (current-node))))))))
(make element gi: "P"
(if (and (not %admon-graphics%) (= (child-number) 1))
(make element gi: "B"
adm-title)
(empty-sosofo))
(process-children))))
(element important ($admonition$))
(element (important title) (empty-sosofo))
(element (important para) ($admonpara$))
(element (important simpara) ($admonpara$))
(element note ($admonition$))
(element (note title) (empty-sosofo))
(element (note para) ($admonpara$))
(element (note simpara) ($admonpara$))
(element tip ($admonition$))
(element (tip title) (empty-sosofo))
(element (tip para) ($admonpara$))
(element (tip simpara) ($admonpara$))
;; perils are given special treatment by generating a centered title
;; and throwing a box around them
;;
(define ($peril$)
(let* ((title (select-elements
(children (current-node)) (normalize "title")))
(has-title (not (node-list-empty? title)))
(adm-title (if has-title
(make sequence
(with-mode title-sosofo-mode
(process-node-list (node-list-first title))))
(literal
(gentext-element-name
(gi (current-node))))))
(id (attribute-string (normalize "id"))))
(if %admon-graphics%
($graphical-admonition$)
(make element gi: "DIV"
attributes: (list (list "CLASS" (gi)))
;; The DIV isn't strictly necessary, of course, but it
;; is consistent with the graphical-admonition case.
(if %spacing-paras%
(make element gi: "P" (empty-sosofo))
(empty-sosofo))
(make element gi: "TABLE"
attributes: (list
(list "CLASS" (gi))
(list "BORDER" "1")
(list "WIDTH" ($table-width$)))
(make element gi: "TR"
(make element gi: "TD"
attributes: (list
(list "ALIGN" "CENTER"))
(make element gi: "B"
(if id
(make element gi: "A"
attributes: (list (list "NAME" id))
(empty-sosofo))
(empty-sosofo))
adm-title)))
(make element gi: "TR"
(make element gi: "TD"
attributes: (list
(list "ALIGN" "LEFT"))
(process-children))))))))
(element caution ($peril$))
(element warning ($peril$))
(element (caution title) (empty-sosofo))
(element (warning title) (empty-sosofo))