IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-20 11:48:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[html-table] refactor and dedupe row/col modifiers

Browse Source 
* dedupe gnc:html-table-set-cell/tag!
* dedupe gnc:html-table-set-cell!
* create internal fn gnc:html-table-set-cell-datum! for above fns
This commit is contained in:
Christopher Lam 2019-10-08 22:01:45 +08:00
parent 8a46daeb8c
commit ef3bc616b2
1 changed files with 26 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
gnucash/report/report-system/html-table.scm
View File

@ -376,80 +376,34 @@
(len (length dd)))
(list-ref-safe dd (- len row 1))))
;; if the 4th arg is a cell, overwrite the existing cell,
;; otherwise, append all remaining objects to the existing cell
(define (gnc:html-table-set-cell! table row col . objects)
(let ((rowdata #f)
(row-loc #f)
(l (length (gnc:html-table-data table)))
(objs (length objects))
)
;; ensure the row-data is there
(if (>= row l)
(begin
(let loop ((i l))
(gnc:html-table-append-row! table (list))
(if (< i row)
(loop (+ i 1))))
(set! l (gnc:html-table-num-rows table))
(set! row-loc (- (- l 1) row))
(set! rowdata (list)))
(begin
(set! row-loc (- (- l 1) row))
(set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
;; make a table-cell and set the data
(let* ((tc (gnc:make-html-table-cell))
(first (car objects)))
(if (and (equal? objs 1) (gnc:html-table-cell? first))
(set! tc first)
(apply gnc:html-table-cell-append-objects! tc objects)
)
(set! rowdata (list-set-safe! rowdata col tc))
;; add the row-data back to the table
(gnc:html-table-set-data!
table (list-set-safe!
(gnc:html-table-data table)
row-loc rowdata)))))
;; this function is not exported
(define (gnc:html-table-set-cell-datum! table row col datum)
(let lp ((len (length (gnc:html-table-data table))))
(cond
((< row len)
(let* ((row-loc (- len row 1))
(old-tbldata (gnc:html-table-data table))
(old-rowdata (list-ref old-tbldata row-loc))
(new-rowdata (list-set-safe! old-rowdata col datum))
(new-tbldata (list-set-safe! old-tbldata row-loc new-rowdata)))
;; add the row-data back to the table
(gnc:html-table-set-data! table new-tbldata)))
(else
(gnc:html-table-append-row! table '())
(lp (1+ len))))))
(define (gnc:html-table-set-cell! table row col . objects)
(let ((tc (if (and (= (length objects) 1) (gnc:html-table-cell? (car objects)))
(car objects)
(apply gnc:make-html-table-cell objects))))
(gnc:html-table-set-cell-datum! table row col tc)))
;; if the 4th arg is a cell, overwrite the existing cell,
;; otherwise, append all remaining objects to the existing cell
(define (gnc:html-table-set-cell/tag! table row col tag . objects)
(let ((rowdata #f)
(row-loc #f)
(l (length (gnc:html-table-data table)))
(num-objs (length objects))
)
;; ensure the row-data is there
(if (>= row l)
(begin
(let loop ((i l))
(gnc:html-table-append-row! table (list))
(if (< i row)
(loop (+ i 1))))
(set! l (gnc:html-table-num-rows table))
(set! row-loc (- (- l 1) row))
(set! rowdata (list)))
(begin
(set! row-loc (- (- l 1) row))
(set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
;; make a table-cell and set the data
(let* ((tc (gnc:make-html-table-cell))
(first (car objects)))
(if (and (equal? num-objs 1) (gnc:html-table-cell? first))
(set! tc first)
(apply gnc:html-table-cell-append-objects! tc objects)
)
(gnc:html-table-cell-set-tag! tc tag)
(set! rowdata (list-set-safe! rowdata col tc))
;; add the row-data back to the table
(gnc:html-table-set-data!
table (list-set-safe!
(gnc:html-table-data table)
row-loc rowdata)))))
(let ((tc (if (and (= (length objects) 1) (gnc:html-table-cell? (car objects)))
(car objects)
(apply gnc:make-html-table-cell objects))))
(gnc:html-table-cell-set-tag! tc tag)
(gnc:html-table-set-cell-datum! table row col tc)))
(define (gnc:html-table-append-column! table newcol)