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