;; from common/dbcommon.dsl

(define (element-title-nosublink-sosofo #!optional (nd (current-node)))
  (if (node-list-empty? nd)
      (empty-sosofo)
      (cond
       ;; Use a seperately defined assoc list?
       ((equal? (gi nd) (normalize "appendix")) (appendix-title-sosofo nd ))
       ((equal? (gi nd) (normalize "article")) (article-title-sosofo nd))
       ((equal? (gi nd) (normalize "bibliography")) (bibliography-title-sosofo nd))
       ((equal? (gi nd) (normalize "book")) (book-title-sosofo nd))
       ((equal? (gi nd) (normalize "chapter")) (chapter-title-sosofo nd))
       ((equal? (gi nd) (normalize "dedication")) (dedication-title-sosofo nd))
       ((equal? (gi nd) (normalize "glossary")) (glossary-title-sosofo nd))
       ((equal? (gi nd) (normalize "index")) (index-title-sosofo nd))
       ((equal? (gi nd) (normalize "colophon")) (colophon-title-sosofo nd))
       ((equal? (gi nd) (normalize "setindex")) (index-title-sosofo nd))
       ((equal? (gi nd) (normalize "part")) (part-title-sosofo nd))
       ((equal? (gi nd) (normalize "preface")) (preface-title-sosofo nd))
       ((equal? (gi nd) (normalize "refentry")) (refentry-title-sosofo nd))
       ((equal? (gi nd) (normalize "reference")) (reference-title-sosofo nd))
       ((equal? (gi nd) (normalize "refsect1")) (refsection-title-sosofo nd))
       ((equal? (gi nd) (normalize "refsect2")) (refsection-title-sosofo nd))
       ((equal? (gi nd) (normalize "refsect3")) (refsection-title-sosofo nd))
       ((equal? (gi nd) (normalize "refsynopsisdiv")) (refsynopsisdiv-title-sosofo nd))
       ((equal? (gi nd) (normalize "sect1")) (section-title-sosofo nd 'supress))
       ((equal? (gi nd) (normalize "sect2")) (section-title-sosofo nd 'supress))
       ((equal? (gi nd) (normalize "sect3")) (section-title-sosofo nd 'supress))       ((equal? (gi nd) (normalize "sect4")) (section-title-sosofo nd 'supress))
       ((equal? (gi nd) (normalize "sect5")) (section-title-sosofo nd 'supress))
       ((equal? (gi nd) (normalize "set")) (set-title-sosofo nd))
       (else (block-title-sosofo nd)))))


(define (section-title-sosofo nd #!optional supress-link )
  (let ((title (section-title nd)))
    (if (string? title)
        (empty-sosofo)
        (if supress-link
            (with-mode title-nosublink-sosofo-mode
               (process-node-list title))
            (with-mode title-sosofo-mode
               (process-node-list title))))))


(mode title-nosublink-sosofo-mode
  (element title
    (process-children-trim))

  (element citetitle
    (process-children-trim))

  (element xref
    (xref-supress-link))

  (element refname
    (process-children-trim))

  (element refentrytitle
    (process-children-trim)))





;; from html/dbautoc.dsl

(define (toc-entry tocentry)
  (make element gi: "DT"
        (make sequence
          (if (equal? (element-label tocentry) "")
              (empty-sosofo)
              (make sequence
                (literal (element-label tocentry))
                (literal (gentext-label-title-sep
                          (gi tocentry)))))

          ;; If the tocentry isn't in its own
          ;; chunk, don't make a link...
          (if (and #f (not (chunk? tocentry)))
              (element-title-sosofo tocentry)
              (make element gi: "A"
                    attributes: (list
                                 (list "HREF"
                                       (href-to tocentry)))
                    (element-title-nosublink-sosofo tocentry)))

          ;; Maybe annotate...
          (if (and %annotate-toc%
                   (equal? (gi tocentry) (normalize "refentry")))
              (make sequence
                (dingbat-sosofo "nbsp");
                (dingbat-sosofo "em-dash");
                (dingbat-sosofo "nbsp");
                (toc-annotation tocentry))
              (empty-sosofo)))))


;; /html/dblink.dsl

(element xref
  (let* ((endterm   (attribute-string (normalize "endterm")))
	 (linkend   (attribute-string (normalize "linkend")))
	 (target    (element-with-id linkend))
	 (xreflabel (if (node-list-empty? target)
			#f
			(attribute-string (normalize "xreflabel") target))))
    (if (node-list-empty? target)
	(error (string-append "XRef LinkEnd to missing ID '" linkend "'"))
	(make element gi: "A"
	      attributes: (list
			   (list "HREF" (href-to target)))
	      (if xreflabel
		  (literal xreflabel)
		  (xref-endterm target endterm))) )))

(define (xref-supress-link)
  (let* ((endterm   (attribute-string (normalize "endterm")))
	 (linkend   (attribute-string (normalize "linkend")))
	 (target    (element-with-id linkend))
	 (xreflabel (if (node-list-empty? target)
			#f
			(attribute-string (normalize "xreflabel") target))))
    (if (node-list-empty? target)
	(error (string-append "XRef LinkEnd to missing ID '" linkend "'"))
	(if xreflabel
	  (literal xreflabel)
	  (xref-endterm target endterm)) )))
     


(define (xref-endterm target endterm)
   (if endterm
      (if (node-list-empty? (element-with-id endterm))
	  (error (string-append
			  "XRef EndTerm to missing ID '" 
			  endterm "'"))
	  (with-mode xref-endterm-mode
		    (process-node-list (element-with-id endterm))))
      (cond ((or (equal? (gi target) (normalize "biblioentry"))
	    (equal? (gi target) (normalize "bibliomixed")))
		;; xref to the bibliography is a special case
		(xref-biblioentry target))
       ((equal? (gi target) (normalize "co"))
		;; callouts are a special case
		($callout-mark$ target #f))
       ((equal? (gi target) (normalize "listitem"))
		;; listitems are a special case
		(if (equal? (gi (parent target)) (normalize "orderedlist"))
		    (literal (orderedlist-listitem-label-recursive target))
		    (error (string-append "XRef to LISTITEM only supported in ORDEREDLISTs"))))
       ((equal? (gi target) (normalize "varlistentry"))
		(xref-varlistentry target))
       ((equal? (gi target) (normalize "question"))
		;; questions and answers are (yet another) special case
		(make sequence
		  (literal (gentext-element-name target))
		  (literal (gentext-label-title-sep target))
		  (literal (question-answer-label target))))
       ((equal? (gi target) (normalize "answer"))
		;; questions and answers are (yet another) special case
		(make sequence
		  (literal (gentext-element-name target))
		  (literal (gentext-label-title-sep target))
		  (literal (question-answer-label target))))
       ((equal? (gi target) (normalize "refentry"))
		;; so are refentrys
		(xref-refentry target))
       ((equal? (gi target) (normalize "refnamediv"))
		;; and refnamedivs
		(xref-refnamediv target))
       ((equal? (gi target) (normalize "glossentry"))
		;; as are glossentrys
		(xref-glossentry target))
       ((equal? (gi target) (normalize "author"))
		;; and authors
		(xref-author target))
       ((equal? (gi target) (normalize "authorgroup"))
		;; and authorgroups
			(xref-authorgroup target))
; this doesn't really work very well yet
;      ((equal? (gi target) (normalize "substeps"))
;		;; and substeps
;		(xref-substeps target))
       (else 
		(xref-general target))))  )