Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Trep subtotal links #1836

Open
wants to merge 3 commits into
base: stable
Choose a base branch
from
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 36 additions & 16 deletions gnucash/report/trep-engine.scm
Original file line number Diff line number Diff line change
Expand Up @@ -1652,14 +1652,22 @@ be excluded from periodic reporting.")
(gnc-commodity-equal commodity (gnc:gnc-monetary-commodity mon)))
list-of-monetary))

(define anchor
(gensym "subtotals"))

(define (cell-add-id cell)
(gnc:html-table-cell-set-style! cell "total-label-cell" 'attribute (list "id" anchor))
cell)

(define (first-column string)
(if (report-uses? 'export-table)
(cons
(gnc:make-html-table-cell/markup "total-label-cell" string)
(cell-add-id (gnc:make-html-table-cell/markup "total-label-cell" string))
(gnc:html-make-empty-cells (+ right-indent width-left-columns -1)))
(list
(gnc:make-html-table-cell/size/markup
1 (+ right-indent width-left-columns) "total-label-cell" string))))
(cell-add-id
(gnc:make-html-table-cell/size/markup
1 (+ right-indent width-left-columns) "total-label-cell" string)))))

(define (data-columns commodity)
(let loop ((merging? #f)
Expand Down Expand Up @@ -1718,7 +1726,7 @@ be excluded from periodic reporting.")
zero))))

(set! grid
(grid-add grid row col (map get-commodity-grid-amount list-of-commodities)))
(grid-add grid row col (map get-commodity-grid-amount list-of-commodities) anchor))

;; each commodity subtotal gets a separate line in the html-table
;; each line comprises: indenting, first-column, data-columns
Expand Down Expand Up @@ -2015,26 +2023,34 @@ be excluded from periodic reporting.")
calculated-cells total-collectors)))))
(values table grid csvlist))))

(define-record-type :subtotal-table-cell
(make-subtotal-table-cell row col data anchor)
subtotal-table-cell?
(row get-subtotal-table-cell-row)
(col get-subtotal-table-cell-col)
(data get-subtotal-table-cell-data)
(anchor get-subtotal-table-cell-anchor))

;; grid data structure
(define (make-grid)
'())
(define (cell-match? cell row col)
(and (or (not row) (equal? row (vector-ref cell 0)))
(or (not col) (equal? col (vector-ref cell 1)))))
(and (or (not row) (equal? row (get-subtotal-table-cell-row cell)))
(or (not col) (equal? col (get-subtotal-table-cell-col cell)))))
(define (grid-get grid row col)
;; grid filter - get all row/col - if #f then retrieve whole row/col
(filter
(lambda (cell)
(cell-match? cell row col))
grid))
(define (grid-rows grid)
(delete-duplicates (map (lambda (cell) (vector-ref cell 0)) grid)))
(delete-duplicates (map get-subtotal-table-cell-row grid)))
(define (grid-cols grid)
(delete-duplicates (map (lambda (cell) (vector-ref cell 1)) grid)))
(define (grid-add grid row col data)
(delete-duplicates (map get-subtotal-table-cell-col grid)))
(define (grid-add grid row col data anchor)
;; we don't need to check for duplicate cells in a row/col because
;; in the trep it should never happen.
(cons (vector row col data) grid))
(cons (make-subtotal-table-cell row col data anchor) grid))
(define (grid->html-table grid)
(define (<? a b)
(cond ((string? (car a)) (gnc:string-locale<? (car a) (car b)))
Expand All @@ -2057,25 +2073,29 @@ be excluded from periodic reporting.")
(map (lambda (col)
(let ((cell (grid-get grid row col)))
(if (null? cell) 0
(length (vector-ref (car cell) 2)))))
(length (get-subtotal-table-cell-data (car cell))))))
(cons 'col-total list-of-cols))))
(define (make-table-cell row col commodity-idx divisor)
(let ((cell (grid-get grid row col)))
(if (null? cell) ""
(gnc:make-html-table-cell/markup
"number-cell"
(monetary-div
(list-ref-safe (vector-ref (car cell) 2) commodity-idx)
divisor)))))
(gnc:make-html-text
(let ((subtotal (list-ref-safe (get-subtotal-table-cell-data (car cell)) commodity-idx)))
(if divisor
(monetary-div subtotal divisor)
(gnc:html-markup-anchor
(format #f "#~a" (get-subtotal-table-cell-anchor (car cell)))
subtotal))))))))
(define (make-row row commodity-idx)
(append
(list (cond
((positive? commodity-idx) "")
((eq? row 'row-total) (G_ "Grand Total"))
(else (cdr row))))
(map (lambda (col) (make-table-cell row col commodity-idx 1))
(map (lambda (col) (make-table-cell row col commodity-idx #f))
list-of-cols)
(list (make-table-cell row 'col-total commodity-idx 1))
(list (make-table-cell row 'col-total commodity-idx #f))
(if row-average-enabled?
(list (make-table-cell
row 'col-total commodity-idx (length list-of-cols)))
Expand Down