15.4.3 DSSSL-Listing: Ausgabe eines einzelnen Autors
<!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN">
; -------------------- Style Sheet für die Autorenausgabe
(declare-flow-object-class document-type
"UNREGISTERED::James Clark//Flow Object Class::document-type")
(declare-flow-object-class element
"UNREGISTERED::James Clark//Flow Object Class::element")
(declare-flow-object-class empty-element
"UNREGISTERED::James Clark//Flow Object Class::empty-element")
(define (copy-attributes #!optional (nd (current-node)))
(let loop ((atts (named-node-list-names (attributes nd))))
(if (null? atts)
'()
(let* ((name (car atts))
(value (attribute-string name nd)))
(if value
(cons (list name value)
(loop (cdr atts)))
(loop (cdr atts)))))))
; ----- Vorgehen für nicht ausdrücklich vorkommende Elemente
(default (process-children))
;------ Dummy fuer den Test; an dieser Stelle wird beim Generieren
; ----- "on the fly" der jeweilige Name durch ein (define ...) eingesetzt
(define thisAuthor "MANNT")
; ---------------- Monate als ganzes Wort ausgeben
(define (getmonth mo li lang)
(if (= mo 1)
(if (equal? lang "de")
(car (car li))
(car (cdr (car li))))
(getmonth (- mo 1) (cdr li) lang)))
(define monate (list (list "Januar" "January")
(list "Februar" "February")
(list "März" "March")
(list "April" "April")
(list "Mai" "May")
(list "Juni" "June")
(list "Juli" "July")
(list "August" "August")
(list "September" "September")
(list "Oktober" "October")
(list "November" "November")
(list "Dezember" "December")))
; ----- Ländernamen als ganzes Wort ausgeben
(define (getcountry country li lang)
(if (equal? country (car (car li)))
(if (equal? lang "de")
(car (cdr (car li)))
(car (cdr (cdr (car li)))))
(getcountry country (cdr li) lang)))
(define staaten (list (list "at" "Österreich" "Austria")
(list "au" "Australien" "Australia")
(list "br" "Brasilien" "Brazil")
(list "bu" "Bulgarien" "Bulgaria")
(list "ca" "Kanada" "Canada")
(list "ch" "Schweiz" "Switzerland")
(list "de" "Deutschland" "Germany")
(list "fi" "Finnland" "Finnland")
(list "fr" "Frankreich" "France")
(list "en" "Großbritannien" "Great Britain")
(list "me" "Mexiko" "Mexico")
(list "ie" "Irland" "Ireland")
(list "nl" "Niederlande" "Netherlands")
(list "no" "Norwegen" "Norway")
(list "ru" "Rußland" "Russia")
(list "es" "Spanien" "Spain")
(list "se" "Schweden" "Sweden")
(list "us" "USA" "USA")))
; ----- Horizontale Linien
(define (horiz-rule)
(make empty-element gi: "HR"
attributes: (cons (list "class" "med")
'())))
(define (small-horiz-rule)
(make empty-element gi: "HR"
attributes: (cons (list "class" "sm")
'())))
; ----- das Top-level-Element lithist
(element lithist
(make sequence
(make document-type
name: "HTML"
public-id: "-//W3C//DTD HTML 4.0//EN")
(make element gi: "HTML"
(make sequence
(make element gi: "HEAD"
(make sequence
(make element gi: "TITLE"
(literal "Dichter und Schriftsteller"))
(make empty-element gi: "LINK"
attributes: (cons (list "REL" "STYLESHEET")
(cons (list "TYPE" "text/css")
(cons (list "HREF" "/style/litanw.css")
(cons (list "TITLE" "Literatur")
'())))))
(make empty-element gi: "META"
attributes: (cons (list "name" "generator" )
(cons (list "content"
"from XML source and Style Sheet
via James Clark's Jade")
(cons (list "name" "author")
(cons (list "content" "Henning Behme")
'())))))))
(make element gi: "BODY"
(make sequence
(make element gi: "H3"
attributes: (cons (list "class" "de") '())
(literal "Dichter und Schriftsteller"))
(make element gi: "H3"
attributes: (cons (list "class" "en") '())
(literal "Poets and Writers"))
(process-children)
(make element gi: "P"
attributes: (cons (list "class" "memo")
'()) (literal "Last modified on April 14, 1998; by HB"))))))))
; -------------------- die Hauptsache: das Element Autor
(element author
(if (string=? thisAuthor (attribute-string "ID" (current-node)))
(make sequence
(process-matching-children 'name)
(make element gi: "TABLE"
attributes: (cons (list "border" "0")
(cons (list "width" "100%")
(cons (list "cellspacing" "0")
(cons (list "cellpadding" "2")
'()))))
(make element gi: "CAPTION"
(make element gi: "H3"
(literal "Leben und Werk"))
(make element gi: "H3"
attributes: (cons (list "class" "eng")
'())
(literal "Life and Works")))
(process-matching-children 'vita)
(process-matching-children 'event)
(process-matching-children 'work)
(process-matching-children 'comment)))
(empty-sosofo)))
; ---------------------- wann geboren?
(element born
(make element gi: "TR"
(make element gi: "TH"
attributes: (cons (list "class" "when")
'()) (process-matching-children 'year))
(make element gi: "TD"
attributes: (cons (list "class" "life")
'())
(literal "geboren/born: ")
(process-matching-children 'day)
(process-matching-children 'month)
(make element gi: "SPAN"
attributes: (cons (list "class" "life")
'())
(process-matching-children 'where)))))
; ---------------------- wann gestorben?
(element died
(make element gi: "TR"
(make element gi: "TH"
attributes: (cons (list "class" "when")
'()) (process-matching-children 'year))
(make element gi: "TD"
attributes: (cons (list "class" "life")
'())
(literal "gestorben/died: ")
(process-matching-children 'day)
(process-matching-children 'month)
(make element gi: "SPAN"
attributes: (cons (list "class" "life")
'())
(process-matching-children 'where)))))
; ----------------- geboren/gestorben (Tag/Monat)?
(element day
(make element gi: "SPAN"
attributes: (cons (list "class" "life")
'())
(process-children)
(literal ". ")))
; ---- Monatsausgabe
(element month
(make element gi: "SPAN"
attributes: (cons (list "class" "life")
'()) (literal (getmonth (string->number (data (current-node))) monate "de"))
(literal " ")))
; ---------------------- wo geboren/gestorben?
(element (born where)
(make sequence
(literal "in ")
(process-matching-children 'place)
(literal " (")
(process-matching-children 'country)
(literal ")")))
(element (died where)
(make sequence
(literal "in ")
(process-matching-children 'place)
(literal " (")
(process-matching-children 'country)
(literal ")")))
(element country
(literal (getcountry (data (current-node)) staaten "de")))
; ----- wichtige Ereignisse ausgeben
(element event
(make sequence
(if (first-sibling?)
(make element gi: "TR"
(make element gi: "TD"
attributes: (cons (list "colspan" "2")
'()) (horiz-rule)))
(empty-sosofo))
(make element gi: "TR"
(make element gi: "TH"
attributes: (cons (list "class" "when")
'())
(process-matching-children 'year))
(make element gi: "TD"
attributes: (cons (list "class" "occ")
'())
(process-matching-children 'what)))))
; --------------- einzelne Werke ausgeben
(element work
(make sequence
(if (first-sibling?)
(make element gi: "TR"
(make element gi: "TD"
attributes: (cons (list "colspan" "2")
'()) (horiz-rule)))
(empty-sosofo))
(make element gi: "TR"
(make element gi: "TH"
attributes: (cons (list "class" "when")
'())
(process-matching-children 'year))
(make element gi: "TD"
attributes: (cons (list "class" "titel")
'())
(process-matching-children 'title)))
))
; --------------- Kommentare, so vorhanden, ausgeben
(element comment
(make sequence
(if (first-sibling?)
(make element gi: "TR"
(make element gi: "TD"
attributes: (cons (list "colspan" "2")
'()) (horiz-rule)))
(empty-sosofo))
(make element gi: "TR"
(make element gi: "TD"
attributes: (cons (list "class" "when")
(cons (list "colspan" "2")
'()))
(process-children)))
))
; ----- BR und EM nach HTML "durchreichen"
(element br
(make empty-element gi: "BR"))
(element em
(make element gi: "EM"))
; ----- Vor- und Nachnamen ausgeben
(element name
(make sequence
(make element gi: "H3"
attributes: (cons (list "class" "auth")
'())
(process-matching-children 'fname)
(process-matching-children 'lname))
(make element gi: "h4"
attributes: (cons (list "class" "pseudo")
'())
(process-matching-children 'pseudonym))))
(element fname
(make sequence
(process-children)
(literal " ")))
; ----- URL verschweigen
(element url (empty-sosofo))