mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[income-statement] compact functions
This commit is contained in:
parent
bf202d1461
commit
34bb47e23f
@ -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"))
|
||||||
|
Loading…
Reference in New Issue
Block a user