[docbook-apps] Newbie trying to make htmlhelp.dsl modifications

[Thomas Søndergaard <ts at medical-insight dot com>]

Hello,

I'm working on a project where we use docbook to generate the user
documentation. The html-output is used for the online help system which
is displayed using Qt Assistant - a program very similar to mswindows
help. This program needs a "profile" - an xml file that specifies the
structure of the document and the keywords. I found a stylesheet called
htmlhelp.dsl, which generates such files for mswindows help system and
modified it to generate a Qt assistant profile for me, and it almost
works. I have one minor problem, which is that the links I generate in
the profile for indexterm's are (slightly) wrong! I really have no idea
how to fix this problem, since I don't really understand how the
stylesheet works, my modifications are merely done using mental pattern
matching :-)

(mode qtassistantkeywords
  ;; this mode is really just a hack to get at the root element
  (root (process-children))

  (default 
    (if (node-list=? (current-node) (sgml-root-element))
	  (process-node-list (select-elements 
			      (descendants (current-node))
			      (normalize "indexterm")))
	(empty-sosofo)))

  (element indexterm
      (make sequence
	(make formatting-instruction data: "\less-than-sign;keyword")

	(make formatting-instruction data: (string-append " ref=\"" (href-to
(current-node)) "\""))

	(make formatting-instruction data: "\greater-than-sign;")

	(process-children)

	(make formatting-instruction data:
"\less-than-sign;/keyword\greater-than-sign;
")))
		    
  (element primary
    (htmlhelpindexterm))

)

An example of the problem I get is that for a particular section in the
html generated from a docbook section with an indexterm I might have an
anchor labeled AEN95, but the link I generate in the profile uses the
anchor #AEN97.

Furthermore if give a section og chapter an id, that id will be used as
the name in the html, but my generated index still uses the
AEN[XX]-thingy.

I've attached the stylesheet and the desired output format is documented
here, if you are interested:
http://doc.trolltech.com/3.3/assistant-6.html

Your help is appreciated.

br,

Thomas Sondergaard

<!DOCTYPE style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" [
<!ENTITY dbstyle SYSTEM "/usr/share/sgml/docbook/dsssl-stylesheets-1.76/html/docbook.dsl" CDATA DSSSL>
]>

<style-sheet>

<style-specification use="docbook">
<style-specification-body> 

;; Generation of Qt Assistant configuration file added by Thomas Sondergaard


(define %graphic-default-extension%
  "png")

;; These are some customizations to the Modular DocBook Stylesheets to produce
;; compiled HTML help files.
;;
;; José Fonseca


;; ts: not necessary, use the lang="da" on the book element
;(define %default-language% "dk")

;; Don't generate Table of Contents

(define ($generate-chapter-toc$) #f)
(define ($generate-qandaset-toc$) #f)

(define %generate-article-toc% #f)
(define %generate-book-toc% #f)
(define %generate-part-toc% #f)
(define %generate-reference-toc% #f)
(define %generate-set-toc% #f)

;; Stylesheet customization (taken from ldp.dsl)

(define %html-ext%
  ;; when producing HTML files, use this extension
  ".html")

;; forces the Table of Contents on separate page
;(define (chunk-skip-first-element-list)
;  '())

(define (chunk-element-list)
  (list (normalize "preface")
	(normalize "chapter")
	(normalize "appendix") 
	(normalize "article")
	(normalize "glossary")
	(normalize "bibliography")
	(normalize "index")
	(normalize "colophon")
	(normalize "setindex")
	(normalize "reference")
	(normalize "refentry")
	(normalize "part")
;	(normalize "sect1") 
	(normalize "section") 
	(normalize "book") ;; just in case nothing else matches...
	(normalize "set")  ;; sets are definitely chunks...
	))

;;Titlepage Not Separate
(define (chunk-skip-first-element-list)
  (list (normalize "sect1")
	(normalize "section")))

(define %root-filename%
  ;; The filename of the root HTML document (e.g, "index").
  "index")

(define %use-id-as-filename%
  ;; Use ID attributes as name for component HTML files?
  #t)


;; Element generation (based on Norman Walsh's htmlhelp.dsl)

(define (extract-gi args)
  (let ((gi (member gi: args)))
    (if gi
	(car (cdr gi))
	"")))

(define (extract-node args)
  (let ((node (member node: args)))
    (if node
	(car (cdr node))
	#f)))

(define (extract-attributes args)
  (let ((attr (member attributes: args)))
    (if attr
	(car (cdr attr))
	'())))

(define (extract-sosofos args)
  (let loop ((l args) (results '()))
    (if (null? l)
	results
	(if (not (keyword? (car l)))
	    (loop (cdr l) (append results (list (car l))))
	    (loop (cdr (cdr l)) results)))))

(define (make-element #!rest args)
  ;; Args _MUST_ be '( gi: "gi" attributes: '() sosofo...) where sosofo
  ;; is optional.
  (let* ((node       (if (extract-node args)
			 (extract-node args)
			 (current-node)))
	 (giname     (extract-gi args))
	 (attr       (extract-attributes args))
	 (sosofo     (extract-sosofos args)))
    (sosofo-append
      (make formatting-instruction data: (string-append "<" giname))
      (if (null? attr)
	  (empty-sosofo)
	  (let loop ((a attr))
	    (if (null? a)
		(empty-sosofo)
		(make sequence
		  (let* ((attrlist (car a))
			 (name (car attrlist))
			 (value (car (cdr attrlist))))
		    (make formatting-instruction 
		      data: (string-append " " name "=\"" (if value value "whatthe") "\"")))
		  (loop (cdr a))))))
      
      (make formatting-instruction data: ">")
      (htmlnewline)

      (if sosofo
	  (apply sosofo-append sosofo)
	  (current-node))

      (make formatting-instruction data: (string-append "</" giname ">"))
      (htmlnewline ))))

(define (make-empty-element #!rest args)
  ;; Args _MUST_ be '( gi: "gi" attributes: '() sosofo)
  (let* ((giname (extract-gi args))
	 (attributes (extract-attributes args))
	 (attr attributes))
    (sosofo-append
      (make formatting-instruction data: (string-append "<" giname))
      (if (null? attr)
	  (empty-sosofo)
	  (let loop ((a attr))
	    (if (null? a)
		(empty-sosofo)
		(make sequence
		  (make formatting-instruction 
		    data: (string-append " " 
					 (car (car a)) 
					 "=\"" 
					 (car (cdr (car a)))
					 "\""))
		  (loop (cdr a))))))

      (make formatting-instruction data: ">")
      (htmlnewline))))

;; Table of Contents generation (based on dbautoc.dsl, v1.76)

(define (htmlhelp-toc-depth)
  10)

(define (build-htmlhelp-toc nd depth #!optional (first? #t))
  (let ((toclist (toc-list-filter 
		  (node-list-filter-by-gi (children nd)
					  (append (division-element-list)
						  (component-element-list)
						  (section-element-list))))))
    (if (or (<= depth 0) 
	    (and (node-list-empty? toclist) #f))
      (empty-sosofo)
      (make sequence
        (make-element gi: "LI"
	  (make-element gi: "OBJECT"
	    attributes: '(("type" "text/sitemap"))
	    (make-empty-element gi: "param"
	      attributes: (list (list "name" "Name")
			  (list "value" (element-title-string nd))))
	    (make-empty-element gi: "param"
	      attributes: (list (list "name" "Local")
			  (list "value" (href-to nd))))))
	  (make-element gi: "UL"
	    (let loop ((nl toclist))
	      (if (node-list-empty? nl)
		  (empty-sosofo)
		  (sosofo-append
		   (build-htmlhelp-toc (node-list-first nl) 
				       (- depth 1) #f)
		   (loop (node-list-rest nl))))))))))

(define (build-qt-assistant-adp nd #!optional (iterationCount 0))
  (let ((toclist (toc-list-filter 
		  (node-list-filter-by-gi (children nd)
					  (append (division-element-list)
						  (component-element-list)
						  (section-element-list))))))
    (if (node-list-empty? toclist)
	(make-element gi: (if (= iterationCount 0) "DCF" "section")
		      attributes: (list (list "ref" (href-to nd))
					(list "title" (element-title-string nd))))
	
	(make sequence
	  (make-element gi: (if (= iterationCount 0) "DCF" "section")
			attributes: (list (list "ref" (href-to nd))
					  (list "title" (element-title-string nd)))
			(if (= iterationCount 1) (make-qt-assistant-keywords) (empty-sosofo))
			(let loop ((nl toclist))
			  (if (node-list-empty? nl)
			      (empty-sosofo)
			      (sosofo-append
			       (build-qt-assistant-adp (node-list-first nl) 
					       (+ iterationCount 1))
			       (loop (node-list-rest nl))))))))))


(define (make-htmlhelp-contents)
  (make sequence
    (make document-type
      name: "HTML"
      public-id: "-//IETF//DTD HTML//EN")
    (make-element gi: "HTML"
      (make-element gi: "BODY"
	(make-element gi: "UL"
	  (build-htmlhelp-toc (sgml-root-element) (htmlhelp-toc-depth)))))))

(define (make-qt-assistant-profile)
  (make formatting-instruction data: "\less-than-sign;profile\greater-than-sign;\less-than-sign;property name='name'\greater-than-sign;CAM3DHelp_da\less-than-sign;/property\greater-than-sign;\less-than-sign;property name='title'\greater-than-sign;EasyViz CAM Manual\less-than-sign;/property\greater-than-sign;\less-than-sign;property name='applicationicon'\greater-than-sign;figs/logo.png\less-than-sign;/property\greater-than-sign;\less-than-sign;property name='startpage'\greater-than-sign;index.html\less-than-sign;/property\greater-than-sign;\less-than-sign;property name='aboutmenutext'\greater-than-sign;Om Hjælp\less-than-sign;/property\greater-than-sign;\less-than-sign;property name='abouturl'\greater-than-sign;about.txt\less-than-sign;/property\greater-than-sign;\less-than-sign;/profile\greater-than-sign;"))
;   (make-element gi: "profile"
; 		(make-element gi: "property"
; 			      attributes: '(("name" "name"))
; 			      (make formatting-instruction data: "CAM3DHelp_da") )
; 		(make-element gi: "property"
; 			      attributes: '(("name" "title"))
; 			      (make formatting-instruction data: "General 3D CAM Hjælp") )
; 		(make-element gi: "property"
; 			      attributes: '(("name" "applicationicon"))
; 			      (make formatting-instruction data: "logo.png") )
; 		(make-element gi: "property"
; 			      attributes: '(("name" "startpage"))
; 			      (make formatting-instruction data: "index.html") )
; 		(make-element gi: "property"
; 			      attributes: '(("name" "aboutmenutext"))
; 			      (make formatting-instruction data: "Om Hjælp") )
; 		(make-element gi: "property"
; 			      attributes: '(("name" "abouturl"))
; 			      (make formatting-instruction data: "about_da.txt") )))

(define (make-qt-assistant-adp)
  (make sequence
    (make-element gi: "assistantconfig"
		  attributes: '(("version" "3.2.0"))
		  (make-qt-assistant-profile)
		  (build-qt-assistant-adp (sgml-root-element)))))

(define (make-htmlhelp-contents2)
  (make sequence
    (make document-type
      name: "HTML"
      public-id: "-//IETF//DTD HTML//EN")
    (make element gi: "HTML"
      (make element gi: "BODY"
	(make element gi: "UL"
	  (make element gi: "LI"
	    (make element gi: "OBJECT"
	      attributes: '(("type" "text/sitemap"))
	      (make empty-element gi: "param"
		attributes: (list (list "name" "Name")
			    (list "value" (element-title-string (sgml-root-element)))))
	      (make empty-element gi: "param"
		attributes: (list (list "name" "Local")
			    (list "value" (html-base-filename (sgml-root-element))))))
	    (make element gi: "UL"
	      (build-htmlhelp-toc (sgml-root-element) (htmlhelp-toc-depth)))))))))

;; Index processing (based on dbindes.dsl, v1.76)

(define (htmlhelpindexattr attr)
  (if (attribute-string (normalize attr))
      (make sequence
	(make formatting-instruction data: attr)
	(make formatting-instruction data: " ")
	(make formatting-instruction data: (attribute-string 
					    (normalize attr)))
	(htmlnewline))
      (empty-sosofo)))

(define (htmlhelpindexterm)
  (let* ((attr    (gi (current-node)))
	 (content (data (current-node)))
	 (string  (string-replace content "&#13;" " "))
	 (sortas  (attribute-string (normalize "sortas"))))
    (make sequence
      (make formatting-instruction data: string))))

(define (htmlhelpindexzone zone)
  (let loop ((idlist (split zone)))
    (if (null? idlist)
	(empty-sosofo)
	(make sequence
	  (htmlhelpindexzone1 (car idlist))
	  (loop (cdr idlist))))))

(define (htmlhelpindexzone1 id)
  (let* ((target (ancestor-member (element-with-id id)
				  (append (book-element-list)
					  (division-element-list)
					  (component-element-list)
					  (section-element-list))))
	 (title  (string-replace (element-title-string target) "&#13;" " ")))
    (make sequence
      (make formatting-instruction data: "ZONE ")
      (make formatting-instruction data: (href-to target))
      (htmlnewline)

      (make formatting-instruction data: "TITLE ")
      (make formatting-instruction data: title)
      (htmlnewline))))

(mode htmlhelpindex
  ;; this mode is really just a hack to get at the root element
  (root (process-children))

  (default 
    (if (node-list=? (current-node) (sgml-root-element))
	  (process-node-list (select-elements 
			      (descendants (current-node))
			      (normalize "indexterm")))
	(empty-sosofo)))

  (element indexterm
      (make sequence
	(make formatting-instruction data: "\less-than-sign;LI")

	(make formatting-instruction data: " name=\"")

;;	(htmlhelpindexattr "scope")
;;	(htmlhelpindexattr "significance")
;;	(htmlhelpindexattr "class")
;;	(htmlhelpindexattr "id")
;;	(htmlhelpindexattr "startref")
	
;;	(if (attribute-string (normalize "zone"))
;;	    (htmlhelpindexzone (attribute-string (normalize "zone")))
;;	    (empty-sosofo))

	(process-children)

	(make formatting-instruction data: "\"")

	(make formatting-instruction data: (string-append " link=\"" (href-to (current-node)) "\""))

	(make formatting-instruction data: "/\greater-than-sign;&#13;")))
		    
  (element primary
    (htmlhelpindexterm))

;;  (element secondary
;;    (htmlhelpindexterm))

;;  (element tertiary
;;    (htmlhelpindexterm))

;;  (element see
;;    (htmlhelpindexterm))

;;  (element seealso
;;    (htmlhelpindexterm))
)

(mode qtassistantkeywords
  ;; this mode is really just a hack to get at the root element
  (root (process-children))

  (default 
    (if (node-list=? (current-node) (sgml-root-element))
	  (process-node-list (select-elements 
			      (descendants (current-node))
			      (normalize "indexterm")))
	(empty-sosofo)))

  (element indexterm
      (make sequence
	(make formatting-instruction data: "\less-than-sign;keyword")

	(make formatting-instruction data: (string-append " ref=\"" (href-to (current-node)) "\""))

	(make formatting-instruction data: "\greater-than-sign;")

	(process-children)

	(make formatting-instruction data: "\less-than-sign;/keyword\greater-than-sign;&#13;")))
		    
  (element primary
    (htmlhelpindexterm))

)

(define (make-htmlhelp-index)
  (make sequence
    (make document-type
      name: "HTML"
      public-id: "-//IETF//DTD HTML//EN")
    (make element gi: "HTML"
      (make element gi: "BODY"
	(with-mode htmlhelpindex
          (process-children))))))

(define (make-qt-assistant-keywords)
  (make sequence
    (with-mode qtassistantkeywords
      (process-children))))

;; Generates a HTML help project

(define (make-htmlhelp-project)
  (let* ((rootgi (case-fold-down (gi (sgml-root-element))))
	 (chm (string-append rootgi ".chm"))
	 (hhp (string-append rootgi ".hhp"))
	 (hhc (string-append rootgi ".hhc"))
	 (hhk (string-append rootgi ".hhk"))
	 (top (html-base-filename (sgml-root-element))))
    (make sequence
      (make entity
	system-id: hhp
	(make sequence
	  (make formatting-instruction data: "[OPTIONS]&#13;")
	  (make formatting-instruction data: "Auto Index=Yes&#13;")
	  (make formatting-instruction data: "Compatibility=1.1&#13;")
	  (make formatting-instruction data: (string-append "Compiled file=" chm "&#13;"))
	  (make formatting-instruction data: (string-append "Contents file=" hhc "&#13;"))
	  (make formatting-instruction data: "Default Window=Default&#13;")
	  (make formatting-instruction data: (string-append "Default topic=" top "&#13;"))
	  (make formatting-instruction data: "Full-text search=Yes&#13;")
	  (make formatting-instruction data: (string-append "Index file=" hhk "&#13;"))
	  (make formatting-instruction data: "Language=0x409 English (United States)&#13;")
	  (make formatting-instruction data: "&#13;")
	  (make formatting-instruction data: "[WINDOWS]&#13;")
	  (make formatting-instruction data: (string-append "Default=," hhc "," hhk "," top "," top ",,,,,0x22520,,0x384e,,,,,,,,0&#13;"))
	  (make formatting-instruction data: "&#13;")
	  (make formatting-instruction data: "[FILES]&#13;")
	  (let loop ((node (current-node)))
	    (if (node-list-empty? node)
		(empty-sosofo)
		(make sequence
		  (make formatting-instruction data: (string-append (html-file node) "&#13;"))
		  (loop (next-chunk-element node)))))))
      (make entity
	system-id: hhc
	  (make-htmlhelp-contents))
      (make entity
	system-id: hhk
	  (make-htmlhelp-index)))))

(define (make-qt-assistant-project)
  (let* ((rootgi (case-fold-down (gi (sgml-root-element))))
	 (adp (string-append rootgi ".adp"))
	 (top (html-base-filename (sgml-root-element))))
    (make sequence
      (make entity
	system-id: adp
	  (make-qt-assistant-adp)))))

;; Overrides the root node definition (taken from docbook.dsl, v1.76)

(root
 (make sequence
   (process-children)
   (with-mode manifest
     (process-children))
   (if html-index
       (with-mode htmlindex
	 (process-children))
       (empty-sosofo))
   (make-htmlhelp-project)
   (make-qt-assistant-project)))

</style-specification-body>
</style-specification>

<external-specification id="docbook" document="dbstyle">

</style-sheet>