]> ;------------------------------------------------------------ ; "Tag View" DSSSL Spec. Provides a default style for ; SGML or XML documents. ; ; Author: W. Eliot Kimber ; ; ; Change History: ; ; $Header$ ; ; $Log$ ; ;-------------------------------------------------------------------------- (define debug (external-procedure "UNREGISTERED::James Clark//Procedure::debug")) (define *rgb-color-space* (color-space "ISO/IEC 10179:1996//Color-Space Family::Device RGB")) (define midnight-blue-color (color *rgb-color-space* (/ 25 255) (/ 25 255) (/ 112 255))) (define primary-blue-color (color *rgb-color-space* (/ 25 255) (/ 25 255) (/ 255 255))) (define sea-green-color (color *rgb-color-space* (/ 46 255) (/ 139 255) (/ 87 255))) (define red-color (color *rgb-color-space* (/ 255 255) (/ 0 255) (/ 0 255))) ;-------------------------------------------------- ; Define general-purpose functions: ;-------------------------------------------------- (define (copy-attributes nd indent) (let loop ((atts (named-node-list-names (attributes nd))) (resultstr "")) (if (null? atts) resultstr (loop (cdr atts) (let* ((name (car atts)) (value (attribute-string name nd))) (if value (string-append resultstr "&#RE;" indent name "=\"" value "\"") resultstr)))))) (define (ancestors nl) (node-list-map (lambda (snl) (let loop ((cur (parent snl)) (result (empty-node-list))) (if (node-list-empty? cur) result (loop (parent cur) (node-list cur result))))) nl)) (define (copy-string string count) (let loop ((resultstr "") (count count)) (if (equal? count 0) resultstr (loop (string-append resultstr string) (- count 1))))) (declare-initial-value font-family-name "iso-monospace") (root (make scroll (process-children))) (default (let ((indent (copy-string " " (node-list-length (ancestors (current-node)))))) (sosofo-append (make paragraph color: sea-green-color (literal indent "<" (gi (current-node)) (copy-attributes (current-node) (string-append indent " ")) ">")) (make paragraph lines: 'asis (process-children)) (if (node-property 'must-omit-end-tag? (current-node)) (empty-sosofo) (make paragraph color: sea-green-color (literal indent ""))))))