diff --git a/gnucash/report/html-table.scm b/gnucash/report/html-table.scm index e37ff75bb9..9b9aa49d84 100644 --- a/gnucash/report/html-table.scm +++ b/gnucash/report/html-table.scm @@ -24,6 +24,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (use-modules (srfi srfi-2)) +(use-modules (srfi srfi-9)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -35,29 +36,66 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define - (make-record-type "" - '(col-headers - row-headers - caption - data - num-rows - style - col-styles - row-styles - row-markup-table - col-headers-style - row-headers-style))) +(define-record-type + (make-html-table col-headers row-headers caption data num-rows style + col-styles row-styles row-markup-table col-headers-style + row-headers-style) + html-table? + (col-headers html-table-col-headers html-table-set-col-headers!) + (row-headers html-table-row-headers html-table-set-row-headers!) + (caption html-table-caption html-table-set-caption!) + (data html-table-data html-table-set-data!) + (num-rows html-table-num-rows html-table-set-num-rows!) + (style html-table-style html-table-set-style!) + (col-styles html-table-col-styles html-table-set-col-styles!) + (row-styles html-table-row-styles html-table-set-row-styles!) + (row-markup-table html-table-row-markup-table html-table-set-row-markup-table!) + (col-headers-style html-table-col-headers-style) + (row-headers-style html-table-row-headers-style)) -(define gnc:html-table? - (record-predicate )) +(define gnc:html-table? html-table?) +(define gnc:make-html-table-internal make-html-table) +(define gnc:html-table-data html-table-data) +(define gnc:html-table-set-data! html-table-set-data!) +(define gnc:html-table-caption html-table-caption) +(define gnc:html-table-set-caption! html-table-set-caption!) +(define gnc:html-table-multirow-col-headers html-table-col-headers) +(define gnc:html-table-set-multirow-col-headers! html-table-set-col-headers!) +(define gnc:html-table-style html-table-style) +(define gnc:html-table-set-style-internal! html-table-set-style!) +(define gnc:html-table-row-styles html-table-row-styles) +(define gnc:html-table-set-row-styles! html-table-set-row-styles!) +(define gnc:html-table-row-markup-table html-table-row-markup-table) +(define gnc:html-table-set-row-markup-table! html-table-set-row-markup-table!) +(define gnc:html-table-col-styles html-table-col-styles) +(define gnc:html-table-set-col-styles! html-table-set-col-styles!) +(define gnc:html-table-col-headers-style html-table-col-headers-style) +(define gnc:html-table-row-headers-style html-table-row-headers-style) +(define gnc:html-table-num-rows html-table-num-rows) +(define gnc:html-table-set-num-rows-internal! html-table-set-num-rows!) -(define - (make-record-type "" - '(rowspan colspan tag data style))) -(define gnc:make-html-table-cell-internal - (record-constructor )) +(define-record-type + (make-html-table-cell rowspan colspan tag data style) + html-table-cell? + (rowspan html-table-rowspan html-table-set-rowspan!) + (colspan html-table-colspan html-table-set-colspan!) + (tag html-table-tag html-table-set-tag!) + (data html-table-data html-table-set-data!) + (style html-table-style html-table-set-style!)) + +(define gnc:make-html-table-cell-internal make-html-table-cell) +(define gnc:html-table-cell? html-table-cell?) +(define gnc:html-table-cell-rowspan html-table-rowspan) +(define gnc:html-table-cell-set-rowspan! html-table-set-rowspan!) +(define gnc:html-table-cell-colspan html-table-colspan) +(define gnc:html-table-cell-set-colspan! html-table-set-colspan!) +(define gnc:html-table-cell-tag html-table-tag) +(define gnc:html-table-cell-set-tag! html-table-set-tag!) +(define gnc:html-table-cell-data html-table-data) +(define gnc:html-table-cell-set-data-internal! html-table-set-data!) +(define gnc:html-table-cell-style html-table-style) +(define gnc:html-table-cell-set-style-internal! html-table-set-style!) (define (gnc:make-html-table-cell . objects) (gnc:make-html-table-cell-internal 1 1 "td" objects @@ -93,39 +131,6 @@ (gnc:make-html-table-cell-internal rowspan colspan "th" objects (gnc:make-html-style-table))) -(define gnc:html-table-cell? - (record-predicate )) - -(define gnc:html-table-cell-rowspan - (record-accessor 'rowspan)) - -(define gnc:html-table-cell-set-rowspan! - (record-modifier 'rowspan)) - -(define gnc:html-table-cell-colspan - (record-accessor 'colspan)) - -(define gnc:html-table-cell-set-colspan! - (record-modifier 'colspan)) - -(define gnc:html-table-cell-tag - (record-accessor 'tag)) - -(define gnc:html-table-cell-set-tag! - (record-modifier 'tag)) - -(define gnc:html-table-cell-data - (record-accessor 'data)) - -(define gnc:html-table-cell-set-data-internal! - (record-modifier 'data)) - -(define gnc:html-table-cell-style - (record-accessor 'style)) - -(define gnc:html-table-cell-set-style-internal! - (record-modifier 'style)) - (define (gnc:html-table-cell-set-style! cell tag . rest) (let ((newstyle (if (and (= (length rest) 2) (procedure? (car rest))) (apply gnc:make-html-data-style-info rest) @@ -174,9 +179,6 @@ ;; wrapper around HTML tables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define gnc:make-html-table-internal - (record-constructor )) - (define (gnc:make-html-table) (gnc:make-html-table-internal #f ;; col-headers @@ -192,60 +194,16 @@ (gnc:make-html-style-table) ;; row-headers-style )) -(define gnc:html-table-data - (record-accessor 'data)) - -(define gnc:html-table-set-data! - (record-modifier 'data)) - -(define gnc:html-table-caption - (record-accessor 'caption)) - -(define gnc:html-table-set-caption! - (record-modifier 'caption)) (define (gnc:html-table-set-col-headers! table col-headers) (gnc:html-table-set-multirow-col-headers! table (list col-headers))) -(define gnc:html-table-multirow-col-headers - (record-accessor 'col-headers)) - -(define gnc:html-table-set-multirow-col-headers! - (record-modifier 'col-headers)) - -(define gnc:html-table-style - (record-accessor 'style)) - -(define gnc:html-table-set-style-internal! - (record-modifier 'style)) - -(define gnc:html-table-row-styles - (record-accessor 'row-styles)) - -(define gnc:html-table-set-row-styles! - (record-modifier 'row-styles)) - -(define gnc:html-table-row-markup-table - (record-accessor 'row-markup-table)) - (define (gnc:html-table-row-markup table row) (hash-ref (gnc:html-table-row-markup-table table) row)) -(define gnc:html-table-set-row-markup-table! - (record-modifier 'row-markup-table)) - (define (gnc:html-table-set-row-markup! table row markup) (hash-set! (gnc:html-table-row-markup-table table) row markup)) -(define gnc:html-table-col-styles - (record-accessor 'col-styles)) - -(define gnc:html-table-set-col-styles! - (record-modifier 'col-styles)) - -(define gnc:html-table-col-headers-style - (record-accessor 'col-headers-style)) - (define (gnc:html-table-set-col-headers-style! table tag . rest) (let ((newstyle (if (and (= (length rest) 2) (procedure? (car rest))) (apply gnc:make-html-data-style-info rest) @@ -253,8 +211,6 @@ (style (gnc:html-table-col-headers-style table))) (gnc:html-style-table-set! style tag newstyle))) -(define gnc:html-table-row-headers-style - (record-accessor 'row-headers-style)) (define (gnc:html-table-set-row-headers-style! table tag . rest) (let* ((newstyle (if (and (= (length rest) 2) (procedure? (car rest))) @@ -298,12 +254,6 @@ (define (gnc:html-table-col-style table col) (hash-ref (gnc:html-table-col-styles table) col)) -(define gnc:html-table-num-rows - (record-accessor 'num-rows)) - -(define gnc:html-table-set-num-rows-internal! - (record-modifier 'num-rows)) - (define (gnc:html-table-num-columns table) (apply max (cons 0 (map length (gnc:html-table-data table)))))