;; $Id: dblists.dsl 0.87 1997/07/14 03:57:05 nwalsh Exp $

;; =============================== LISTS ================================

(define (OLSTEP)
  (case
   (modulo (length (hierarchical-number-recursive "ORDEREDLIST")) 4)
	((1) 1.2em)
	((2) 1.2em)
	((3) 1.6em)
	((0) 1.4em)))

(define (ILSTEP) 1.0em)

(define ($list$)
 (make display-group
       space-before: (if (INLIST?) %para-sep% %block-sep%)
       space-after:  (if (INLIST?) %para-sep% %block-sep%)))
 
(element ITEMIZEDLIST ($list$))

(element (ITEMIZEDLIST LISTITEM)
  (make paragraph
	start-indent: (+ (inherited-start-indent) (ILSTEP))
	(process-children)))

(element (ITEMIZEDLIST LISTITEM PARA)
  (let ((spacing (inherited-attribute-string "spacing")))
    (if (= (child-number) 1)
      (let ((ilevel 
	      (length (hierarchical-number-recursive "ITEMIZEDLIST")))
	    (override
	      (inherited-attribute-string "override"))
	    (spacing
	      (inherited-attribute-string "spacing"))
	    (mark
	      (inherited-attribute-string "mark")))
	(make paragraph
	      use: para-style
	      space-before: (if (equal? "COMPACT" spacing)
				0pt
			      %para-sep%)
	      first-line-start-indent: (- (ILSTEP))
	      (make line-field
		    font-size:
		      (BULLTREAT BULLSIZE ilevel override mark)
		    position-point-shift:
		      (BULLTREAT BULLSHIFT ilevel override mark)
		    field-width: (ILSTEP)
		    (literal
		      (BULLTREAT BULLSTR ilevel override mark)))
	      (make sequence
		    first-line-start-indent: 0pt
		    (process-children-trim))))
    (make paragraph
	  use: para-style
	  space-before: (if (equal? "COMPACT" spacing)
			    0pt
			  %para-sep%)
	  (process-children-trim)))))

(element ORDEREDLIST ($list$))

(element (ORDEREDLIST LISTITEM)
  (make paragraph
	start-indent: (+ (inherited-start-indent) (OLSTEP))
	(process-children)))

(define (number-with-numeration numeration number)
  (let* ((depth (length (hierarchical-number-recursive "ORDEREDLIST")))
	 (rawnum (case numeration
		   (("ARABIC") 1)
		   (("LOWERALPHA") 2)
		   (("LOWERROMAN") 3)
		   (("UPPERALPHA") 4)
		   (("UPPERROMAN") 0)
		   (else (modulo depth 5))))
	 (num (case rawnum
		((1) (format-number (PARNUM) "1"))
		((2) (format-number (PARNUM) "a"))
		((3) (format-number (PARNUM) "i"))
		((4) (format-number (PARNUM) "A"))
		((0) (format-number (PARNUM) "I")))))
    (if (> depth 5) 
	(string-append "(" num ")")
	num)))

(element (ORDEREDLIST LISTITEM PARA)
  (let ((spacing (inherited-attribute-string "spacing")))
    (if (= (child-number) 1)
	(make paragraph
	  use: para-style
	  space-before: (if (equal? "COMPACT" spacing)
			    0pt
			    %para-sep%)
	  first-line-start-indent: (- (OLSTEP))
	  (make line-field
	    field-width: (OLSTEP)
	    (literal (number-with-numeration 
		      (attribute-string "numeration") (PARNUM))
		     (gentext-label-title-sep "ORDEREDLIST"))
	    (make sequence
	      first-line-start-indent: 0pt
	      (process-children-trim))))
	(make paragraph
	  use: para-style
	  space-before: (if (equal? "COMPACT" spacing)
			    0pt
			    %para-sep%)
	  (process-children-trim)))))
  
(element VARIABLELIST ($list$))
(element VARLISTENTRY ($para-container$))
(element (VARLISTENTRY TERM)
  (let ((termlength
	  (attribute-string "termlength" (ancestor "VARIABLELIST"))))
    (make paragraph
	  use: para-style
	  space-before: %para-sep%
	  end-indent: (if termlength
			  (- %text-width% (PARSEDUNIT termlength))
			  0pt)
	  (process-children-trim))))
(element (VARLISTENTRY LISTITEM)
  (make paragraph
    start-indent: (+ (inherited-start-indent) 2em)
    (process-children-trim)))
(element (VARLISTENTRY LISTITEM PARA)
  (make paragraph
	use: para-style
	space-before: %para-sep%
	space-after: %para-sep%
	(process-children-trim)))

(element SIMPLELIST
  (let ((type (attribute-string "type")))
    (if (equal? type "INLINE")
	(make sequence
	  (process-children-trim))
	(make display-group
	  space-before: (if (INLIST?) %para-sep% %block-sep%)
	  space-after:  (if (INLIST?) %para-sep% %block-sep%)
	  (process-children-trim)))))

(element MEMBER
  (let ((type (inherited-attribute-string "type")))
    (if (equal? type "INLINE")
	(make sequence
	  (process-children-trim)
	  (if (not (last-sibling?))
	      (literal ", ")
	      (literal "")))
	(make paragraph
	  start-indent: (+ (inherited-start-indent) (ILSTEP))
	  (process-children)))))

(element SEGMENTEDLIST (process-children))
(element (SEGMENTEDLIST TITLE) ($lowtitle$ 2))

(element SEGTITLE (empty-sosofo))
(mode seglist-in-seg
  (element SEGTITLE
    (make sequence
      font-family-name: %title-font-family%
      font-weight: 'bold
      (process-children))))

(define (nth-node nl k)
  (if (equal? k 1)
      (node-list-first nl)
      (nth-node (node-list-rest nl) (- k 1))))

(element SEGLISTITEM ($paragraph$))
(element SEG 
  (let* ((seg-num (child-number (current-node)))
	 (seglist (parent (parent (current-node))))
	 (segtitle (nth-node (select-elements 
			 (descendants seglist) "SEGTITLE") seg-num)))

    ;; Note: segtitle is only going to be the right thing in a well formed
    ;; SegmentedList.  If there are too many Segs or too few SegTitles,
    ;; you'll get something odd...maybe an error

    (with-mode seglist-in-seg
      (make paragraph
	(make sequence
	  font-family-name: %title-font-family%
	  font-weight: 'bold
	  (sosofo-append (process-node-list segtitle))
	  (literal ": "))
	(process-children)))))

;; To do:

(element CALLOUTLIST (process-children))
(element (CALLOUTLIST TITLE) ($lowtitle$ 2))
(element CALLOUT ($paragraph$))