;; $Id: dbverb.dsl,v 1.5 2003/01/15 08:24:14 adicarlo Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;
(define ($inpre$)
(let ((wrapper (ancestor-member (current-node)
(list (normalize "address")
(normalize "funcsynopsisinfo")
(normalize "literallayout")
(normalize "programlisting")
(normalize "screen")
(normalize "synopsis")))))
(if (or (and (equal? wrapper "literallayout")
(not (equal? (attribute-string "class" wrapper)
(normalize "monospaced"))))
(equal? wrapper "address"))
#f
#t)))
(define ($format-indent$ indent)
;; This code is made complex by the fact that we need an additional
;; wrapper and we have to translate spaces into nbsp entity-refs,
;; if we aren't in a PRE.
;;
(if ($inpre$)
(literal indent)
(make element gi: "CODE"
($sp-to-nbsp-sosofo$ indent))))
(define ($format-linenumber$ linenumber)
;; This code is made complex by the fact that we need an additional
;; wrapper and we have to translate spaces into nbsp entity-refs,
;; if we aren't in a PRE.
;;
(if (equal? (remainder linenumber %linenumber-mod%) 0)
(if ($inpre$)
(make sequence
(literal (pad-string (format-number linenumber "1")
%linenumber-length% %linenumber-padchar%))
($linenumber-space$))
(make element gi: "CODE"
($sp-to-nbsp-sosofo$
(pad-string (format-number linenumber "1")
%linenumber-length% %linenumber-padchar%))
($linenumber-space$)))
(if ($inpre$)
(make sequence
(literal (pad-string "" %linenumber-length% " "))
($linenumber-space$))
(make element gi: "CODE"
($sp-to-nbsp-sosofo$
(pad-string "" %linenumber-length% " "))
($linenumber-space$)))))
(define ($line-start$ indent line-numbers? #!optional (line-number 1))
(make sequence
(if indent
($format-indent$ indent)
(empty-sosofo))
(if line-numbers?
($format-linenumber$ line-number)
(empty-sosofo))))
(define ($sp-to-nbsp-sosofo$ string)
;; Given a string, return it as a sosofo, but replace spaces with
;; nbsp entity-refs.
(make sequence
(let loop ((charlist (string->list string))
(res (empty-sosofo)))
(if (null? charlist)
res
(loop
(cdr charlist)
(let ((c (car charlist)))
(if (equal? c #\ )
(sosofo-append res
(make entity-ref name: "nbsp"))
(sosofo-append res (literal (list->string (list c)))))))))))
(define ($verbatim-display$ indent line-numbers?)
(let ((content (make element gi: "PRE"
attributes: (list
(list "CLASS" (gi)))
(if (or indent line-numbers?)
($verbatim-line-by-line$ indent line-numbers?)
(process-children)))))
(if %shade-verbatim%
(make element gi: "TABLE"
attributes: ($shade-verbatim-attr$)
(make element gi: "TR"
(make element gi: "TD"
content)))
(make sequence
(para-check)
content
(para-check 'restart)))))
(define ($verbatim-line-by-line$ indent line-numbers?)
(let ((expanded-content
;; this is the content with
;; inlinemediaobject/imageobject[@format='linespecific']
;; expanded
(let loop ((kl (children (current-node))) (rl (empty-node-list)))
(if (node-list-empty? kl)
rl
(if (equal? (gi (node-list-first kl))
(normalize "inlinemediaobject"))
(let* ((imgobj (node-list-filter-by-gi
(children (node-list-first kl))
(list (normalize "imageobject"))))
(datobj (node-list-filter-by-gi
(children imgobj)
(list (normalize "imagedata")))))
(if (and (not (node-list-empty? imgobj))
(not (node-list-empty? datobj))
(equal? (attribute-string (normalize "format") datobj)
(normalize "linespecific")))
(loop (node-list-rest kl)
(node-list rl (string->nodes (include-characters
(if (attribute-string (normalize "fileref") datobj)
(attribute-string (normalize "fileref") datobj)
(entity-generated-system-id (attribute-string (normalize "entityref") datobj)))))))
(loop (node-list-rest kl)
(node-list rl (node-list-first kl)))))
(loop (node-list-rest kl) (node-list rl (node-list-first kl))))))))
(make sequence
($line-start$ indent line-numbers? 1)
(let loop ((kl expanded-content)
(linecount 1)
(res (empty-sosofo)))
(if (node-list-empty? kl)
res
(loop
(node-list-rest kl)
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-000D)
(+ linecount 1)
linecount)
(let ((c (node-list-first kl)))
(if (char=? (node-property 'char c default: #\U-0000)
#\U-000D)
(sosofo-append res
(process-node-list c)
($line-start$ indent
line-numbers?
(+ linecount 1)))
(sosofo-append res (process-node-list c))))))))))
(define ($linespecific-display$ indent line-numbers?)
(make element gi: "P"
attributes: (list (list "CLASS" (gi)))
(make sequence
($line-start$ indent line-numbers? 1)
(let loop ((kl (children (current-node)))
(linecount 1)
(res (empty-sosofo)))
(if (node-list-empty? kl)
res
(loop
(node-list-rest kl)
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-000D)
(+ linecount 1)
linecount)
(let ((c (node-list-first kl)))
(if (char=? (node-property 'char c default: #\U-0000)
#\U-000D)
(sosofo-append res
(make empty-element gi: "br")
(process-node-list c)
($line-start$ indent
line-numbers?
(+ linecount 1)))
(if (char=? (node-property 'char c default: #\U-0000)
#\U-0020)
(sosofo-append res
(make entity-ref name: "nbsp"))
(sosofo-append res (process-node-list c)))))))))))
(element literallayout
(if (equal? (attribute-string "class") (normalize "monospaced"))
($verbatim-display$
%indent-literallayout-lines%
(or %number-literallayout-lines%
(equal? (attribute-string (normalize "linenumbering"))
(normalize "numbered"))))
($linespecific-display$
%indent-literallayout-lines%
(or %number-literallayout-lines%
(equal? (attribute-string (normalize "linenumbering"))
(normalize "numbered"))))))
(element address
($linespecific-display$
%indent-address-lines%
(or %number-address-lines%
(equal? (attribute-string (normalize "linenumbering"))
(normalize "numbered")))))
(element programlisting
($verbatim-display$
%indent-programlisting-lines%
(or %number-programlisting-lines%
(equal? (attribute-string (normalize "linenumbering"))
(normalize "numbered")))))
(element screen
($verbatim-display$
%indent-screen-lines%
(or %number-screen-lines%
(equal? (attribute-string (normalize "linenumbering"))
(normalize "numbered")))))
(element screenshot (process-children))
(element screeninfo (empty-sosofo))