;; $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