TIVI-153: Add docbook-style-dssl as dep for iputilsHEADsubmit/trunk/20120831.183452accepted/trunk/20120904.1915411.0_branch2.0alpha1.0

1 files changed, 172 insertions, 0 deletions

diff --git a/html/dbqanda.dsl b/html/dbqanda.dsl
new file mode 100644
index 0000000..633b26e
--- /dev/null
+++ b/html/dbqanda.dsl
@@ -0,0 +1,172 @@
+;; $Id: dbqanda.dsl,v 1.1 2003/03/25 19:53:41 adicarlo Exp $
+;;
+;; This file is part of the Modular DocBook Stylesheet distribution.
+;; See ../README or http://docbook.sourceforge.net/projects/dsssl/
+;;
+
+;; ============================== QANDASET ==============================
+
+(define (qanda-defaultlabel)
+  (normalize "number"))
+
+(define (qanda-section-level)
+  ;; FIXME: what if they nest inside each other?
+  (let* ((enclsect (ancestor-member (current-node)
+				    (list (normalize "section")
+					  (normalize "simplesect")
+					  (normalize "sect5")
+					  (normalize "sect4")
+					  (normalize "sect3")
+					  (normalize "sect2")
+					  (normalize "sect1")
+					  (normalize "refsect3")
+					  (normalize "refsect2")
+					  (normalize "refsect1")))))
+    (SECTLEVEL enclsect)))
+
+(define (qandadiv-section-level)
+  (let ((depth (length (hierarchical-number-recursive 
+			(normalize "qandadiv")))))
+    (+ (qanda-section-level) depth)))
+
+(element qandaset
+  (let ((title (select-elements (children (current-node)) 
+				(normalize "title")))
+	;; process title and rest separately so that we can put the TOC
+	;; in the rigth place...
+	(rest  (node-list-filter-by-not-gi (children (current-node))
+					   (list (normalize "title")))))
+    (make element gi: "DIV"
+	  attributes: (list (list "CLASS" (gi)))
+	  (process-node-list title)
+	  (if ($generate-qandaset-toc$)
+	      (process-qanda-toc)
+	      (empty-sosofo))
+	  (process-node-list rest))))
+
+(element (qandaset title)
+  (let* ((htmlgi  (string-append "H" (number->string 
+				      (+ (qanda-section-level) 1)))))
+    (make element gi: htmlgi
+	  attributes: (list (list "CLASS" (gi (current-node))))
+	  (process-children))))
+
+(element qandadiv
+  (make element gi: "DIV"
+	attributes: (list (list "CLASS" (gi)))
+	(process-children)))
+
+(element (qandadiv title)
+  (let* ((hnr     (hierarchical-number-recursive (normalize "qandadiv")
+						 (current-node)))
+	 (number  (let loop ((numlist hnr) (number "") (sep ""))
+		    (if (null? numlist)
+			number
+			(loop (cdr numlist) 
+			      (string-append number
+					     sep
+					     (number->string (car numlist)))
+			      "."))))
+	 (htmlgi  (string-append "H" (number->string 
+				      (+ (qandadiv-section-level) 1)))))
+    (make element gi: htmlgi
+	  (make element gi: "A"
+		attributes: (list (list "NAME" (element-id 
+						(parent (current-node)))))
+		(empty-sosofo))
+	  (literal number ". ")
+	  (process-children))))
+
+(element qandaentry
+  (make element gi: "DIV"
+	attributes: (list (list "CLASS" (gi)))
+	(process-children)))
+
+(element question
+  (let* ((chlist   (children (current-node)))
+	 (firstch  (node-list-first chlist))
+	 (restch   (node-list-rest chlist)))
+    (make element gi: "DIV"
+	  attributes: (list (list "CLASS" (gi)))
+	  (make element gi: "P"
+		(make element gi: "A"
+		      attributes: (list (list "NAME" (element-id)))
+		      (empty-sosofo))
+		(make element gi: "B"
+		      (literal (question-answer-label (current-node)) " "))
+		(process-node-list (children firstch)))
+	  (process-node-list restch))))
+
+(element answer
+  (let* ((inhlabel (inherited-attribute-string (normalize "defaultlabel")))
+	 (deflabel (if inhlabel inhlabel (qanda-defaultlabel)))
+	 (label    (attribute-string (normalize "label")))
+	 (chlist   (children (current-node)))
+	 (firstch  (node-list-first chlist))
+	 (restch   (node-list-rest chlist)))
+    (make element gi: "DIV"
+	  attributes: (list (list "CLASS" (gi)))
+	  (make element gi: "P"
+		(make element gi: "B"
+		      (literal (question-answer-label (current-node)) " "))
+		(process-node-list (children firstch)))
+	  (process-node-list restch))))
+
+;; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 
+
+(define (process-qanda-toc #!optional (node (current-node)))
+  (let* ((divs     (node-list-filter-by-gi (children node)
+					   (list (normalize "qandadiv"))))
+	 (entries  (node-list-filter-by-gi (children node)
+					   (list (normalize "qandaentry"))))
+	 (inhlabel (inherited-attribute-string (normalize "defaultlabel")))
+	 (deflabel (if inhlabel inhlabel (qanda-defaultlabel))))
+    (make element gi: "DL"
+	  (with-mode qandatoc
+	    (process-node-list divs))
+	  (with-mode qandatoc
+	    (process-node-list entries)))))
+
+(mode qandatoc
+  (element qandadiv
+    (let ((title (select-elements (children (current-node))
+				  (normalize "title"))))
+      (make sequence
+	(make element gi: "DT"
+	      (process-node-list title))
+	(make element gi: "DD"
+	      (process-qanda-toc)))))
+  
+  (element (qandadiv title)
+    (let* ((hnr     (hierarchical-number-recursive (normalize "qandadiv")
+						   (current-node)))
+	   (number  (let loop ((numlist hnr) (number "") (sep ""))
+		      (if (null? numlist)
+			  number
+			  (loop (cdr numlist) 
+				(string-append number
+					       sep
+					       (number->string (car numlist)))
+				".")))))
+      (make sequence
+	(literal number ". ")
+	(make element gi: "A"
+	      attributes: (list (list "HREF" 
+				      (href-to (parent (current-node)))))
+	      (process-children)))))
+
+  (element qandaentry
+    (process-children))
+
+  (element question
+    (let* ((chlist   (children (current-node)))
+	   (firstch  (node-list-first chlist)))
+      (make element gi: "DT"
+	    (literal (question-answer-label (current-node)) " ")
+	    (make element gi: "A"
+		  attributes: (list (list "HREF" (href-to (current-node))))
+		  (process-node-list (children firstch))))))
+  
+  (element answer
+    (empty-sosofo))
+)