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

;; 961028 -- bosak
;;   TABLE element spec changed
;;   p-style changed to para-style
;; 961123 -- bosak
;;   TABLE and TITLE elements modified
;;   margins changed
;;   added INFORMALTABLE (docbook-specific)
;; 961124 -- bosak
;;   mods to THEAD
;; 970116 -- bosak
;;   method for assigning frame-attribute on TGROUP changed from
;;     attribute-string to inherited-attribute string to cope
;;     with FRAME attribute set on either TABLE or INFORMALTABLE
;;     (docbook-specific)
;;   mods to TITLE, cell indents & margins
;; 970215 -- berglund, communicated 970128
;;   n-rows-spanned fixed to accommodate #IMPLIED value for morerows
;;     rather than default value of 0 (DocBook 2.x -> 3.0 change to
;;     align with SGML Open table model)
;; 970215 -- graham, communicated 970202
;;   pgwide accommodated
;; Notes by bosak:
;;   For (informal)tables and table titles to align correctly with
;;     paragraphs immediately preceding them, the (informal)table
;;     must be a child of the preceding paragraph.
;;   To get a table frame and rules around each cell, you must set
;;     frame="all" on every TABLE and INFORMALTABLE and
;;     colsep=1 rowsep=1 on every TGROUP.
;;     (note by nwalsh: or set %cals-rule-default% to 1 in a driver)
;;   All further notes by Anders Berglund except where indicated.
;;
;; ============================ TABLES ===============================
;
; *** DRAFT VERSION ****
;
; Copyright (C), Berglund Consulting & Type Foundry 1996.
; Permission to copy in any form is granted for use in  
; DSSSL applications, provided this notice is included in
; all copies.
;
; This supports the specifications in the "Exchange model" in the
; SGML Open Technical Resolution TR 9503:1995
; with the modification that SPANSPECs are supported.
; Thus the following is NOT supported:
; - mixed measure - e.g. 2*+3pt - for colspecs

; Caution
; - NOTE that vertical column spans are not supported by Microsoft Word
; - NOTE that for RTF the table foot is placed at the end of the table;
;   table heads are correctly repeated at page breaks in a table
;
; Tailor these values to go with the rest of the DSSSL application
; and for the desired default values
;
(define %cals-rule-default% 0)
(define %cals-valign-default% "TOP")
; cell margins - a 4pt value assumes that the paragraphs in the
;                cells have a 0 start and end indent so that a  
;                margin needs to be specified on the cells
;; bosak has tweaked all these
(define %cals-cell-before-row-margin% 3pt)
(define %cals-cell-after-row-margin% 3pt)
(define %cals-cell-before-column-margin% 3pt)
(define %cals-cell-after-column-margin% 3pt)
; value for start and end indent; initial value for inheritance in the
;                                 cells
(define %cals-cell-content-start-indent% 3pt)
(define %cals-cell-content-end-indent% 2pt)
;
; These may need changing for the desired style
;
(element INFORMALTABLE
  (make display-group
	space-before: %block-sep%
	space-after: %block-sep%
	(process-children)))

(element TABLE
  (make display-group
	space-before: %block-sep%
	space-after: %block-sep%
	;; pgwide handling by Tony Graham
	start-indent: (let ((pgwide (attribute-string "pgwide")))
			(if
			 (string? pgwide)
			 (if
			  (not
			   (= (string->number pgwide) 0))
			  %pgwide-start-indent%
			  (inherited-start-indent))
			 (inherited-start-indent)))
	(with-mode block-caption-mode
		   (process-first-descendant "TITLE"))
	(process-children)))

;;Replaced by generic block-caption-mode in dbblock.dsl
;;(mode table-caption-mode
;;  (element TITLE
;;    (let* ((label (attribute-string "label" (ancestor "table")))
;;	   (chn (ancestor-child-number "CHAPTER"))
;;	   (apn (ancestor-child-number "APPENDIX"))
;;	   (tbn (format-number (element-number (parent (current-node))) "1"))
;;	   (pnn (cond
;;		 (chn (FNUM chn))
;;		 (apn (FNUM apn))
;;		 (else "")))
;;	   (prefix (if (equal? pnn "") 
;;		       "" 
;;		       (string-append pnn (gentext-intra-label-sep "TABLE")))))
;;      (make paragraph
;;	    use: para-style
;;	    font-weight: 'bold
;;	    space-before: %block-sep%
;;	    space-after: %block-sep%
;;	    keep-with-next?: #t
;;	    (literal
;;	     (string-append
;;	      (gentext-element-name-space "TABLE")
;;	      (if label
;;		  label
;;		  (string-append prefix tbn))
;;	      (gentext-label-title-sep "TABLE")))
;;	    (process-children-trim)))))

