;; $Id: dbsynop.dsl,v 1.3 2003/01/15 08:24:23 adicarlo Exp $

;;

;; This file is part of the Modular DocBook Stylesheet distribution.

;; See ../README or http://docbook.sourceforge.net/projects/dsssl/

;;

;; ========================= SYNTAX DEFINITIONS =========================

(element synopsis ($verbatim-display$ %indent-synopsis-lines%

				      %number-synopsis-lines%))

(element cmdsynopsis

  ;; Can't be an $informal-object$ because it needs the paragraph

  ;; wrapper around process-children

  (make display-group

    start-indent: (+ %block-start-indent% (inherited-start-indent))

    space-before: %block-sep%

    space-after: %block-sep%

    (make paragraph

      (process-children))))

;; Support for ARG provided by James Bostock, augmented by norm

;;

(element (cmdsynopsis command)

  (make sequence

    (if (first-sibling? (current-node))

	(empty-sosofo)

	(make paragraph-break))

    (next-match)

    (literal " ")))

(element group

  (let ((choice  (attribute-string (normalize "choice")))

	(rep     (attribute-string (normalize "rep")))

	(sepchar (if (inherited-attribute-string (normalize "sepchar"))

		     (inherited-attribute-string (normalize "sepchar"))

		     " ")))

    (make sequence

      (if (equal? (absolute-child-number (current-node)) 1)

	  (empty-sosofo)

	  (literal sepchar))

      (cond

       ((equal? choice (normalize "plain")) (literal %arg-choice-plain-open-str%))

       ((equal? choice (normalize "req")) (literal %arg-choice-req-open-str%))

       ((equal? choice (normalize "opt")) (literal %arg-choice-opt-open-str%))

       (else (literal %arg-choice-def-open-str%)))

      (process-children)

      (cond

       ((equal? choice (normalize "plain")) (literal %arg-choice-plain-close-str%))

       ((equal? choice (normalize "req")) (literal %arg-choice-req-close-str%))

       ((equal? choice (normalize "opt")) (literal %arg-choice-opt-close-str%))

       (else (literal %arg-choice-def-close-str%)))

      (cond

       ((equal? rep (normalize "repeat")) (literal %arg-rep-repeat-str%))

       ((equal? rep (normalize "norepeat")) (literal %arg-rep-norepeat-str%))

       (else (literal %arg-rep-def-str%))))))

(element arg

  (let ((choice  (attribute-string (normalize "choice")))

	(rep     (attribute-string (normalize "rep")))

	(sepchar (if (inherited-attribute-string (normalize "sepchar"))

		     (inherited-attribute-string (normalize "sepchar"))

		     " ")))

    (make sequence

      (if (equal? (absolute-child-number (current-node)) 1)

	  (empty-sosofo)

	  (literal sepchar))

      (cond

       ((equal? choice (normalize "plain")) (literal %arg-choice-plain-open-str%))

       ((equal? choice (normalize "req")) (literal %arg-choice-req-open-str%))

       ((equal? choice (normalize "opt")) (literal %arg-choice-opt-open-str%))

       (else (literal %arg-choice-def-open-str%)))

      (process-children)

      (cond

       ((equal? rep (normalize "repeat")) (literal %arg-rep-repeat-str%))

       ((equal? rep (normalize "norepeat")) (literal %arg-rep-norepeat-str%))

       (else (literal %arg-rep-def-str%)))

      (cond

       ((equal? choice (normalize "plain")) (literal %arg-choice-plain-close-str%))

       ((equal? choice (normalize "req")) (literal %arg-choice-req-close-str%))

       ((equal? choice (normalize "opt")) (literal %arg-choice-opt-close-str%))

       (else (literal %arg-choice-def-close-str%))))))

(element (group arg)

  (let ((choice (attribute-string (normalize "choice")))

	(rep (attribute-string (normalize "rep"))))

    (make sequence

      (if (not (first-sibling? (current-node)))

	  (literal %arg-or-sep%)

	  (empty-sosofo))

      (process-children))))

(element sbr 

  (make paragraph-break))

;; ----------------------------------------------------------------------

;; Syntax highlighting...

(define (funcsynopsis-function #!optional (sosofo (process-children)))

  (make sequence

    font-weight: 'bold

    sosofo))

(define (paramdef-parameter #!optional (sosofo (process-children)))

  (make sequence

    font-posture: 'italic

    sosofo))

;; ----------------------------------------------------------------------

(element synopfragmentref 

  (let* ((target (element-with-id (attribute-string (normalize "linkend"))))

	 (snum   (child-number target)))

    (make sequence

      font-posture: 'italic

      (make link 

	destination: (node-list-address target)

	(make sequence

	  font-posture: 'upright

	  ($callout-bug$ snum)))

      (process-children))))

(element synopfragment

  (let ((snum (child-number (current-node))))

    (make paragraph

      ($callout-bug$ snum)

      (literal " ")

      (process-children))))

(element funcsynopsis 

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

    ;; This used to be a sequence, but that caused the start-indent to be

    ;; wrong when it was the first element of a RefSect.  Making it a

    ;; paragraph makes the bug go away and doesn't seem to have any ill

    ;; effects.  Need to investigate further...

    (make paragraph

      font-family-name: %mono-font-family%

      font-size: (fsize)

      font-weight: 'medium

      font-posture: 'upright

      line-spacing: (* (fsize) %line-spacing-factor%)

      ($informal-object$))))

(element funcsynopsisinfo 

  ;; Fake out the font-size so that when verbatim-display calculates the

  ;; verbatim-size-factor it doesn't get squared.  This will fail if the

  ;; "correct" size isn't bfsize, but what can I do?

  (make sequence

    font-size: %bf-size%

    ($verbatim-display$ %indent-funcsynopsisinfo-lines%

			%number-funcsynopsisinfo-lines%)))

(element funcprototype 

  (let ((paramdefs (select-elements (children (current-node))

				    (normalize "paramdef"))))

    (make sequence

      (make paragraph

	font-family-name: %mono-font-family%

	(process-children))

      (if (equal? %funcsynopsis-style% 'kr)

	  (with-mode kr-funcsynopsis-mode

	    (process-node-list paramdefs))

	  (empty-sosofo)))))

(element funcdef (process-children))

(element (funcdef function) 

  (if %funcsynopsis-decoration%

      (funcsynopsis-function)

      (process-children)))

(element void 

  (if (equal? %funcsynopsis-style% 'ansi)

      (literal "(void);")

      (literal "();")))

(element varargs (literal "(...);"))

(element paramdef

  (let ((param (select-elements (children (current-node)) (normalize "parameter"))))

    (make sequence

      (if (equal? (child-number (current-node)) 1)

	  (literal "(")

	  (empty-sosofo))

      (if (equal? %funcsynopsis-style% 'ansi)

	  (process-children)

	  (process-node-list param))

      (if (equal? (gi (ifollow (current-node))) (normalize "paramdef"))

	  (literal ", ")

	  (literal ");")))))

(element (paramdef parameter)

  (make sequence

    (if %funcsynopsis-decoration%

      (paramdef-parameter)

      (process-children))

    (if (equal? (gi (ifollow (current-node))) (normalize "parameter"))

	(literal ", ")

	(empty-sosofo))))

(element funcparams 

  (make sequence 

    (literal "(")

    (process-children)

    (literal ")")))

(mode kr-funcsynopsis-mode

  (element paramdef

    (make sequence

      (make paragraph

	font-family-name: %mono-font-family%

	start-indent: (+ (inherited-start-indent) %kr-funcsynopsis-indent%)

	(make sequence

	  (process-children) 

	  (literal ";"))))))