;; $Id: dbcallou.dsl,v 1.4 2004/10/10 14:04:48 petere78 Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;
;; The support provided below is a little primitive because there's no way
;; to do line-addressing in Jade.
;;
;; CO's are supported with the CO element or, in SCREENCO and
;; PROGRAMLISTINGCO only, AREAs.
;;
;; Notes on the use of AREAs:
;;
;; - Processing is very slow. Jade loops through each AREA for
;; every column on every line.
;; - Only the LINECOLUMN units are supported, and they are #IMPLIED
;; - If a COORDS only specifies a line, the %callout-default-col% will
;; be used for the column.
;; - If the column is beyond the end of the line, that will work OK, but
;; if more than one callout has to get placed beyond the end of the same
;; line, that doesn't work so well.
;; - Embedded tabs foul up the column counting.
;; - Embedded markup fouls up the column counting.
;; - Embedded markup with embedded line breaks fouls up the line counting.
;; - The callout bugs occur immediately before the LINE COLUMN specified.
;; - You can't point to an AREASET, that doesn't make any sense
;; since it would imply a one-to-many link
;;
;; There's still no support for a stylesheet drawing the callouts on a
;; GRAPHIC, and I don't think there ever will be.
;;
(element areaspec (empty-sosofo))
(element area (empty-sosofo))
(element areaset (empty-sosofo))
(element co
($callout-mark$ (current-node)))
(element programlistingco ($informal-object$))
(element screenco ($informal-object$))
(element graphicco ($informal-object$))
(element (screenco screen)
($callout-verbatim-display$ %indent-screen-lines% %number-screen-lines%))
(element (programlistingco programlisting)
($callout-verbatim-display$ %indent-programlisting-lines%
%number-programlisting-lines%))
;; ----------------------------------------------------------------------
(define ($callout-bug$ conumber)
(if (and conumber %callout-fancy-bug%)
(case conumber
((1) (literal "\dingbat-negative-circled-sans-serif-digit-one;"))
((2) (literal "\dingbat-negative-circled-sans-serif-digit-two;"))
((3) (literal "\dingbat-negative-circled-sans-serif-digit-three;"))
((4) (literal "\dingbat-negative-circled-sans-serif-digit-four;"))
((5) (literal "\dingbat-negative-circled-sans-serif-digit-five;"))
((6) (literal "\dingbat-negative-circled-sans-serif-digit-six;"))
((7) (literal "\dingbat-negative-circled-sans-serif-digit-seven;"))
((8) (literal "\dingbat-negative-circled-sans-serif-digit-eight;"))
((9) (literal "\dingbat-negative-circled-sans-serif-digit-nine;"))
(else (make sequence
font-weight: 'bold
(literal "(" (format-number conumber "1") ")"))))
(make sequence
font-weight: 'bold
(if conumber
(literal "(" (format-number conumber "1") ")")
(literal "(??)")))))
(define ($callout-mark$ co)
;; Print the callout mark for co
(if (equal? (gi co) (normalize "co"))
($callout-bug$ (if (node-list-empty? co)
#f
(child-number co)))
(let ((areanum (if (node-list-empty? co)
#f
(if (equal? (gi (parent co)) (normalize "areaset"))
(absolute-child-number (parent co))
(absolute-child-number co)))))
($callout-bug$ (if (node-list-empty? co)
#f
areanum)))))
(define ($look-for-callout$ line col #!optional (eol? #f))
;; Look to see if a callout should be printed at line col, and print
;; it if it should
(let* ((areaspec (select-elements (children (parent (current-node)))
(normalize "areaspec")))
(areas (expand-children (children areaspec)
(list (normalize "areaset")))))
(let loop ((areanl areas))
(if (node-list-empty? areanl)
(empty-sosofo)
(make sequence
(if ($callout-area-match$ (node-list-first areanl) line col eol?)
($callout-area-format$ (node-list-first areanl) line col eol?)
(empty-sosofo))
(loop (node-list-rest areanl)))))))
(define ($callout-area-match$ area line col eol?)
;; Does AREA area match line col?
(let* ((coordlist (split (attribute-string (normalize "coords") area)))
(aline (string->number (car coordlist)))
(acol (if (null? (cdr coordlist))
#f
(string->number (car (cdr coordlist)))))
(units (if (inherited-attribute-string (normalize "units") area)
(inherited-attribute-string (normalize "units") area)
(normalize "linecolumn"))))
(and (equal? units (normalize "linecolumn"))
(or
(and (equal? line aline)
(equal? col acol))
(and (equal? line aline)
eol?
(or (not acol) (> acol col)))))))
(define ($callout-area-format$ area line col eol?)
;; Format AREA area at the appropriate place
(let* ((coordlist (split (attribute-string (normalize "coords") area)))
(aline (string->number (car coordlist)))
(acol (if (null? (cdr coordlist))
#f
(string->number (car (cdr coordlist))))))
(if (and (equal? line aline)
eol?
(or (not acol) (> acol col)))
(make sequence
(let loop ((atcol col))
(if (>= atcol (if acol acol %callout-default-col%))
(empty-sosofo)
(make sequence
(literal "\no-break-space;")
(loop (+ atcol 1)))))
($callout-mark$ area))
($callout-mark$ area))))
(define ($callout-linespecific-content$ indent line-numbers?)
;; Print linespecific content in a callout with line numbers
(make sequence
($line-start$ indent line-numbers? 1)
(let loop ((kl (children (current-node)))
(linecount 1)
(colcount 1)
(res (empty-sosofo)))
(if (node-list-empty? kl)
(sosofo-append res
($look-for-callout$ linecount colcount #t)
(empty-sosofo))
(loop
(node-list-rest kl)
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-000D)
(+ linecount 1)
linecount)
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-000D)
1
(if (char=? (node-property 'char (node-list-first kl)
default: #\U-0000) #\U-0000)
colcount
(+ colcount 1)))
(let ((c (node-list-first kl)))
(if (char=? (node-property 'char c default: #\U-0000)
#\U-000D)
(sosofo-append res
($look-for-callout$ linecount colcount #t)
(process-node-list c)
($line-start$ indent
line-numbers?
(+ linecount 1)))
(sosofo-append res
($look-for-callout$ linecount colcount)
(process-node-list c)))))))))
(define ($callout-verbatim-display$ indent line-numbers?)
(let* ((width-in-chars (if (attribute-string "width")
(string->number (attribute-string "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)))
quadding: 'start
($callout-linespecific-content$ indent line-numbers?))))
;; EOF dbcallout.dsl