mirror of
https://github.com/smarty-php/smarty.git
synced 2025-11-03 22:01:36 +01:00
595 lines
22 KiB
Plaintext
595 lines
22 KiB
Plaintext
|
;; $Id$
|
||
|
|
;;
|
||
|
|
;; This file is part of the Modular DocBook Stylesheet distribution.
|
||
|
|
;; See ../README or http://www.berkshire.net/~norm/dsssl/
|
||
|
|
;;
|
||
|
|
;; Table support completely reimplemented by norm 15/16 Nov 1997
|
||
|
|
;;
|
||
|
|
;; ======================================================================
|
||
|
|
;;
|
||
|
|
;; This code is intended to implement the SGML Open Exchange Table Model
|
||
|
|
;; (http://www.sgmlopen.org/sgml/docs/techpubs.htm) as far as is possible
|
||
|
|
;; in RTF. There are a few areas where this code probably fails to
|
||
|
|
;; perfectly implement the model:
|
||
|
|
;;
|
||
|
|
;; - Mixed column width units (4*+2pi) are not supported.
|
||
|
|
;; - The behavior that results from mixing relative units with
|
||
|
|
;; absolute units has not been carefully considered.
|
||
|
|
;; - TFOOT appears at the bottom of the table, but is not repeated
|
||
|
|
;; across the bottom of pages (RTF limitation).
|
||
|
|
;; - ENTRYTBL is not supported.
|
||
|
|
;; - Rotated tables (e.g. landscape tables in a portrait document)
|
||
|
|
;; cannot be supported in a simple-page-sequence
|
||
|
|
;;
|
||
|
|
;; ======================================================================
|
||
|
|
;;
|
||
|
|
;; My goal in reimplementing the table model was to provide correct
|
||
|
|
;; formatting in tables that use MOREROWS. The difficulty is that
|
||
|
|
;; correct formatting depends on calculating the column into which
|
||
|
|
;; an ENTRY will fall.
|
||
|
|
;;
|
||
|
|
;; This is a non-trivial problem because MOREROWS can hang down from
|
||
|
|
;; preceding rows and ENTRYs may specify starting columns (skipping
|
||
|
|
;; preceding ones).
|
||
|
|
;;
|
||
|
|
;; A simple, elegant recursive algorithm exists. Unfortunately it
|
||
|
|
;; requires calculating the column number of every preceding cell
|
||
|
|
;; in the entire table. Without memoization, performance is unacceptable
|
||
|
|
;; even in relatively small tables (5x5, for example).
|
||
|
|
;;
|
||
|
|
;; In order to avoid recursion, the algorithm used below is one that
|
||
|
|
;; works forward from the beginning of the table and "passes along"
|
||
|
|
;; the relevant information (column number of the preceding cell and
|
||
|
|
;; overhang from the MOREROWS in preceding rows).
|
||
|
|
;;
|
||
|
|
;; Unfortunately, this means that element construction rules
|
||
|
|
;; can't always be used to fire the appropriate rule. Instead,
|
||
|
|
;; each TGROUP has to process each THEAD/BODY/FOOT explicitly.
|
||
|
|
;; And each of those must process each ROW explicitly, then each
|
||
|
|
;; ENTRY/ENTRYTBL explicitly.
|
||
|
|
;;
|
||
|
|
;; ----------------------------------------------------------------------
|
||
|
|
;;
|
||
|
|
;; I attempted to simplify this code by relying on inheritence from
|
||
|
|
;; table-column flow objects, but that wasn't entirely successful.
|
||
|
|
;; Horizontally spanning cells didn't seem to inherit from table-column
|
||
|
|
;; flow objects that didn't specify equal spanning. There seemed to
|
||
|
|
;; be other problems as well, but they could have been caused by coding
|
||
|
|
;; errors on my part.
|
||
|
|
;;
|
||
|
|
;; Anyway, by the time I understood how I could use table-column
|
||
|
|
;; flow objects for inheritence, I'd already implemented all the
|
||
|
|
;; machinery below to "work it out by hand".
|
||
|
|
;;
|
||
|
|
;; ======================================================================
|
||
|
|
;; NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
|
||
|
|
;; ----------------------------------------------------------------------
|
||
|
|
;; A fairly large chunk of this code is in dbcommon.dsl!
|
||
|
|
;; ======================================================================
|
||
|
|
;;
|
||
|
|
|
||
|
|
;; Default value for FRAME= on tables
|
||
|
|
(define ($cals-frame-default$) (normalize "all"))
|
||
|
|
|
||
|
|
;; Default for COLSEP/ROWSEP if unspecified.
|
||
|
|
(define ($cals-rowsep-default$ #!optional (node (current-node)))
|
||
|
|
;; Return "0" for #f, "1" for #t
|
||
|
|
;; Default is to have rules if FRAME=ALL, otherwise not. Except
|
||
|
|
;; that a separator between HEAD and BODY is controlled by
|
||
|
|
;; %table-head-body-border%.
|
||
|
|
;;
|
||
|
|
(let* ((table (ancestor-member node ($table-element-list$)))
|
||
|
|
(frame (if (attribute-string (normalize "frame") table)
|
||
|
|
(attribute-string (normalize "frame") table)
|
||
|
|
($cals-frame-default$)))
|
||
|
|
(row (ancestor-member node (list (normalize "row")))))
|
||
|
|
(if (equal? frame (normalize "all"))
|
||
|
|
#t
|
||
|
|
(if (and (equal? (gi (parent row)) (normalize "thead"))
|
||
|
|
(last-sibling? row))
|
||
|
|
%table-head-body-border%
|
||
|
|
#f))))
|
||
|
|
|
||
|
|
(define ($cals-colsep-default$ #!optional (node (current-node)))
|
||
|
|
;; Default is to have rules if FRAME=ALL, otherwise not.
|
||
|
|
;;
|
||
|
|
(let* ((table (ancestor-member node ($table-element-list$)))
|
||
|
|
(frame (if (attribute-string (normalize "frame") table)
|
||
|
|
(attribute-string (normalize "frame") table)
|
||
|
|
($cals-frame-default$))))
|
||
|
|
(equal? frame (normalize "all"))))
|
||
|
|
|
||
|
|
;; Default for VALIGN if unspecified
|
||
|
|
(define ($cals-valign-default$) (normalize "top"))
|
||
|
|
|
||
|
|
;; Margins around cell contents
|
||
|
|
(define %cals-cell-before-row-margin% 3pt)
|
||
|
|
(define %cals-cell-after-row-margin% 3pt)
|
||
|
|
|
||
|
|
;; seems to be a bug in JadeTeX -- we get a wierd indent on table
|
||
|
|
;; cells for the first line only. This is a workaround.
|
||
|
|
;; Adam Di Carlo, adam@onshore.com
|
||
|
|
(define %cals-cell-before-column-margin%
|
||
|
|
(cond ((equal? (print-backend) 'tex)
|
||
|
|
0pt)
|
||
|
|
(else
|
||
|
|
3pt)))
|
||
|
|
|
||
|
|
(define %cals-cell-after-column-margin% 3pt)
|
||
|
|
|
||
|
|
;; Inheritable start and end indent for cell contents
|
||
|
|
(define %cals-cell-content-start-indent% 2pt)
|
||
|
|
(define %cals-cell-content-end-indent% 2pt)
|
||
|
|
|
||
|
|
;; How to indent pgwide tables? (Non-pgwide tables get inherited-start-indent
|
||
|
|
(define %cals-pgwide-start-indent% %body-start-indent%)
|
||
|
|
|
||
|
|
;; What alignment should tables have on the page
|
||
|
|
(define %cals-display-align% 'start)
|
||
|
|
|
||
|
|
;; ----------------------------------------------------------------------
|
||
|
|
;; Table rule widths
|
||
|
|
|
||
|
|
(define %table-before-row-border% #t)
|
||
|
|
(define %table-after-row-border% #t)
|
||
|
|
(define %table-before-column-border% #t)
|
||
|
|
(define %table-after-column-border% #t)
|
||
|
|
(define %table-head-body-border% #t)
|
||
|
|
(define %table-cell-after-column-border% #t)
|
||
|
|
(define %table-cell-after-row-border% #t)
|
||
|
|
|
||
|
|
;;(define tbl-color-space
|
||
|
|
;; (color-space "ISO/IEC 10179:1996//Color-Space Family::Device RGB"))
|
||
|
|
;;
|
||
|
|
;;(define tbl-red (color tbl-color-space 1 0 0))
|
||
|
|
;;(define tbl-green (color tbl-color-space 0 1 0))
|
||
|
|
;;(define tbl-blue (color tbl-color-space 0 0 1))
|
||
|
|
|
||
|
|
(define calc-table-before-row-border
|
||
|
|
(if (boolean? %table-before-row-border%)
|
||
|
|
%table-before-row-border%
|
||
|
|
;; Avoid problems with the DSSSL compiler when
|
||
|
|
;; %table-before-row-border% is boolean.
|
||
|
|
(let ((border-width %table-before-row-border%))
|
||
|
|
(make table-border
|
||
|
|
line-thickness: border-width))))
|
||
|
|
|
||
|
|
(define calc-table-after-row-border
|
||
|
|
(if (boolean? %table-after-row-border%)
|
||
|
|
%table-after-row-border%
|
||
|
|
(let ((border-width %table-after-row-border%))
|
||
|
|
(make table-border
|
||
|
|
line-thickness: border-width))))
|
||
|
|
|
||
|
|
(define calc-table-before-column-border
|
||
|
|
(if (boolean? %table-before-column-border%)
|
||
|
|
%table-before-column-border%
|
||
|
|
(let ((border-width %table-before-column-border%))
|
||
|
|
(make table-border
|
||
|
|
line-thickness: border-width))))
|
||
|
|
|
||
|
|
(define calc-table-after-column-border
|
||
|
|
(if (boolean? %table-after-column-border%)
|
||
|
|
%table-after-column-border%
|
||
|
|
(let ((border-width %table-after-column-border%))
|
||
|
|
(make table-border
|
||
|
|
line-thickness: border-width))))
|
||
|
|
|
||
|
|
(define calc-table-head-body-border
|
||
|
|
(if (boolean? %table-head-body-border%)
|
||
|
|
%table-head-body-border%
|
||
|
|
(let ((border-width %table-head-body-border%))
|
||
|
|
(make table-border
|
||
|
|
line-thickness: border-width))))
|
||
|
|
|
||
|
|
(define calc-table-cell-after-column-border
|
||
|
|
(if (boolean? %table-cell-after-column-border%)
|
||
|
|
%table-cell-after-column-border%
|
||
|
|
(let ((border-width %table-cell-after-column-border%))
|
||
|
|
(make table-border
|
||
|
|
line-thickness: border-width))))
|
||
|
|
|
||
|
|
(define calc-table-cell-after-row-border
|
||
|
|
(if (boolean? %table-cell-after-row-border%)
|
||
|
|
%table-cell-after-row-border%
|
||
|
|
(let ((border-width %table-cell-after-row-border%))
|
||
|
|
(make table-border
|
||
|
|
line-thickness: border-width))))
|
||
|
|
|
||
|
|
;; ----------------------------------------------------------------------
|
||
|
|
;; Convert colwidth units into table-unit measurements
|
||
|
|
|
||
|
|
(define (colwidth-unit lenstr)
|
||
|
|
(if (string? lenstr)
|
||
|
|
(let ((number (length-string-number-part lenstr))
|
||
|
|
(units (length-string-unit-part lenstr)))
|
||
|
|
(if (string=? units "*")
|
||
|
|
(if (string=? number "")
|
||
|
|
(table-unit 1)
|
||
|
|
(table-unit (string->number number)))
|
||
|
|
(if (string=? units "")
|
||
|
|
;; no units, default to points
|
||
|
|
(* (string->number number) 1pt)
|
||
|
|
(let* ((unum (string->number number))
|
||
|
|
(uname (case-fold-down units)))
|
||
|
|
(case uname
|
||
|
|
(("mm") (* unum 1mm))
|
||
|
|
(("cm") (* unum 1cm))
|
||
|
|
(("in") (* unum 1in))
|
||
|
|
(("pi") (* unum 1pi))
|
||
|
|
(("pt") (* unum 1pt))
|
||
|
|
(("px") (* unum 1px))
|
||
|
|
;; unrecognized units; use points
|
||
|
|
(else (* unum 1pt)))))))
|
||
|
|
;; lenstr is not a string...probably #f
|
||
|
|
(table-unit 1)))
|
||
|
|
|
||
|
|
|
||
|
|
(define (cell-align cell colnum)
|
||
|
|
(let* ((entry (ancestor-member cell (list (normalize "entry")
|
||
|
|
(normalize "entrytbl"))))
|
||
|
|
(tgroup (find-tgroup entry))
|
||
|
|
(spanname (attribute-string (normalize "spanname") entry))
|
||
|
|
(calsalign (if (attribute-string (normalize "align") entry)
|
||
|
|
(attribute-string (normalize "align") entry)
|
||
|
|
(if (and spanname
|
||
|
|
(spanspec-align (find-spanspec spanname)))
|
||
|
|
(spanspec-align (find-spanspec spanname))
|
||
|
|
(if (colspec-align (find-colspec-by-number colnum))
|
||
|
|
(colspec-align (find-colspec-by-number colnum))
|
||
|
|
(if (tgroup-align tgroup)
|
||
|
|
(tgroup-align tgroup)
|
||
|
|
(normalize "left")))))))
|
||
|
|
(cond
|
||
|
|
((equal? calsalign (normalize "left")) 'start)
|
||
|
|
((equal? calsalign (normalize "center")) 'center)
|
||
|
|
((equal? calsalign (normalize "right")) 'end)
|
||
|
|
(else 'start))))
|
||
|
|
|
||
|
|
(define (cell-valign cell colnum)
|
||
|
|
(let* ((entry (ancestor-member cell (list (normalize "entry")
|
||
|
|
(normalize "entrytbl"))))
|
||
|
|
(row (ancestor (normalize "row") entry))
|
||
|
|
(tbody (ancestor-member cell (list (normalize "tbody")
|
||
|
|
(normalize "thead")
|
||
|
|
(normalize "tfoot"))))
|
||
|
|
(tgroup (ancestor (normalize "tgroup") entry))
|
||
|
|
(calsvalign (if (attribute-string (normalize "valign") entry)
|
||
|
|
(attribute-string (normalize "valign") entry)
|
||
|
|
(if (attribute-string (normalize "valign") row)
|
||
|
|
(attribute-string (normalize "valign") row)
|
||
|
|
(if (attribute-string (normalize "valign") tbody)
|
||
|
|
(attribute-string (normalize "valign") tbody)
|
||
|
|
($cals-valign-default$))))))
|
||
|
|
(cond
|
||
|
|
((equal? calsvalign (normalize "top")) 'start)
|
||
|
|
((equal? calsvalign (normalize "middle")) 'center)
|
||
|
|
((equal? calsvalign (normalize "bottom")) 'end)
|
||
|
|
(else 'start))))
|
||
|
|
|
||
|
|
;; ======================================================================
|
||
|
|
;; Element rules
|
||
|
|
|
||
|
|
(element tgroup
|
||
|
|
(let ((frame-attribute (if (inherited-attribute-string (normalize "frame"))
|
||
|
|
(inherited-attribute-string (normalize "frame"))
|
||
|
|
($cals-frame-default$))))
|
||
|
|
(make table
|
||
|
|
;; These values are used for the outer edges (well, the top, bottom
|
||
|
|
;; and left edges for sure; I think the right edge actually comes
|
||
|
|
;; from the cells in the last column
|
||
|
|
before-row-border: (if (cond
|
||
|
|
((equal? frame-attribute (normalize "all")) #t)
|
||
|
|
((equal? frame-attribute (normalize "sides")) #f)
|
||
|
|
((equal? frame-attribute (normalize "top")) #t)
|
||
|
|
((equal? frame-attribute (normalize "bottom")) #f)
|
||
|
|
((equal? frame-attribute (normalize "topbot")) #t)
|
||
|
|
((equal? frame-attribute (normalize "none")) #f)
|
||
|
|
(else #f))
|
||
|
|
calc-table-before-row-border
|
||
|
|
#f)
|
||
|
|
after-row-border: (if (cond
|
||
|
|
((equal? frame-attribute (normalize "all")) #t)
|
||
|
|
((equal? frame-attribute (normalize "sides")) #f)
|
||
|
|
((equal? frame-attribute (normalize "top")) #f)
|
||
|
|
((equal? frame-attribute (normalize "bottom")) #t)
|
||
|
|
((equal? frame-attribute (normalize "topbot")) #t)
|
||
|
|
((equal? frame-attribute (normalize "none")) #f)
|
||
|
|
(else #f))
|
||
|
|
calc-table-after-row-border
|
||
|
|
#f)
|
||
|
|
before-column-border: (if (cond
|
||
|
|
((equal? frame-attribute (normalize "all")) #t)
|
||
|
|
((equal? frame-attribute (normalize "sides")) #t)
|
||
|
|
((equal? frame-attribute (normalize "top")) #f)
|
||
|
|
((equal? frame-attribute (normalize "bottom")) #f)
|
||
|
|
((equal? frame-attribute (normalize "topbot")) #f)
|
||
|
|
((equal? frame-attribute (normalize "none")) #f)
|
||
|
|
(else #f))
|
||
|
|
calc-table-before-column-border
|
||
|
|
#f)
|
||
|
|
after-column-border: (if (cond
|
||
|
|
((equal? frame-attribute (normalize "all")) #t)
|
||
|
|
((equal? frame-attribute (normalize "sides")) #t)
|
||
|
|
((equal? frame-attribute (normalize "top")) #f)
|
||
|
|
((equal? frame-attribute (normalize "bottom")) #f)
|
||
|
|
((equal? frame-attribute (normalize "topbot")) #f)
|
||
|
|
((equal? frame-attribute (normalize "none")) #f)
|
||
|
|
(else #f))
|
||
|
|
calc-table-after-column-border
|
||
|
|
#f)
|
||
|
|
display-alignment: %cals-display-align%
|
||
|
|
(make table-part
|
||
|
|
content-map: '((thead header)
|
||
|
|
(tbody #f)
|
||
|
|
(tfoot footer))
|
||
|
|
($process-colspecs$ (current-node))
|
||
|
|
(process-children)
|
||
|
|
(make-table-endnotes)))))
|
||
|
|
|
||
|
|
(element colspec
|
||
|
|
;; now handled by $process-colspecs$ at the top of each tgroup...
|
||
|
|
(empty-sosofo))
|
||
|
|
|
||
|
|
(element spanspec
|
||
|
|
(empty-sosofo))
|
||
|
|
|
||
|
|
(element thead
|
||
|
|
($process-table-body$ (current-node)))
|
||
|
|
|
||
|
|
(element tfoot
|
||
|
|
($process-table-body$ (current-node)))
|
||
|
|
|
||
|
|
(element tbody
|
||
|
|
($process-table-body$ (current-node)))
|
||
|
|
|
||
|
|
(element row
|
||
|
|
(empty-sosofo)) ;; this should never happen, they're processed explicitly
|
||
|
|
|
||
|
|
(element entry
|
||
|
|
(empty-sosofo)) ;; this should never happen, they're processed explicitly
|
||
|
|
|
||
|
|
;; ======================================================================
|
||
|
|
;; Functions that handle processing of table bodies, rows, and cells
|
||
|
|
|
||
|
|
(define ($process-colspecs$ tgroup)
|
||
|
|
(let* ((cols (string->number (attribute-string (normalize "cols")))))
|
||
|
|
(let loop ((colnum 1))
|
||
|
|
(if (> colnum cols)
|
||
|
|
(empty-sosofo)
|
||
|
|
(make sequence
|
||
|
|
(let ((colspec (find-colspec-by-number colnum)))
|
||
|
|
(if (node-list-empty? colspec)
|
||
|
|
(make table-column
|
||
|
|
column-number: colnum
|
||
|
|
width: (colwidth-unit "1*"))
|
||
|
|
($process-colspec$ colspec colnum)))
|
||
|
|
(loop (+ colnum 1)))))))
|
||
|
|
|
||
|
|
(define ($process-colspec$ colspec colnum)
|
||
|
|
(let* ((colwidth (if (attribute-string (normalize "colwidth") colspec)
|
||
|
|
(attribute-string (normalize "colwidth") colspec)
|
||
|
|
"1*")))
|
||
|
|
(make table-column
|
||
|
|
column-number: colnum
|
||
|
|
width: (colwidth-unit colwidth))))
|
||
|
|
|
||
|
|
(define ($process-table-body$ body)
|
||
|
|
(let* ((tgroup (ancestor (normalize "tgroup") body))
|
||
|
|
(cols (string->number (attribute-string (normalize "cols") tgroup)))
|
||
|
|
(blabel (cond
|
||
|
|
((equal? (gi body) (normalize "thead")) 'thead)
|
||
|
|
((equal? (gi body) (normalize "tbody")) 'tbody)
|
||
|
|
((equal? (gi body) (normalize "tfoot")) 'tfoot))))
|
||
|
|
(make sequence
|
||
|
|
label: blabel
|
||
|
|
(let loop ((rows (select-elements (children body) (normalize "row")))
|
||
|
|
(overhang (constant-list 0 cols)))
|
||
|
|
(if (node-list-empty? rows)
|
||
|
|
(empty-sosofo)
|
||
|
|
(make sequence
|
||
|
|
($process-row$ (node-list-first rows) overhang)
|
||
|
|
(loop (node-list-rest rows)
|
||
|
|
(update-overhang (node-list-first rows) overhang))))))))
|
||
|
|
|
||
|
|
(define ($process-row$ row overhang)
|
||
|
|
(let* ((tgroup (ancestor (normalize "tgroup") row))
|
||
|
|
(maxcol (string->number (attribute-string
|
||
|
|
(normalize "cols") tgroup)))
|
||
|
|
(lastentry (node-list-last (node-list-filter-out-pis
|
||
|
|
(children row))))
|
||
|
|
(table (parent tgroup)))
|
||
|
|
;; there's no point calculating the row or colsep here, each cell
|
||
|
|
;; specifies it which overrides anything we might say here...
|
||
|
|
(make table-row
|
||
|
|
(let loop ((cells (node-list-filter-out-pis (children row)))
|
||
|
|
(prevcell (empty-node-list)))
|
||
|
|
(if (node-list-empty? cells)
|
||
|
|
(empty-sosofo)
|
||
|
|
(make sequence
|
||
|
|
($process-cell$ (node-list-first cells) prevcell row overhang)
|
||
|
|
(loop (node-list-rest cells) (node-list-first cells)))))
|
||
|
|
|
||
|
|
;; add any necessary empty cells to the end of the row
|
||
|
|
(let loop ((colnum (+ (cell-column-number lastentry overhang)
|
||
|
|
(hspan lastentry))))
|
||
|
|
(if (> colnum maxcol)
|
||
|
|
(empty-sosofo)
|
||
|
|
(make sequence
|
||
|
|
($process-empty-cell$ colnum row)
|
||
|
|
(loop (+ colnum 1))))))))
|
||
|
|
|
||
|
|
(define ($process-cell$ entry preventry row overhang)
|
||
|
|
(let* ((colnum (cell-column-number entry overhang))
|
||
|
|
(lastcellcolumn (if (node-list-empty? preventry)
|
||
|
|
0
|
||
|
|
(- (+ (cell-column-number preventry overhang)
|
||
|
|
(hspan preventry))
|
||
|
|
1)))
|
||
|
|
(lastcolnum (if (> lastcellcolumn 0)
|
||
|
|
(overhang-skip overhang lastcellcolumn)
|
||
|
|
0))
|
||
|
|
(font-name (if (have-ancestor? (normalize "thead") entry)
|
||
|
|
%title-font-family%
|
||
|
|
%body-font-family%))
|
||
|
|
(weight (if (have-ancestor? (normalize "thead") entry)
|
||
|
|
'bold
|
||
|
|
'medium))
|
||
|
|
(align (cell-align entry colnum)))
|
||
|
|
|
||
|
|
(make sequence
|
||
|
|
;; This is a little bit complicated. We want to output empty cells
|
||
|
|
;; to skip over missing data. We start count at the column number
|
||
|
|
;; arrived at by adding 1 to the column number of the previous entry
|
||
|
|
;; and skipping over any MOREROWS overhanging entrys. Then for each
|
||
|
|
;; iteration, we add 1 and skip over any overhanging entrys.
|
||
|
|
(let loop ((count (overhang-skip overhang (+ lastcolnum 1))))
|
||
|
|
(if (>= count colnum)
|
||
|
|
(empty-sosofo)
|
||
|
|
(make sequence
|
||
|
|
($process-empty-cell$ count row)
|
||
|
|
(loop (overhang-skip overhang (+ count 1))))))
|
||
|
|
|
||
|
|
;; Now we've output empty cells for any missing entries, so we
|
||
|
|
;; are ready to output the cell for this entry...
|
||
|
|
(make table-cell
|
||
|
|
column-number: colnum
|
||
|
|
n-columns-spanned: (hspan entry)
|
||
|
|
n-rows-spanned: (vspan entry)
|
||
|
|
|
||
|
|
cell-row-alignment: (cell-valign entry colnum)
|
||
|
|
|
||
|
|
cell-after-column-border: (if (cell-colsep entry colnum)
|
||
|
|
calc-table-cell-after-column-border
|
||
|
|
#f)
|
||
|
|
|
||
|
|
cell-after-row-border: (if (cell-rowsep entry colnum)
|
||
|
|
(if (last-sibling? (parent entry))
|
||
|
|
calc-table-head-body-border
|
||
|
|
calc-table-cell-after-row-border)
|
||
|
|
#f)
|
||
|
|
|
||
|
|
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%
|
||
|
|
|
||
|
|
;; If there is some additional indentation (because we're in a list,
|
||
|
|
;; for example) make sure that gets passed along, but don't add
|
||
|
|
;; the normal body-start-indent.
|
||
|
|
start-indent: (+ (- (inherited-start-indent) %body-start-indent%)
|
||
|
|
%cals-cell-content-start-indent%)
|
||
|
|
end-indent: %cals-cell-content-end-indent%
|
||
|
|
(if (equal? (gi entry) (normalize "entrytbl"))
|
||
|
|
(make paragraph
|
||
|
|
(literal "ENTRYTBL not supported."))
|
||
|
|
(make paragraph
|
||
|
|
font-family-name: font-name
|
||
|
|
font-weight: weight
|
||
|
|
quadding: align
|
||
|
|
(process-node-list (children entry))))))))
|
||
|
|
|
||
|
|
(define (empty-cell-colsep colnum row)
|
||
|
|
(let* ((tgroup (ancestor (normalize "tgroup") row))
|
||
|
|
(table (parent tgroup))
|
||
|
|
(calscolsep
|
||
|
|
(if (tgroup-colsep tgroup)
|
||
|
|
(tgroup-colsep tgroup)
|
||
|
|
(if (attribute-string (normalize "colsep") table)
|
||
|
|
(attribute-string (normalize "colsep") table)
|
||
|
|
(if ($cals-colsep-default$ row)
|
||
|
|
"1"
|
||
|
|
"0")))))
|
||
|
|
(> (string->number calscolsep) 0)))
|
||
|
|
|
||
|
|
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
|
|
||
|
|
(define (cell-colsep cell colnum)
|
||
|
|
(let* ((entry (ancestor-member cell (list (normalize "entry") (normalize "entrytbl"))))
|
||
|
|
(spanname (attribute-string (normalize "spanname") entry))
|
||
|
|
(tgroup (find-tgroup entry))
|
||
|
|
(table (parent tgroup))
|
||
|
|
(calscolsep
|
||
|
|
(if (attribute-string (normalize "colsep") entry)
|
||
|
|
(attribute-string (normalize "colsep") entry)
|
||
|
|
(if (and spanname
|
||
|
|
(spanspec-colsep (find-spanspec spanname)))
|
||
|
|
(spanspec-colsep (find-spanspec spanname))
|
||
|
|
(if (colspec-colsep (find-colspec-by-number colnum))
|
||
|
|
(colspec-colsep (find-colspec-by-number colnum))
|
||
|
|
(if (tgroup-colsep tgroup)
|
||
|
|
(tgroup-colsep tgroup)
|
||
|
|
(if (attribute-string (normalize "colsep") table)
|
||
|
|
(attribute-string (normalize "colsep") table)
|
||
|
|
(if ($cals-colsep-default$ cell)
|
||
|
|
"1"
|
||
|
|
"0"))))))))
|
||
|
|
(> (string->number calscolsep) 0)))
|
||
|
|
|
||
|
|
(define (cell-rowsep cell colnum)
|
||
|
|
(let* ((entry (ancestor-member cell (list (normalize "entry")
|
||
|
|
(normalize "entrytbl"))))
|
||
|
|
(spanname (attribute-string (normalize "spanname") entry))
|
||
|
|
(row (ancestor (normalize "row") entry))
|
||
|
|
(tgroup (find-tgroup entry))
|
||
|
|
(table (parent tgroup))
|
||
|
|
(calsrowsep
|
||
|
|
(if (attribute-string (normalize "rowsep") entry)
|
||
|
|
(attribute-string (normalize "rowsep") entry)
|
||
|
|
(if (and spanname (spanspec-rowsep (find-spanspec spanname)))
|
||
|
|
(spanspec-rowsep (find-spanspec spanname))
|
||
|
|
(if (colspec-rowsep (find-colspec-by-number colnum))
|
||
|
|
(colspec-rowsep (find-colspec-by-number colnum))
|
||
|
|
(if (attribute-string (normalize "rowsep") row)
|
||
|
|
(attribute-string (normalize "rowsep") row)
|
||
|
|
(if (tgroup-rowsep tgroup)
|
||
|
|
(tgroup-rowsep tgroup)
|
||
|
|
(if (attribute-string (normalize "rowsep") table)
|
||
|
|
(attribute-string (normalize "rowsep") table)
|
||
|
|
(if ($cals-rowsep-default$ cell)
|
||
|
|
"1"
|
||
|
|
"0")))))))))
|
||
|
|
(> (string->number calsrowsep) 0)))
|
||
|
|
|
||
|
|
(define (empty-cell-rowsep colnum row)
|
||
|
|
(let* ((tgroup (ancestor (normalize "tgroup") row))
|
||
|
|
(table (parent tgroup))
|
||
|
|
(calsrowsep
|
||
|
|
(if (attribute-string (normalize "rowsep") row)
|
||
|
|
(attribute-string (normalize "rowsep") row)
|
||
|
|
(if (tgroup-rowsep tgroup)
|
||
|
|
(tgroup-rowsep tgroup)
|
||
|
|
(if (attribute-string (normalize "rowsep") table)
|
||
|
|
(attribute-string (normalize "rowsep") table)
|
||
|
|
(if ($cals-rowsep-default$ row)
|
||
|
|
"1"
|
||
|
|
"0"))))))
|
||
|
|
(> (string->number calsrowsep) 0)))
|
||
|
|
|
||
|
|
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
|
|
||
|
|
(define ($process-empty-cell$ colnum row)
|
||
|
|
(make table-cell
|
||
|
|
column-number: colnum
|
||
|
|
n-columns-spanned: 1
|
||
|
|
n-rows-spanned: 1
|
||
|
|
cell-after-column-border: (if (empty-cell-colsep colnum row)
|
||
|
|
calc-table-cell-after-column-border
|
||
|
|
#f)
|
||
|
|
|
||
|
|
cell-after-row-border: (if (empty-cell-rowsep colnum row)
|
||
|
|
(if (last-sibling? row)
|
||
|
|
calc-table-head-body-border
|
||
|
|
calc-table-cell-after-row-border)
|
||
|
|
#f)
|
||
|
|
|
||
|
|
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%
|
||
|
|
(empty-sosofo)))
|
||
|
|
|
||
|
|
;; EOF
|