GCA Paper DSSSL Stylesheet, from Paul Prescod: http://itrc.uwaterloo.ca/~papresco/dsssl/gcapaper.dsl ;; JADE non-standard flow objects for SGML transformations (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") (declare-flow-object-class document-type "UNREGISTERED::James Clark//Flow Object Class::document-type") (declare-flow-object-class processing-instruction "UNREGISTERED::James Clark//Flow Object Class::processing-instruction") (declare-flow-object-class entity "UNREGISTERED::James Clark//Flow Object Class::entity") (declare-flow-object-class entity-ref "UNREGISTERED::James Clark//Flow Object Class::entity-ref") (declare-flow-object-class formatting-instruction "UNREGISTERED::James Clark//Flow Object Class::formatting-instruction") (declare-characteristic preserve-sdata? "UNREGISTERED::James Clark//Characteristic::preserve-sdata?" #t) ;; JADE non-standard functions (define debug (external-procedure "UNREGISTERED::James Clark//Procedure::debug")) ;; Construction rules (element GCAPAPER (make element gi:"HTML" (process-children))) (element (FRONT TITLE) (sosofo-append (make element gi:"TITLE" (process-children)) (make element gi:"H1" (process-children)))) (element SUBT (make element gi:"H2")) (element AUTHOR (sosofo-append (make element gi: "P" (make element gi: "B" (literal "Author:")) (process-matching-children "FNAME") (literal " ") (process-matching-children "SURNAME")) (process-matching-children "JOBTITLE") (process-matching-children "ADDRESS") (process-matching-children "BIO"))) (element JOBTITLE (make element gi: "P")) (element BIO (sosofo-append (make element gi: "P" (make element gi: "B" (literal "Bio:"))) (process-children))) (element ADDRESS (make element gi: "ADDRESS")) (element ALINE (sosofo-append (process-children) (make empty-element gi: "BR"))) (define (conditional-comma #!optional (sosofo (process-children))) (sosofo-append sosofo (if (not (node-is-last)) (literal ", ") (empty-sosofo)))) (element CITY (conditional-comma)) (element STATE (conditional-comma)) (element PROVINCE (conditional-comma)) (element CNTRY (conditional-comma)) (element POSTCODE (process-children)) (element PHONE (sosofo-append (make empty-element gi:"BR") (literal "Phone: ") (process-children))) (element FAX (sosofo-append (make empty-element gi:"BR") (literal "Fax: ") (process-children))) (element AFFIL (conditional-comma)) (element SUBAFFIL (conditional-comma)) (element EMAIL (let ((URL (string-append "mailto:" (data (current-node))))) (sosofo-append (make empty-element gi:"BR") (make-link URL (literal (data (current-node))))))) (element WEB (let ((URL (data (current-node)))) (sosofo-append (make empty-element gi:"BR") (make-link URL (literal (data (current-node))))))) (element (SECTION TITLE) (make element gi: "H1" (hyperlink-target) (process-children))) (element (SUBSEC1 TITLE) (make element gi: "H2" (hyperlink-target) (process-children))) (element (SUBSEC2 TITLE) (make element gi: "H3" (hyperlink-target) (process-children))) (element (SUBSEC3 TITLE) (make element gi: "H4" (hyperlink-target) (process-children))) (element lquote (make element gi: "BLOCKQUOTE")) (element note (sosofo-append (make element gi: "P" (make element "B" (literal "Note:"))) (process-children))) (element verbatim (make element gi:"PRE")) (element sgml.block (make element gi:"PRE")) (define (figure-row contents) (make element gi:"TR" (make element gi: "TD" contents))) (element FIGURE (make element gi:"TABLE" attributes: `(("BORDER" "2")) (hyperlink-target) (figure-row (process-matching-children "TITLE")) (figure-row (process-matching-children "PARA" "GRAPHIC" "VERBATIM")) (figure-row (process-matching-children "CAPTION")))) (element (FIGURE TITLE) (process-children)) (element GRAPHIC (make element gi: "P" (make empty-element gi: "IMG" attributes: `(("SRC" ,(entity-generated-system-id (attribute-string "FIGNAME"))))))) (element INLINE-GRAPHIC (make empty-element gi: "IMG" attributes: `(("SRC" ,(entity-generated-system-id (attribute-string "FIGNAME")))))) (element caption (make element gi:"P")) (element (randlist title) (make element gi:"P" (make element gi: "B"))) (element (seqlist title) (make element gi:"P" (make element gi: "B"))) (element (deflist title) (make element gi:"P" (make element gi: "B"))) ; these mappings are rather arbitrary. ; someone more ambitious can replace them with a DL and Unicode "BULLET/DASH" chars (element randlist (let ((disk-type (cond (attribute-string "STYLE") (("SIMPLE") "CIRCLE") (("BULLETED") "DISK") (("DASHED") "SQUARE")))) (sosofo-append (make element gi: "B" (process-matching-children "TITLE")) (make element gi:"UL" `(("TYPE" ,disk-type)))))) (element seqlist (let ((num-type (cond (attribute-string "NUMBER") (("arabic") "1") (("ualpha") "A") (("uroman") "I") (("lalpha") "a") (("lroman") "i")))) (sosofo-append (process-matching-children "TITLE") (make element gi:"OL" attributes: `(("TYPE" ,num-type)))))) (element li (make element gi: "LI" )) (element deflist (sosofo-append (process-matching-children "TITLE") (make element gi:"DL"))) (element term.heading (make element gi:"DT")) (element def.term (make element gi:"DT")) (element def.heading (make element gi:"DD")) (element def (make element gi:"DD")) (element KEYWORDS (sosofo-append (make element gi:"B" (literal "Keywords:")) (make element gi:"P"))) (element KEYWORD (conditional-comma (process-children))) (element ABSTRACT (sosofo-append (make element gi: "B" (literal "Abstract:")) (make element gi: "BLOCKQUOTE"))) (element SGML (make element gi: "TT")) (element PARA (make element gi:"P" (hyperlink-target) (process-children))) (element ACKNOWL (sosofo-append (make element gi: "H2" (literal "Acknowledgements")) (make element gi: "BLOCKQUOTE"))) (element acronym.grp (sosofo-append (process-node-list (node-list-first (children (current-node)))) (literal " (") (process-node-list (node-list-rest (children (current-node)))) (literal ")"))) (element bibliog (sosofo-append (make element gi: "H2" (literal "Bibliography")) (make element gi: "DL"))) (element bibitem (sosofo-append (make element gi: "DT" attributes: `(("COMPACT" "COMPACT")) (hyperlink-target) (process-matching-children "BIB")) (make element gi: "DD" (process-matching-children "PUB")))) (element bib (make element gi: "SUP" (literal "[") (process-children) (literal "]") )) (define (footnote-number-sosofo #!optional (node (current-node))) (make element gi: "SUP" (literal "[FN " (number->string (cadr (element-number-list '("GCAPAPER" "FTNOTE") node ))) "]"))) (define (make-link href children) (make element gi: "A" attributes: `(("HREF" ,href)) children)) (define (footnote-file-name target) (string-append "Footnote_" (number->string (cadr (element-number-list '("GCAPAPER" "FTNOTE") target ))) ".html")) (element ftnote (sosofo-append (with-mode ref (process-node-list (current-node))) (make entity system-id: (footnote-file-name (current-node)) (make element gi: "TITLE" (footnote-number-sosofo)) (make element gi: "DL" (make element gi: "DT" (footnote-number-sosofo) (make element gi: "DD" (process-children))))))) (element (ftnote para) (if (= (child-number) 1) (process-children) (next-match))) (element highlight (case (attribute-string "STYLE") (("BOLD") (make element gi: "B")) (("ITAL") (make element gi: "I")) (("BITAL") (make element gi: "B" (make element gi: "I"))) (("UNDER") (make element gi: "U")))) (element SUB (make element gi:"SUB")) (element SUPER (make element gi:"SUPER")) (define (find-data node gi) (let ((el (node-list-first (select-elements (descendants node) gi)))) (if (node-list-empty? el) #f (data el)))) (element fnref (with-mode ref (process-node-list (element-with-id (attribute-string "REFLOC"))))) (element xref (with-mode ref (process-node-list (element-with-id (attribute-string "REFLOC"))))) (element bibref (with-mode ref (process-node-list (element-with-id (attribute-string "REFLOC"))))) (mode ref (element ftnote (make-link (footnote-file-name (current-node)) (make element gi: "SUP" (footnote-number-sosofo)))) (element bibitem (make-link (string-append "#" (attribute-string "ID")) (process-matching-children "BIB"))) (element SECTION (make-link (string-append "#" (attribute-string "ID")) (literal "[" (find-data (current-node) "SECTION") "]"))) (element SUBSEC1 (make-link (string-append "#" (attribute-string "ID")) (literal "[" (find-data (current-node) "SECTION") "]"))) (element SUBSEC2 (make-link (string-append "#" (attribute-string "ID")) (literal "[" (find-data (current-node) "SECTION") "]"))) (element SUBSEC3 (make-link (string-append "#" (attribute-string "ID")) (literal "[" (find-data (current-node) "SECTION") "]"))) (element FIGURE (make-link (string-append "#" (attribute-string "ID")) (literal "[" (or (find-data (current-node) "TITLE") (find-data (current-node) "CAPTION") (literal (current-node) "FIGURE")) "]"))) (element PARA (sosofo-append (literal "[PARAGRAPH-REF]")))) ;; DSSSL functions not implemented in Jade yet (define (ifollow #!optional nodearg) (let ((node (if nodearg nodearg (current-node)))) (let loop ((rest (siblings node))) (cond ((node-list-empty? rest) rest) ((node-list=? (node-list-first rest) node) (node-list-first (node-list-rest rest))) (else (loop (node-list-rest rest)) ))))) (define (siblings #!optional nodearg) (let ((node (if nodearg nodearg (current-node)))) (children (parent node)) )) ;; useful non-standard function (define (node-is-last #!optional (node (current-node))) (node-list-empty? (ifollow node))) (define (hyperlink-target #!optional (node (current-node))) (if (attribute-string "ID") (make element gi: "A" attributes: `(("NAME" ,(attribute-string "ID"))) (literal "")) (empty-sosofo))) (define (cadr foo) (car (cdr foo)))