[income-statement] compact functions

This commit is contained in:
Christopher Lam 2019-10-01 00:06:48 +08:00
parent bf202d1461
commit 34bb47e23f

View File

@ -383,45 +383,40 @@
(exchange-fn (exchange-fn
(gnc:case-exchange-fn price-source report-commodity end-date)) (gnc:case-exchange-fn price-source report-commodity end-date))
) )
;; Wrapper to call gnc:html-table-add-labeled-amount-line! ;; Wrapper to call gnc:html-table-add-labeled-amount-line!
;; with the proper arguments. ;; with the proper arguments.
(define (add-subtotal-line table pos-label neg-label signed-balance) (define (add-subtotal-line table pos-label neg-label signed-balance)
(let* ((neg? (and signed-balance (let* ((neg? (and signed-balance neg-label
neg-label (negative?
(gnc-numeric-negative-p (gnc:gnc-monetary-amount
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity
(gnc:sum-collector-commodity signed-balance report-commodity exchange-fn)))))
signed-balance report-commodity exchange-fn))))) (label (if neg? (or neg-label pos-label) pos-label))
(label (if neg? (or neg-label pos-label) pos-label)) (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
(balance (if neg? (gnc:collector- signed-balance) signed-balance))) (gnc:html-table-add-labeled-amount-line!
(gnc:html-table-add-labeled-amount-line! table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell" (gnc:sum-collector-commodity balance report-commodity exchange-fn)
(gnc:sum-collector-commodity balance report-commodity exchange-fn) (1- (* tree-depth 2)) 1 "total-number-cell")))
(1- (* tree-depth 2)) 1 "total-number-cell")))
;; wrapper around gnc:html-table-append-ruler! ;; wrapper around gnc:html-table-append-ruler!
(define (add-rule table) (define (add-rule table)
(gnc:html-table-append-ruler! table (* 2 tree-depth))) (gnc:html-table-append-ruler! table (* 2 tree-depth)))
(gnc:html-document-set-title! (gnc:html-document-set-title!
doc (format #f doc (format #f (string-append "~a ~a " (_ "For Period Covering ~a to ~a"))
(string-append "~a ~a " company-name report-title
(_ "For Period Covering ~a to ~a"))
company-name report-title
(qof-print-date start-date-printable) (qof-print-date start-date-printable)
(qof-print-date end-date))) (qof-print-date end-date)))
(if (null? accounts) (if (null? accounts)
;; error condition: no accounts specified ;; error condition: no accounts specified is this *really*
;; is this *really* necessary?? ;; necessary?? i'd be fine with an all-zero P&L that would,
;; i'd be fine with an all-zero P&L ;; technically, be correct....
;; that would, technically, be correct.... (gnc:html-document-add-object!
(gnc:html-document-add-object! doc (gnc:html-make-no-account-warning
doc reportname (gnc:report-id report-obj)))
(gnc:html-make-no-account-warning
reportname (gnc:report-id report-obj)))
;; Get all the balances for each of the account types. ;; Get all the balances for each of the account types.
(let* ((expense-total (let* ((expense-total
@ -530,82 +525,48 @@
(string-append (_ "Net income") period-for) (string-append (_ "Net income") period-for)
(string-append (_ "Net loss") period-for) (string-append (_ "Net loss") period-for)
net-income (* 2 (1- tree-depth)) exchange-fn #f #f) net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
(gnc:html-document-add-object! ;; add the sections in the desired order to document
doc (let ((build-table (gnc:make-html-table))
(let* ((build-table (gnc:make-html-table))) (inc-cell (gnc:make-html-table-cell inc-table))
(if two-column? (tra-cell (if (null? trading-accounts)
(gnc:html-table-append-row! (gnc:html-make-empty-cell)
build-table (gnc:make-html-table-cell tra-table)))
(if standard-order? (exp-cell (gnc:make-html-table-cell exp-table)))
(list (define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
(gnc:make-html-table-cell inc-table) (cond
(if (null? trading-accounts) ((and two-column? standard-order?)
(gnc:html-make-empty-cell) (add-cells inc-cell tra-cell exp-cell))
(gnc:make-html-table-cell tra-table))
(gnc:make-html-table-cell exp-table) (two-column?
) (add-cells exp-cell inc-cell tra-cell))
(list
(gnc:make-html-table-cell exp-table) (standard-order?
(gnc:make-html-table-cell inc-table) (add-cells inc-cell)
(if (null? trading-accounts) (unless (null? trading-accounts) (add-cells tra-cell))
(gnc:html-make-empty-cell) (add-cells exp-cell))
(gnc:make-html-table-cell tra-table))
) (else
) (add-cells exp-cell)
) (add-cells inc-cell)
(if standard-order? (unless (null? trading-accounts) (add-cells tra-cell))))
(begin
(gnc:html-table-append-row! (gnc:html-table-set-style!
build-table build-table "td"
(list (gnc:make-html-table-cell inc-table))) 'attribute '("align" "left")
(if (not (null? trading-accounts)) 'attribute '("valign" "top"))
(gnc:html-table-append-row! (gnc:html-document-add-object! doc build-table))
build-table
(list (gnc:make-html-table-cell tra-table))))
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell exp-table)))
)
(begin
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell exp-table)))
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell inc-table)))
(if (not (null? trading-accounts))
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell tra-table))))
)
)
)
(gnc:html-table-set-style!
build-table "td"
'attribute '("align" "left")
'attribute '("valign" "top"))
build-table
)
)
;; add currency information if requested ;; add currency information if requested
(gnc:report-percent-done 90) (gnc:report-percent-done 90)
(if show-rates? (when show-rates?
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc ;;(gnc:html-markup-p) doc (gnc:html-make-exchangerates
(gnc:html-make-exchangerates report-commodity exchange-fn accounts)))
report-commodity exchange-fn accounts))) (gnc:report-percent-done 100)))
(gnc:report-percent-done 100)
)
)
(gnc:report-finished) (gnc:report-finished)
doc)) doc))
(define is-reportname (N_ "Income Statement")) (define is-reportname (N_ "Income Statement"))