;---------------------------------------------------------------------
;   
; There should be no need to change the specification below 
;
;---------------------------------------------------------------------

(define (CALS-COLSPEC-UNIT u)
 (if (string? u)
    (let ((strlen (string-length u)))
    (if (string=? "*" (substring u (- strlen 1) strlen)) 
        (let* ((pnum (substring u 0 (- strlen 1))))
             (if (number? (string->number pnum))
                  (table-unit (string->number pnum))
                  (table-unit 1)))
        (if (> strlen 2)
             (let ((u-s-i (UNAME-START-INDEX u (- strlen 1))))
             (if (= u-s-i 0) ;; there's no number here
                  1pi         ;; so return something that might work
                  (if (= u-s-i strlen)           ;; there's no unit name here
                      (* (string->number u) 1pt) ;; so default to points
                      (let* ((unum (string->number
                                    (substring u 0 u-s-i)))
                              (uname (STRING-DOWNCASE
                                       (substring u u-s-i strlen))))
                        (case uname
                              (("mm") (* unum 1mm))
                              (("cm") (* unum 1cm))
                              (("in") (* unum 1in))
                              (("pi") (* unum 1pi))
                              (("pt") (* unum 1pt))
                              (else
                               (cond 
                                ((number? unum)
                                 (* unum 1pt))
                                ((number? (string->number u))
                                 (* (string->number u) 1pt))
                                      (else u))))))))
             (if (number? (string->number u))
                  (* (string->number u) 1pt)
                  (table-unit 1)))))
    (table-unit 1)))


