;; $Id: dbverb.dsl,v 1.6 2004/10/09 19:46:33 petere78 Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;

(define verbatim-style
  (style
      font-family-name: %mono-font-family%
      font-size:        (* (inherited-font-size) 
			   (if %verbatim-size-factor%
			       %verbatim-size-factor%
			       1.0))
      font-weight:      'medium
      font-posture:     'upright
      line-spacing:     (* (* (inherited-font-size) 
			      (if %verbatim-size-factor%
				  %verbatim-size-factor%
				  1.0))
			   %line-spacing-factor%)
      first-line-start-indent: 0pt
      lines: 'asis
      input-whitespace-treatment: 'preserve))

(define inline-verbatim-style
  (style
      font-family-name: %mono-font-family%
      font-size:        (* (inherited-font-size) 
			   (if %verbatim-size-factor%
			       %verbatim-size-factor%
			       1.0))
      font-weight:      'medium
      font-posture:     'upright
      lines: 'asis
      input-whitespace-treatment: 'preserve))

(define linespecific-style
  (style
      first-line-start-indent: 0pt
      lines: 'asis
      input-whitespace-treatment: 'preserve))

(define ($format-indent$ indent)
  (literal indent))

(define ($format-linenumber$ linenumber)
  ;; A line-field would make more sense here, and allow proportional
  ;; fonts, but you can't put line-fields in the middle of a paragraph
  ;; in the current RTF backend of Jade
  (let ((%factor% (if %verbatim-size-factor%
		      %verbatim-size-factor%
		      1.0)))
    (if (equal? (remainder linenumber %linenumber-mod%) 0)
	(make sequence
	  use: verbatim-style
	  (literal (pad-string (format-number linenumber "1") 
			       %linenumber-length% %linenumber-padchar%))
	  ($linenumber-space$))
	(make sequence
	  use: verbatim-style
	  (literal (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 ($linespecific-display$ indent line-numbers?)
  (let ((vspace (if (INBLOCK?)
		   0pt
		   (if (INLIST?) 
		       %para-sep% 
		       %block-sep%))))
    (make paragraph
      use: linespecific-style
      space-before: (if (and (string=? (gi (parent)) (normalize "entry"))
 			     (absolute-first-sibling?))
			0pt
			vspace)
      space-after:  (if (and (string=? (gi (parent)) (normalize "entry"))
 			     (absolute-last-sibling?))
			0pt
			vspace)
      start-indent: (if (INBLOCK?)
			(inherited-start-indent)
			(+ %block-start-indent% (inherited-start-indent)))
      (if (or indent line-numbers?)
	  ($linespecific-line-by-line$ indent line-numbers?)
	  (process-children)))))

(define ($linespecific-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 ($verbatim-display$ indent line-numbers?)
  (let* ((width-in-chars (if (attribute-string (normalize "width"))
			     (string->number (attribute-string (normalize "width")))
			     %verbatim-default-width%))
	 (fsize (lambda () (if (or (attribute-string (normalize "width"))
				   (not %verbatim-size-factor%))
			       (/ (/ (- %text-width% (inherited-start-indent))
				     width-in-chars) 
				  0.7)
			       (* (inherited-font-size) 
				  %verbatim-size-factor%))))
	 (vspace-before (if (INBLOCK?)
			    0pt
			    (if (INLIST?)
				%para-sep%
				%block-sep%)))
	 (vspace-after (if (INBLOCK?)
			   0pt
			   (if (INLIST?)
			       0pt
			       %block-sep%))))
    (make paragraph
      use: verbatim-style
      space-before: (if (and (string=? (gi (parent)) (normalize "entry"))
 			     (absolute-first-sibling?))
			0pt
			vspace-before)
      space-after:  (if (and (string=? (gi (parent)) (normalize "entry"))
 			     (absolute-last-sibling?))
			0pt
			vspace-after)
      font-size: (fsize)
      line-spacing: (* (fsize) %line-spacing-factor%)
      start-indent: (if (INBLOCK?)
			(inherited-start-indent)
			(+ %block-start-indent% (inherited-start-indent)))
      (if (or indent line-numbers?)
	  ($linespecific-line-by-line$ indent line-numbers?)
	  (process-children)))))

(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))