;; $Id: dbautoc.dsl 0.91 1997/08/28 14:09:41 nwalsh Exp $

;; ========================== TABLE OF CONTENTS =========================

(define %toc-indent% 2pi)
(define %toc-spacing-factor% 0.4)

(define (format-page-number)
  (current-node-page-number-sosofo))

;; Returns the depth of auto TOC that should be made at the nd-level
(define (toc-depth nd)
  (if (string=? (gi nd) "BOOK")
      7
      1))

;; Returns #t if nd should appear in the auto TOC
(define (appears-in-auto-toc? nd)
  #t)

;; return elements of nodelist for which appears-in-auto-toc? is #t
(define (toc-list-filter nodelist)
  (let loop ((toclist (empty-node-list)) (nl nodelist))
    (if (node-list-empty? nl)
	toclist
	(if (appears-in-auto-toc? (node-list-first nl))
	    (loop (node-list toclist (node-list-first nl))
		  (node-list-rest nl))
	    (loop toclist (node-list-rest nl))))))

;; Prints the TOC title if first? is true, otherwise does nothing
(define (toc-title first?)
  (if first?
      (make paragraph
	font-family-name: %title-font-family%
	font-weight: 'bold
	font-size: (HSIZE 4)
	line-spacing: (* (HSIZE 4) %line-spacing-factor%)
	space-before: (* (HSIZE 4) %head-before-factor%)
	space-after: (* (HSIZE 4) %head-after-factor%)
	start-indent: 0pt
	first-line-start-indent: 0pt
	quadding: 'start
	keep-with-next?: #t
	(literal (gentext-element-name "TOC")))
      (empty-sosofo)))

;; Prints the TOC title if first? is true, otherwise does nothing
(define (lot-title first? lotgi)
  (if first?
      (make paragraph
	font-family-name: %title-font-family%
	font-weight: 'bold
	font-size: (HSIZE 4)
	line-spacing: (* (HSIZE 4) %line-spacing-factor%)
	space-before: (* (HSIZE 4) %head-before-factor%)
	space-after: (* (HSIZE 4) %head-after-factor%)
	start-indent: 0pt
	first-line-start-indent: 0pt
	quadding: 'start
	keep-with-next?: #t
	(literal ($lot-title$ lotgi)))
      (empty-sosofo)))

;; Print the TOC entry for tocentry  
(define ($toc-entry$ tocentry level)
  (make paragraph
    use: para-style
    start-indent: (+ %body-start-indent%
		     (* %toc-indent% level))
    first-line-start-indent: (* -1 %toc-indent%)
    font-weight: (if (= level 1) 'bold 'medium)
    space-before: (if (= level 1) (* %toc-spacing-factor% 6pt) 0pt)
    space-after: (if (= level 1) (* %toc-spacing-factor% 6pt) 0pt)
    quadding: 'start
    (element-label-sosofo tocentry #t)
    (literal (gentext-label-title-sep (gi tocentry)))
    (element-title-sosofo tocentry)
    (make leader (literal "."))
    (make link
      destination: (node-list-address tocentry)
      (with-mode toc-page-number-mode
	(process-node-list tocentry)))))

;; Build a TOC starting at nd reaching down depth levels.
;; The optional arguments are used on recursive calls to build-toc
;; and shouldn't be set by the initial caller...
;;
(define (build-toc nd depth #!optional (first? #t) (level 1))
  (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) 
	    (node-list-empty? toclist))
	(empty-sosofo)
	(make sequence
	  (toc-title first?)
	  (let loop ((nl toclist))
	    (if (node-list-empty? nl)
		(empty-sosofo)
		(make sequence
		  ($toc-entry$ (node-list-first nl) level)
		  (build-toc (node-list-first nl) (- depth 1) #f (+ level 1))
		  (loop (node-list-rest nl)))))))))

;; Print the LOT entry
(define ($lot-entry$ tocentry)
  (make paragraph
    use: para-style
    start-indent: (+ %body-start-indent% %toc-indent%)
    first-line-start-indent: (* -1 %toc-indent%)
    font-weight: 'medium
    space-before: 0pt
    space-after: 0pt
    quadding: 'start
    (element-label-sosofo tocentry #t)
    (literal (gentext-label-title-sep (gi tocentry)))
    (element-title-sosofo tocentry)
    (make leader (literal "."))
    (make link
      destination: (node-list-address tocentry)
      (with-mode toc-page-number-mode
	(process-node-list tocentry)))))

;; Build a LOT starting at nd for all the lotgi's it contains.
;; The optional arguments are used on recursive calls to build-toc
;; and shouldn't be set by the initial caller...
;;
(define (build-lot nd lotgi #!optional (first? #t))
  (let ((lotlist (node-list-filter-by-gi (children nd)
					 (append division-element-list
						 component-element-list
						 section-element-list
						 block-element-list))))
    (if (node-list-empty? lotlist)
	(empty-sosofo)
	(make sequence
	  (lot-title first? lotgi)
	  (let loop ((nl lotlist))
	    (if (node-list-empty? nl)
		(empty-sosofo)
		(make sequence
		  (if (string=? (gi (node-list-first nl)) lotgi)
		      ($lot-entry$ (node-list-first nl))
		      (empty-sosofo))
		  (build-lot (node-list-first nl) lotgi #f)
		  (loop (node-list-rest nl)))))))))

(mode toc-page-number-mode
  (default
    (format-page-number)))