; given a node list "nodes" find the snl that has a gi matching "giname"
; and an attribute "attname" that has the value "attval"
; if no such node return #f
(define (GI-ATTVAL-NODE-IN-NODELIST giname attname attval nodes)
  (let* ((n (node-list-first nodes)) ;; has to be let* bosak 961123
	 (attnamestr (attribute-string attname n))) ;; added by bosak 961123
    (if (and (string=? (gi n) giname) attnamestr (string=? attnamestr attval)) ;; check for attnamestr added by bosak 961123
;;    (if (and (string=? (gi n) giname) (string=? (attribute-string attname n) attval)) ;; old version dies if attribute-string returns #f
        n
        (if (node-list-empty? (node-list-rest nodes))
            #f
            (GI-ATTVAL-NODE-IN-NODELIST giname attname attval (node-list-rest nodes))))))

; find the child number of the "colspec" that has a "colname" attribute
; whose value matches the "namest" attribute value of the "spanspec"
; whose "spannane" attribute value matches the "spanname" value of the "entry"
(define (CALS-ENTRY-SPANSPEC-START)
  (child-number
    (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
      (attribute-string "namest" 
        (GI-ATTVAL-NODE-IN-NODELIST "SPANSPEC" "spanname"
          (attribute-string "spanname") (children (ancestor "tgroup"))))
      (children (ancestor "tgroup")))))

; find the child number of the "colspec" that has a "colname" attribute
; value matching the "namest" attribute value of the "entry"
(define (CALS-ENTRY-COLSPEC-NAMEST-NODE)
  (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC" "colname"              
    (attribute-string "namest") (children (ancestor "tgroup"))))
(define (CALS-ENTRY-COLSPEC-NAMEST)
  (child-number (CALS-ENTRY-COLSPEC-NAMEST-NODE)))

; calculate the spane information from "namest" and "nameend" on
; the "entry"   
(define (CALS-ENTRY-COLSPEC-NAMEEND-NODE)
  (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC" "colname"              
    (attribute-string "nameend") (children (ancestor "tgroup"))))
(define (CALS-ENTRY-NAMEST-NAMEEND-NUMCOLS)
  (if (CALS-ENTRY-COLSPEC-NAMEEND-NODE)
     (+ 1
        (- (child-number (CALS-ENTRY-COLSPEC-NAMEEND-NODE))
           (child-number (CALS-ENTRY-COLSPEC-NAMEST-NODE))
     ))
     1))

; find the child number of the "colspec" that has a "colname" attribute
; value matching the "colname" attribute value of the "entry"
(define (CALS-ENTRY-COLSPEC-NAME-NODE)
  (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC" "colname"               
    (attribute-string "colname") (children (ancestor "tgroup"))))
(define (CALS-ENTRY-COLSPEC-NAME)
  (child-number (CALS-ENTRY-COLSPEC-NAME-NODE)))

; find the number of columns spanned by calculating the difference in child
; number of the "colspec"s that have a "colname" attribute whose value
; matches the "nameend" and "namest" attribute values of the "spanspec"
; whose "spannane" attribute value matches the "spanname" value of the "entry"
(define (CALS-ENTRY-SPANSPEC-NUMCOLS)
  (let ((spanspec-node 
          (GI-ATTVAL-NODE-IN-NODELIST "SPANSPEC" "spanname"
            (attribute-string "spanname") (children (ancestor "tgroup")))))
    (+ 1
       (- (child-number
            (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
              (attribute-string "nameend" spanspec-node)
              (children (ancestor "tgroup"))))
          (child-number
            (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
              (attribute-string "namest" spanspec-node)
              (children (ancestor "tgroup"))))))))

; find a "colspec" for a separator
(define (CALS-ENTRY-FIND-SEP-COLSPEC)
  (cond ((attribute-string "spanname") 
         (let ((spanspec-node 
               (GI-ATTVAL-NODE-IN-NODELIST "SPANSPEC" "spanname"
               (attribute-string "spanname") (children (ancestor "tgroup")))))
              (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
                (attribute-string "nameend" spanspec-node)
                (children (ancestor "tgroup")))))
        ((attribute-string "namest")   
         (CALS-ENTRY-COLSPEC-NAMEST-NODE))
        ((attribute-string "colname")  
         (CALS-ENTRY-COLSPEC-NAME-NODE))    
        (else #f)))

; find a "rowsep" specification by looking - in order - at
; "entry", "row", "colspec", "tgroup", "table"
(define (CALS-ENTRY-FIND-ROWSEP)
  (if (attribute-string "rowsep")
    (string->number (attribute-string "rowsep"))
    (if (attribute-string "rowsep" (ancestor "row"))
      (string->number (attribute-string "rowsep" (ancestor "row")))
      (let ((col-spec-node (CALS-ENTRY-FIND-SEP-COLSPEC)))
        (if (and col-spec-node (attribute-string "rowsep" col-spec-node))
          (string->number (attribute-string "rowsep" col-spec-node))
          (if (attribute-string "rowsep" (ancestor "tgroup"))
            (string->number (attribute-string "rowsep" (ancestor "tgroup")))
            (if (attribute-string "rowsep" (ancestor "table"))
              (string->number (attribute-string "rowsep" (ancestor "table")))
              %cals-rule-default%)))))))
; set up a value for the row separator - no distinction for values > 0
; if no rowsep found then use default separator
(define (CALS-ENTRY-ROWSEP)
  (let ((rowsep-value (CALS-ENTRY-FIND-ROWSEP)))
    (if (> rowsep-value 0)
       #t
       #f)))

; find a "rowsep" specification by looking - in order - at
; current "colspec", "tgroup", "table"
(define (CALS-COLSPEC-FIND-ROWSEP)
  (if (attribute-string "rowsep")
    (string->number (attribute-string "rowsep"))
    (if (attribute-string "rowsep" (ancestor "tgroup"))
      (string->number (attribute-string "rowsep" (ancestor "tgroup")))
      (if (attribute-string "rowsep" (ancestor "table"))
        (string->number (attribute-string "rowsep" (ancestor "table")))
        %cals-rule-default%))))
; set up a value for the row separator - no distinction for values > 0
; if no rowsep found then use default separator
(define (CALS-COLSPEC-ROWSEP)
  (let ((rowsep-value (CALS-COLSPEC-FIND-ROWSEP)))
    (if (> rowsep-value 0)
       #t
       #f)))

; find a "colsep" specification by looking - in order - at
; "entry", "colspec", "tgroup", "table"
(define (CALS-ENTRY-FIND-COLSEP)
  (if (attribute-string "colsep")
    (string->number (attribute-string "colsep"))
    (let ((col-spec-node (CALS-ENTRY-FIND-SEP-COLSPEC)))
      (if (and col-spec-node (attribute-string "colsep" col-spec-node))
        (string->number (attribute-string "colsep" col-spec-node))
        (if (attribute-string "colsep" (ancestor "tgroup"))
          (string->number (attribute-string "colsep" (ancestor "tgroup")))
          (if (attribute-string "colsep" (ancestor "table"))
            (string->number (attribute-string "colsep" (ancestor "table")))
            %cals-rule-default%))))))
; set up a value for the column separator - no distinction for values > 0
; if no colsep found then use default separator
(define (CALS-ENTRY-COLSEP)
  (let ((colsep-value (CALS-ENTRY-FIND-COLSEP)))
    (if (> colsep-value 0)
       #t
       #f)))

; find a "colsep" specification by looking - in order - at
; current "colspec", "tgroup", "table"
(define (CALS-COLSPEC-FIND-COLSEP)
  (if (attribute-string "colsep")
    (string->number (attribute-string "colsep"))
    (if (attribute-string "colsep" (ancestor "tgroup"))
      (string->number (attribute-string "colsep" (ancestor "tgroup")))
      (if (attribute-string "colsep" (ancestor "table"))
        (string->number (attribute-string "colsep" (ancestor "table")))
        %cals-rule-default%))))
; set up a value for the row separator - no distinction for values > 0
; if no colsep found then use default separator
(define (CALS-COLSPEC-COLSEP)
  (let ((colsep-value (CALS-COLSPEC-FIND-COLSEP)))
    (if (> colsep-value 0)
       #t
       #f)))

; find a "valign" specification by looking - in order - at
; "entry", "tbody", "thead", "tfoot"
(define (CALS-ENTRY-FIND-VALIGN)
  (if (attribute-string "valign")
    (string->number (attribute-string "valign"))
      (if (attribute-string "valign" (ancestor "tbody"))
        (string->number (attribute-string "valign" (ancestor "tbody")))
        (if (attribute-string "valign" (ancestor "thead"))
          (string->number (attribute-string "valign" (ancestor "thead")))
          (if (attribute-string "valign" (ancestor "tfoot"))
            (string->number (attribute-string "valign" (ancestor "tfoot")))
            %cals-valign-default%)))))
; set up a value for the row alignment
(define (CALS-ENTRY-VALIGN)
  (let ((valign-value (CALS-ENTRY-FIND-VALIGN)))
    (case valign-value
       (("TOP") 'start)
       (("MIDDLE") 'center)
       (("BOTTOM") 'end)
       (else 'start))))

(element TGROUP
  (let ((frame-attribute (inherited-attribute-string "frame")))
    (make table
	  before-row-border:  (if frame-attribute
				  (case frame-attribute
					(("ALL") #t)
					(("SIDES") #f)
					(("TOP") #t)
					(("BOTTOM") #f)
					(("TOPBOT") #t)
					(("NONE") #f)
					(else #f))
				(if (> %cals-rule-default% 0)
				    #t
				  #f)) 
	  after-row-border:   (if frame-attribute
				  (case frame-attribute
					(("ALL") #t)
					(("SIDES") #f)
					(("TOP") #f)
					(("BOTTOM") #t)
					(("TOPBOT") #t)
					(("NONE") #f)
					(else #f))
				(if (> %cals-rule-default% 0)
				    #t
				  #f)) 
	  before-column-border: (if frame-attribute
				    (case frame-attribute
					  (("ALL") #t)
					  (("SIDES") #t)
					  (("TOP") #f)
					  (("BOTTOM") #f)
					  (("TOPBOT") #f)
					  (("NONE") #f)
					  (else #f))
				  (if (> %cals-rule-default% 0)
				      #t
				    #f)) 
	  after-column-border:  (if frame-attribute
				    (case frame-attribute
					  (("ALL") #t)
					  (("SIDES") #t)
					  (("TOP") #f)
					  (("BOTTOM") #f)
					  (("TOPBOT") #f)
					  (("NONE") #f)
					  (else #f))
				  (if (> %cals-rule-default% 0)
				      #t
				    #f)) 
	  (make table-part
		content-map: '((thead header)
			       (tbody #f)
			       (tfoot footer))
		(process-children)))))

(element COLSPEC 
  (make table-column
        cell-after-column-border: (CALS-COLSPEC-COLSEP)
        cell-after-row-border: (CALS-COLSPEC-ROWSEP)
        width: (CALS-COLSPEC-UNIT (attribute-string "colwidth"))))

(element THEAD
  (make sequence
        label: 'thead))

(element TFOOT
  (make sequence
        label: 'tfoot))

(element TBODY
  (make sequence
        label: 'tbody))

(element ROW
  (if (attribute-string "rowsep")
    (make table-row
          cell-after-row-border: (let ((rowsep-value (string->number (attribute-string "rowsep"))))
                                   (if (> rowsep-value 0)
                                     #t
                                     #f))
          (process-children-trim))
    (make table-row
          (process-children-trim))))

(element ENTRY
  (if (attribute-string "spanname")
    (make table-cell
          column-number: (CALS-ENTRY-SPANSPEC-START)
          n-columns-spanned: (CALS-ENTRY-SPANSPEC-NUMCOLS)
	  n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
			    (if morerows-value
				(+ 1 (string->number morerows-value))
			      1))
          cell-row-alignment: (CALS-ENTRY-VALIGN)
          cell-after-column-border: (CALS-ENTRY-COLSEP)
          cell-after-row-border: (CALS-ENTRY-ROWSEP)
          cell-before-row-margin: %cals-cell-before-row-margin%
          cell-after-row-margin: %cals-cell-after-row-margin%
          cell-before-column-margin: %cals-cell-before-column-margin%
          cell-after-column-margin: %cals-cell-after-column-margin%
          start-indent: %cals-cell-content-start-indent%
          end-indent: %cals-cell-content-end-indent%
          (process-children-trim))
    (if (attribute-string "namest")
      (make table-cell
            column-number: (CALS-ENTRY-COLSPEC-NAMEST)
            n-columns-spanned: (CALS-ENTRY-NAMEST-NAMEEND-NUMCOLS)
	    n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
			      (if morerows-value
				  (+ 1 (string->number morerows-value))
				1))
            cell-row-alignment: (CALS-ENTRY-VALIGN)
            cell-after-column-border: (CALS-ENTRY-COLSEP)
            cell-after-row-border: (CALS-ENTRY-ROWSEP)
            cell-before-row-margin: %cals-cell-before-row-margin%
            cell-after-row-margin: %cals-cell-after-row-margin%
            cell-before-column-margin: %cals-cell-before-column-margin%
            cell-after-column-margin: %cals-cell-after-column-margin%
            start-indent:  %cals-cell-content-start-indent%
            end-indent: %cals-cell-content-end-indent%
            (process-children-trim))
      (if (attribute-string "colname")
        (make table-cell
              column-number: (CALS-ENTRY-COLSPEC-NAME)
	      n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
				(if morerows-value
				    (+ 1 (string->number morerows-value))
				  1))
              cell-row-alignment: (CALS-ENTRY-VALIGN)
              cell-after-column-border: (CALS-ENTRY-COLSEP)
              cell-after-row-border: (CALS-ENTRY-ROWSEP)
              cell-before-row-margin: %cals-cell-before-row-margin%
              cell-after-row-margin: %cals-cell-after-row-margin%
              cell-before-column-margin: %cals-cell-before-column-margin%
              cell-after-column-margin: %cals-cell-after-column-margin%
              start-indent: %cals-cell-content-start-indent%
              end-indent:  %cals-cell-content-end-indent%
              (process-children-trim))

        (make table-cell
	      n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
				(if morerows-value
				    (+ 1 (string->number morerows-value))
				  1))
              cell-row-alignment: (CALS-ENTRY-VALIGN)
              cell-after-column-border: (CALS-ENTRY-COLSEP)
              cell-after-row-border: (CALS-ENTRY-ROWSEP)
              cell-before-row-margin: %cals-cell-before-row-margin%
              cell-after-row-margin: %cals-cell-after-row-margin%
              cell-before-column-margin: %cals-cell-before-column-margin%
              cell-after-column-margin: %cals-cell-after-column-margin%
              start-indent: %cals-cell-content-start-indent%
              end-indent:  %cals-cell-content-end-indent%
              (process-children-trim))))))

;; bosak 1996.11.23
(element (TABLE TITLE) (empty-sosofo)) ; don't show caption below table
(element (CHART TITLE) (empty-sosofo)) ; don't show caption below chart

(element SPANSPEC (empty-sosofo))

(element (ROW ENTRY PARA)
  (make paragraph
	use: para-style
	(process-children-trim)))

(element (THEAD ROW ENTRY PARA)
  (make paragraph
	font-size: %bf-size%
	font-family-name: %title-font-family%
	font-weight: 'bold
	line-spacing: (* %bf-size% %line-spacing-factor%)
	quadding: 'start
	(process-children-trim)))

;; ===================== END OF TABLES ===============================