diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm index eb4cea9905..755fa01516 100644 --- a/gnucash/report/report-system/html-table.scm +++ b/gnucash/report/report-system/html-table.scm @@ -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)