Bug 759005 - Print negatives in red

Fixes display of negative monetary-amounts so that they are rendered
according to style-sheet option.

Note this commit fixes via <td> renderer -- if it has a single datum, and
has a negative monetary amount, then its tag gets "-neg" appended.

If a gnc:monetary is renderer *outside* html-table-cell, it will not
be rendered as red (in default stylesheet).
This commit is contained in:
Christopher Lam 2019-10-07 20:16:06 +08:00
parent b00a95c0b3
commit 9d0d3fd3be
2 changed files with 44 additions and 14 deletions

View File

@ -140,25 +140,30 @@
cell (append (gnc:html-table-cell-data cell) objects))) cell (append (gnc:html-table-cell-data cell) objects)))
(define (gnc:html-table-cell-render cell doc) (define (gnc:html-table-cell-render cell doc)
;; This function renders a html-table-cell to a document tree
;; segment. Note: if the html-table-cell datum is a negative
;; gnc:monetary, it fixes the tag eg. "number-cell" becomes
;; "number-cell-red". The gnc:monetary renderer does not have an
;; automatic -neg tag modifier. See bug 759005 and bug 797357.
(let* ((retval '()) (let* ((retval '())
(push (lambda (l) (set! retval (cons l retval)))) (push (lambda (l) (set! retval (cons l retval))))
(style (gnc:html-table-cell-style cell))) (cell-tag (gnc:html-table-cell-tag cell))
(cell-data (gnc:html-table-cell-data cell))
; ;; why dont colspans export??! (tag (if (and (= 1 (length cell-data))
; (gnc:html-table-cell-set-style! cell "td" (gnc:gnc-monetary? (car cell-data))
; 'attribute (list "colspan" (negative? (gnc:gnc-monetary-amount (car cell-data))))
; (or (gnc:html-table-cell-colspan cell) 1))) (string-append cell-tag "-neg")
(gnc:html-document-push-style doc style) cell-tag)))
(gnc:html-document-push-style doc (gnc:html-table-cell-style cell))
(push (gnc:html-document-markup-start (push (gnc:html-document-markup-start
doc (gnc:html-table-cell-tag cell) #t doc tag #t
(format #f "rowspan=\"~a\"" (gnc:html-table-cell-rowspan cell)) (format #f "rowspan=\"~a\"" (gnc:html-table-cell-rowspan cell))
(format #f "colspan=\"~a\"" (gnc:html-table-cell-colspan cell)))) (format #f "colspan=\"~a\"" (gnc:html-table-cell-colspan cell))))
(for-each (for-each
(lambda (child) (lambda (child)
(push (gnc:html-object-render child doc))) (push (gnc:html-object-render child doc)))
(gnc:html-table-cell-data cell)) cell-data)
(push (gnc:html-document-markup-end (push (gnc:html-document-markup-end doc cell-tag))
doc (gnc:html-table-cell-tag cell)))
(gnc:html-document-pop-style doc) (gnc:html-document-pop-style doc)
retval)) retval))

View File

@ -798,6 +798,31 @@ HTML Document Title</title></head><body></body>\n\
) )
(test-end "HTML Table - Table Rendering") (test-end "HTML Table - Table Rendering")
(test-begin "html-table-cell renderers")
(let ((doc (gnc:make-html-document))
(cell (gnc:make-html-table-cell 4)))
(test-equal "html-table-cell renders correctly"
"<td rowspan=\"1\" colspan=\"1\"><number> 4</td>\n"
(string-concatenate
(gnc:html-document-tree-collapse
(gnc:html-table-cell-render cell doc)))))
;; the following is tailor-made to test bug 797357. if the report
;; system is refactored, this test will probably need fixing. it
;; aims to ensure the table-cell class eg 'number-cell'
;; 'total-number-cell' is augmented with a '-neg', and the
;; resulting renderer renders as <td class='number-cell neg' ...>
(let* ((doc (gnc:make-html-document))
(comm-table (gnc-commodity-table-get-table (gnc-get-current-book)))
(USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
(cell (gnc:make-html-table-cell (gnc:make-gnc-monetary USD -10))))
(test-equal "html-table-cell negative-monetary -> tag gets -neg appended"
"td-neg"
(cadr
(gnc:html-document-tree-collapse
(gnc:html-table-cell-render cell doc)))))
(test-end "html-table-cell renderers")
(test-end "HTML Tables - without style sheets") (test-end "HTML Tables - without style sheets")
) )