;; $Id: dbefsyn.dsl,v 1.4 2003/01/15 08:24:13 adicarlo Exp $
;;
;; This file is part of the Modular DocBook Stylesheet distribution.
;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
;;

;; ============================ CLASS SYNOPSIS =============================

(define %indent-classsynopsisinfo-lines% #f)
(define %number-classsynopsisinfo-lines% #f)

(define %default-classsynopsis-language% "java")

(element classsynopsis
  (let ((language (if (attribute-string (normalize "language"))
		      (attribute-string (normalize "language"))
		      %default-classsynopsis-language%)))
    (case language
      (("java") (with-mode cs-java-mode
		  (process-node-list (current-node))))
      (("perl") (with-mode cs-perl-mode
		  (process-node-list (current-node))))
      (("idl") (with-mode cs-idl-mode
		  (process-node-list (current-node))))
      (("cpp") (with-mode cs-cpp-mode
		  (process-node-list (current-node))))
      (("python") (with-mode cs-python-mode
		    (process-node-list (current-node))))
      (else (with-mode cs-java-mode
	      (process-node-list (current-node)))))))

(element methodsynopsis
  (let ((language (if (attribute-string (normalize "language"))
		      (attribute-string (normalize "language"))
		      %default-classsynopsis-language%)))
    (case language
      (("java") (with-mode cs-java-mode
		  (process-node-list (current-node))))
      (("perl") (with-mode cs-perl-mode
		  (process-node-list (current-node))))
      (("idl") (with-mode cs-idl-mode
		  (process-node-list (current-node))))
      (("cpp") (with-mode cs-cpp-mode
		  (process-node-list (current-node))))
      (("python") (with-mode cs-python-mode
		    (process-node-list (current-node))))
      (else (with-mode cs-java-mode
	      (process-node-list (current-node)))))))

(element fieldsynopsis
  (let ((language (if (attribute-string (normalize "language"))
		      (attribute-string (normalize "language"))
		      %default-classsynopsis-language%)))
    (case language
      (("java") (with-mode cs-java-mode
		  (process-node-list (current-node))))
      (("perl") (with-mode cs-perl-mode
		  (process-node-list (current-node))))
      (("idl") (with-mode cs-idl-mode
		  (process-node-list (current-node))))
      (("cpp") (with-mode cs-cpp-mode
		  (process-node-list (current-node))))
      (("python") (with-mode cs-python-mode
		    (process-node-list (current-node))))
      (else (with-mode cs-java-mode
	      (process-node-list (current-node)))))))

(element constructorsynopsis
  (let ((language (if (attribute-string (normalize "language"))
		      (attribute-string (normalize "language"))
		      %default-classsynopsis-language%)))
    (case language
      (("java") (with-mode cs-java-mode
		  (process-node-list (current-node))))
      (("perl") (with-mode cs-perl-mode
		  (process-node-list (current-node))))
      (("idl") (with-mode cs-idl-mode
		  (process-node-list (current-node))))
      (("cpp") (with-mode cs-cpp-mode
		  (process-node-list (current-node))))
      (("python") (with-mode cs-python-mode
		    (process-node-list (current-node))))
      (else (with-mode cs-java-mode
	      (process-node-list (current-node)))))))

(element destructorsynopsis
  (let ((language (if (attribute-string (normalize "language"))
		      (attribute-string (normalize "language"))
		      %default-classsynopsis-language%)))
    (case language
      (("java") (with-mode cs-java-mode
		  (process-node-list (current-node))))
      (("perl") (with-mode cs-perl-mode
		  (process-node-list (current-node))))
      (("idl") (with-mode cs-idl-mode
		  (process-node-list (current-node))))
      (("cpp") (with-mode cs-cpp-mode
		  (process-node-list (current-node))))
      (("python") (with-mode cs-python-mode
		    (process-node-list (current-node))))
      (else (with-mode cs-java-mode
	      (process-node-list (current-node)))))))

;; ===== Java ========================================================

(mode cs-java-mode

(element classsynopsis
  (let* ((classes      (select-elements (children (current-node))
					(normalize "ooclass")))
	 (classname    (node-list-first classes))
	 (superclasses (node-list-rest classes)))
    (make element gi: "pre"
	  attributes: '(("class" "classsynopsis"))
	  (process-node-list classname)
	  (process-node-list superclasses)
	  (literal "{&#RE;")
	  (process-node-list
	   (node-list-filter-by-gi
	    (children (current-node))
	    (list (normalize "constructorsynopsis")
		  (normalize "destructorsynopsis")
		  (normalize "fieldsynopsis")
		  (normalize "methodsynopsis")
		  (normalize "classsynopsisinfo"))))
	  (literal "}"))))

(element classsynopsisinfo
  ($verbatim-display$ %indent-classsynopsisinfo-lines%
		      %number-classsynopsisinfo-lines%))

(element ooclass
  (make sequence
    (if (first-sibling?)
	(literal " ")
	(literal ", "))
    (make element gi: "SPAN"
	  attributes: '(("class" "ooclass"))
	  (process-children))))

(element oointerface
  (make sequence
    (if (first-sibling?)
	(literal " ")
	(literal ", "))
    (make element gi: "SPAN"
	  attributes: '(("class" "oointerface"))
	  (process-children))))

(element ooexception
  (make sequence
    (if (first-sibling?)
	(literal " ")
	(literal ", "))
    (make element gi: "SPAN"
	  attributes: '(("class" "ooexception"))
	  (process-children))))

(element modifier
  (make element gi: "span"
	attributes: '(("class" "modifier"))
	(process-children)
	(literal " ")))

(element classname
  (if (first-sibling?)
      (make sequence
	(literal "class ")
	(make element gi: "span"
	      attributes: '(("class" "classname"))
	      (process-children)
	      (literal " "))
	(if (last-sibling?)
	    (empty-sosofo)
	    (literal "extends ")))
      (make sequence
	(make element gi: "span"
	      attributes: '(("class" "superclass"))
	      (process-children))
	(if (last-sibling?)
	    (literal " ")
	    (literal ", ")))))

(element fieldsynopsis
  (make element gi: "code"
	attributes: '(("class" "fieldsynopsis"))
	(literal "  ")
	(process-children)
	(literal ";&#RE;")))

(element type
  (make element gi: "span"
	attributes: '(("class" "type"))
	(process-children)
	(literal " ")))

(element varname
  (make element gi: "span"
	attributes: '(("class" "varname"))
	(process-children)))

(element initializer
  (make element gi: "span"
	attributes: '(("class" "initializer"))
	(literal " = ")
	(process-children)))

(element constructorsynopsis
  (java-method-synopsis))

(element destructorsynopsis
  (java-method-synopsis))

(element methodsynopsis
  (java-method-synopsis))

(element void
  (make element gi: "span"
	attributes: '(("class" "void"))
	(literal "void ")))

(element methodname
  (process-children))

(element methodparam
  (make element gi: "span"
	attributes: '(("class" "methodparam"))
	(if (first-sibling?)
	    (empty-sosofo)
	    (literal ", "))
	(process-children)))

(element parameter
  (make element gi: "span"
	attributes: '(("class" "parameter"))
	(process-children)))

(element exceptionname
  (make element gi: "span"
	attributes: '(("class" "exceptionname"))
	(if (first-sibling?)
	    (literal "&#RE;          throws ")
	    (literal ", "))
	(process-children)))
)

(define (java-method-synopsis #!optional (nd (current-node)))
  (let* ((modifiers  (select-elements (children nd)
				      (normalize "modifier")))
	 (notmod     (node-list-filter-by-not-gi
		      (children nd)
		      (list (normalize "modifier"))))
	 (type       (if (equal? (gi (node-list-first notmod)) 
				 (normalize "methodname"))
			 (empty-node-list)
			 (node-list-first notmod)))
	 (methodname (select-elements (children nd)
				      (normalize "methodname")))
	 (param      (node-list-filter-by-gi (node-list-rest notmod)
					     (list (normalize "methodparam"))))
	 (excep      (select-elements (children nd)
				      (normalize "exceptionname"))))
    (make element gi: "code"
	  attributes: (list (list "class" (gi nd)))
	  (if (first-sibling?)
	      (literal "&#RE;")
	      (empty-sosofo))
	  (literal "  ")
	  (process-node-list modifiers)
	  (process-node-list type)
	  (process-node-list methodname)
	  (literal "(")
	  (process-node-list param)
	  (literal ")")
	  (process-node-list excep)
	  (literal ";&#RE;"))))

;; ===== C++ =========================================================

(mode cs-cpp-mode

(element classsynopsis
  (let* ((classes      (node-list-filter-by-gi (children (current-node))
					       (list (normalize "classname")
						     (normalize "modifier"))))
	 (classname    (let loop ((nl classes) (cn (empty-node-list)))
			 (if (node-list-empty? nl)
			     cn
			     (if (equal? (gi (node-list-first nl))
					 (normalize "classname"))
				 (node-list cn (node-list-first nl))
				 (loop (node-list-rest nl)
				       (node-list cn (node-list-first nl)))))))

	 (superclasses (let loop ((nl classes))
			 (if (node-list-empty? nl)
			     (empty-node-list)
			     (if (equal? (gi (node-list-first nl))
					 (normalize "classname"))
				 (node-list-rest nl)
				 (loop (node-list-rest nl)))))))
    (make element gi: "pre"
	  attributes: '(("class" "classsynopsis"))
	  (process-node-list classname)
	  (process-node-list superclasses)
	  (literal "{&#RE;")
	  (process-node-list
	   (node-list-filter-by-gi
	    (children (current-node))
	    (list (normalize "constructorsynopsis")
		  (normalize "destructorsynopsis")
		  (normalize "fieldsynopsis")
		  (normalize "methodsynopsis")
		  (normalize "classsynopsisinfo"))))
	  (literal "}"))))

(element classsynopsisinfo
  ($verbatim-display$ %indent-classsynopsisinfo-lines%
		      %number-classsynopsisinfo-lines%))

(element modifier
  (make element gi: "span"
	attributes: '(("class" "modifier"))
	(process-children)
	(literal " ")))

(element classname
  (if (first-sibling?)
      (make sequence
	(literal "class ")
	(make element gi: "span"
	      attributes: '(("class" "classname"))
	      (process-children))
	(if (last-sibling?)
	    (empty-sosofo)
	    (literal ": ")))
      (make sequence
	(make element gi: "span"
	      attributes: '(("class" "superclass"))
	      (process-children))
	(if (last-sibling?)
	    (literal " ")
	    (literal ", ")))))

(element fieldsynopsis
  (make element gi: "code"
	attributes: '(("class" "fieldsynopsis"))
	(literal "  ")
	(process-children)
	(literal ";&#RE;")))

(element type
  (make element gi: "span"
	attributes: '(("class" "type"))
	(process-children)
	(literal " ")))

(element varname
  (make element gi: "span"
	attributes: '(("class" "varname"))
	(process-children)))

(element initializer
  (make element gi: "span"
	attributes: '(("class" "initializer"))
	(literal " = ")
	(process-children)))

(element constructorsynopsis
  (cpp-method-synopsis))

(element destructorsynopsis
  (cpp-method-synopsis))

(element methodsynopsis
  (cpp-method-synopsis))

(element void
  (make element gi: "span"
	attributes: '(("class" "void"))
	(literal "void ")))

(element methodname
  (process-children))

(element methodparam
  (make element gi: "span"
	attributes: '(("class" "methodparam"))
	(if (first-sibling?)
	    (empty-sosofo)
	    (literal ", "))
	(process-children)))

(element parameter
  (make element gi: "span"
	attributes: '(("class" "parameter"))
	(process-children)))

(element exceptionname
  (make element gi: "span"
	attributes: '(("class" "exceptionname"))
	(if (first-sibling?)
	    (literal "&#RE;          throws ")
	    (literal ", "))
	(process-children)))
)

(define (cpp-method-synopsis #!optional (nd (current-node)))
  (let* ((modifiers  (select-elements (children nd)
				      (normalize "modifier")))
	 (notmod     (node-list-filter-by-not-gi
		      (children nd)
		      (list (normalize "modifier"))))
	 (type       (if (equal? (gi (node-list-first notmod)) 
				 (normalize "methodname"))
			 (empty-node-list)
			 (node-list-first notmod)))
	 (methodname (select-elements (children nd)
				      (normalize "methodname")))
	 (param      (node-list-filter-by-gi (node-list-rest notmod)
					     (list (normalize "methodparam"))))
	 (excep      (select-elements (children nd)
				      (normalize "exceptionname"))))
    (make element gi: "code"
	  attributes: (list (list "class" (gi nd)))
	  (if (first-sibling?)
	      (literal "&#RE;")
	      (empty-sosofo))
	  (literal "  ")
	  (process-node-list modifiers)
	  (process-node-list type)
	  (process-node-list methodname)
	  (literal "(")
	  (process-node-list param)
	  (literal ")")
	  (process-node-list excep)
	  (literal ";&#RE;"))))

;; ===== Perl ======================================================== 

(mode cs-perl-mode

(element classsynopsis
  (let* ((modifiers    (select-elements (children (current-node))
					(normalize "modifier")))
	 (classes      (select-elements (children (current-node))
					(normalize "classname")))
	 (classname    (node-list-first classes))
	 (superclasses (node-list-rest classes)))
  (make element gi: "pre"
	attributes: '(("class" "classsynopsis"))
	(literal "package ")
	(process-node-list classname)
	(literal ";&#RE;")
	(if (node-list-empty? superclasses)
	    (empty-sosofo)
	    (make sequence
	      (literal "@ISA = (");
	      (process-node-list superclasses)
	      (literal ";&#RE;")))
	(process-node-list
	 (node-list-filter-by-gi
	  (children (current-node))
	  (list (normalize "constructorsynopsis")
		(normalize "destructorsynopsis")
		(normalize "fieldsynopsis")
		(normalize "methodsynopsis")
		(normalize "classsynopsisinfo")))))))

(element classsynopsisinfo
  ($verbatim-display$ %indent-classsynopsisinfo-lines%
		      %number-classsynopsisinfo-lines%))

(element modifier
  (literal "Perl ClassSynopses don't use Modifiers"))

(element classname
  (if (first-sibling?)
      (make element gi: "span"
	    attributes: '(("class" "classname"))
	    (process-children))
      (make sequence
	(make element gi: "span"
	      attributes: '(("class" "superclass"))
	      (process-children))
	(if (last-sibling?)
	    (empty-sosofo)
	    (literal ", ")))))

(element fieldsynopsis
  (make element gi: "code"
	attributes: '(("class" "fieldsynopsis"))
	(literal "  ");
	(process-children)
	(literal ";&#RE;")))

(element type
  (make element gi: "span"
	attributes: '(("class" "type"))
	(process-children)
	(literal " ")))

(element varname
  (make element gi: "span"
	attributes: '(("class" "varname"))
	(process-children)))

(element initializer
  (make element gi: "span"
	attributes: '(("class" "initializer"))
	(literal " = ")
	(process-children)
	(literal " ")))

(element constructorsynopsis
  (perl-method-synopsis))

(element destructorsynopsis
  (perl-method-synopsis))

(element methodsynopsis
  (perl-method-synopsis))

(element void
  (empty-sosofo))

(element methodname
  (make element gi: "span"
	attributes: '(("class" "methodname"))
	(process-children)))

(element methodparam
  (make element gi: "span"
	attributes: '(("class" "methodparam"))
	(if (first-sibling?)
	    (empty-sosofo)
	    (literal ", "))
	(process-children)))

(element parameter
  (make element gi: "span"
	attributes: '(("class" "parameter"))
	(process-children)))

(element exceptionname
  (literal "Perl ClassSynopses don't use Exceptions"))

)

(define (perl-method-synopsis #!optional (nd (current-node)))
  (let* ((modifiers  (select-elements (children nd)
				      (normalize "modifier")))
	 (notmod     (node-list-filter-by-not-gi
		      (children nd)
		      (list (normalize "modifier"))))
	 (type       (if (equal? (gi (node-list-first notmod)) 
				 (normalize "methodname"))
			 (empty-node-list)
			 (node-list-first notmod)))
	 (methodname (select-elements (children nd)
				      (normalize "methodname")))
	 (param      (node-list-filter-by-gi (node-list-rest notmod)
					     (list (normalize "type")
						   (normalize "void"))))
	 (excep      (select-elements (children nd)
				      (normalize "exceptionname"))))
    (make element gi: "code"
	  attributes: (list (list "class" (gi nd)))
	  (literal "sub ")
	  (process-node-list modifiers)
	  (process-node-list type)
	  (process-node-list methodname)
	  (literal " { ... }"))))

;; ===== IDL ========================================================= 

(mode cs-idl-mode

(element classsynopsis
  (let* ((modifiers    (select-elements (children (current-node))
					(normalize "modifier")))
	 (classes      (select-elements (children (current-node))
					(normalize "classname")))
	 (classname    (node-list-first classes))
	 (superclasses (node-list-rest classes)))
  (make element gi: "pre"
	attributes: '(("class" "classsynopsis"))
	(literal "interface ")
	(process-node-list modifiers)
	(process-node-list classname)
	(if (node-list-empty? superclasses)
	    (literal " ")
	    (make sequence
	      (literal " : ")
	      (process-node-list superclasses)))
	(literal " {&#RE;")
	(process-node-list
	 (node-list-filter-by-gi
	  (children (current-node))
	  (list (normalize "constructorsynopsis")
		(normalize "destructorsynopsis")
		(normalize "fieldsynopsis")
		(normalize "methodsynopsis")
		(normalize "classsynopsisinfo"))))
	(literal "}"))))

(element classsynopsisinfo
  ($verbatim-display$ %indent-classsynopsisinfo-lines%
		      %number-classsynopsisinfo-lines%))

(element modifier
  (make element gi: "span"
	attributes: '(("class" "modifier"))
    (process-children)
    (literal " ")))

(element classname
  (if (first-sibling?)
      (make element gi: "span"
	    attributes: '(("class" "classname"))
	    (process-children))
      (make sequence
	(make element gi: "span"
	      attributes: '(("class" "superclass"))
	      (process-children))
	(if (last-sibling?)
	    (empty-sosofo)
	    (literal ", ")))))

(element fieldsynopsis
  (make element gi: "code"
	attributes: '(("class" "fieldsynopsis"))
	(literal "  ");
	(process-children)
	(literal ";&#RE;")))

(element type
  (make element gi: "span"
	attributes: '(("class" "type"))
	(process-children)
	(literal " ")))

(element varname
  (make element gi: "span"
	attributes: '(("class" "varname"))
	(process-children)))

(element initializer
  (make element gi: "span"
	attributes: '(("class" "initializer"))
	(literal " = ")
	(process-children)
	(literal " ")))

(element constructorsynopsis
  (idl-method-synopsis))

(element destructorsynopsis
  (idl-method-synopsis))

(element methodsynopsis
  (idl-method-synopsis))

(element void
  (make element gi: "span"
	attributes: '(("class" "void"))
	(literal "void ")))

(element methodname
  (make element gi: "span"
	attributes: '(("class" "methodname"))
	(process-children)))

(element methodparam
  (make element gi: "span"
	attributes: '(("class" "methodparam"))
	(if (first-sibling?)
	    (empty-sosofo)
	    (literal ", "))
	(process-children)))

(element parameter
  (make element gi: "span"
	attributes: '(("class" "parameter"))
	(process-children)))

(element exceptionname
  (make element gi: "span"
	attributes: '(("class" "exceptionname"))
	(if (first-sibling?)
	    (literal " raises(")
	    (literal ", "))
	(process-children)
	(if (last-sibling?)
	    (literal ")")
	    (empty-sosofo))))
)

(define (idl-method-synopsis #!optional (nd (current-node)))
  (let* ((modifiers  (select-elements (children nd)
				      (normalize "modifier")))
	 (notmod     (node-list-filter-by-not-gi
		      (children nd)
		      (list (normalize "modifier"))))
	 (type       (if (equal? (gi (node-list-first notmod)) 
				 (normalize "methodname"))
			 (empty-node-list)
			 (node-list-first notmod)))
	 (methodname (select-elements (children nd)
				      (normalize "methodname")))
	 (param      (node-list-filter-by-gi (node-list-rest notmod)
					     (list (normalize "methodparam"))))
	 (excep      (select-elements (children nd)
				      (normalize "exceptionname"))))
    (make element gi: "code"
	  attributes: (list (list "class" (gi nd)))
	  (literal "  ")
	  (process-node-list modifiers)
	  (process-node-list type)
	  (process-node-list methodname)
	  (literal "(")
	  (process-node-list param)
	  (literal ")")
	  (process-node-list excep)
	  (literal ";&#RE;"))))

;; ===== Python ======================================================= 
;; Contributed by Lane Stevens, lane@cycletime.com

(mode cs-python-mode
  (element classsynopsis
    (let* ((classes      (select-elements (children (current-node))
					  (normalize "ooclass")))
	   (classname    (node-list-first classes))
	   (superclasses (node-list-rest classes)))
      (make element gi: "pre"
	    attributes: '(("class" "classsynopsis"))
	    (literal "class ")
	    (process-node-list classname)
	    (literal "(")
	    (process-node-list superclasses)
	    (literal ") :")
	    (process-node-list
	     (node-list-filter-by-gi
	      (children (current-node))
	      (list (normalize "constructorsynopsis")
		    (normalize "destructorsynopsis")
		    (normalize "fieldsynopsis")
		    (normalize "methodsynopsis")
		    (normalize "classsynopsisinfo"))))
	    )
      )
    )

  (element ooclass
    (make sequence
      (make element gi: "SPAN"
	    attributes: '(("class" "ooclass"))
	    (process-children)
	    (cond
	     ((first-sibling?) (literal " "))
	     ((last-sibling?) (empty-sosofo))
	     (#t (literal ", "))
	     )
	    )
      )
    )
	    
  (element classname
    (if (first-sibling?)
	(make element gi: "SPAN"
	      attributes: '(("class" "classname"))
	      (process-children))
	(make element gi: "SPAN"
	      attributes: '(("class" "superclass")))
	)
    )

  (element methodsynopsis
    (python-method-synopsis))

  (element initializer
    (make element gi: "SPAN"
	  attributes: '(("class" "initializer"))
	  (literal " = ")
	  (process-children)))
  
  (element methodname
    (process-children))

  (element methodparam
    (make element gi: "SPAN"
	  attributes: '(("class" "methodparam"))
	  (process-children)
	  (if (last-sibling?)
	      (empty-sosofo)
	      (literal ", "))
	  )
    )
	      
    
  (element parameter
    (make element gi: "SPAN"
	  attributes: '(("class" "parameter"))
	  (process-children)))

  
  )

(define (python-method-synopsis #!optional (nd (current-node)))
  (let* ((the-method-name (select-elements (children nd) (normalize "methodname")))
	 (the-method-params (select-elements (children nd) (normalize "methodparam"))))
    (make element gi: "code"
	  attributes: (list (list "class" (gi nd)))
	  (literal "    def ")
	  (process-node-list the-method-name)
	  (literal "(")
	  (process-node-list the-method-params)
	  (literal ") :")
	  )
    )
  )

;; EOF