mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[trial-balance] *untabify/delete-trailing-whitespace/reindent*
global reindent
This commit is contained in:
Christopher Lam
parent
525bcd39ed
commit
6e12bf81a9
@ -51,6 +51,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-module (gnucash report standard-reports trial-balance))
|
||||
(use-modules (srfi srfi-1))
|
||||
(use-modules (gnucash utilities))
|
||||
(use-modules (gnucash gnc-module))
|
||||
(use-modules (gnucash gettext))
|
||||
@ -177,7 +178,7 @@
|
||||
;; options generator
|
||||
(define (trial-balance-options-generator)
|
||||
(let* ((options (gnc:new-options))
|
||||
(book (gnc-get-current-book)) ; XXX Find a way to get the book that opened the report
|
||||
(book (gnc-get-current-book))
|
||||
(add-option
|
||||
(lambda (new-option)
|
||||
(gnc:register-option options new-option))))
|
||||
@ -241,8 +242,7 @@
|
||||
(lambda ()
|
||||
;; Here, it would be useful to have an inventory account type.
|
||||
;; Lacking that, just select no accounts by default.
|
||||
'()
|
||||
)
|
||||
'())
|
||||
#f #t))
|
||||
(add-option
|
||||
(gnc:make-account-list-option
|
||||
@ -250,8 +250,7 @@
|
||||
"d"
|
||||
opthelp-income-summary-accounts
|
||||
(lambda ()
|
||||
'()
|
||||
)
|
||||
'())
|
||||
#f #t))
|
||||
|
||||
;; all about currencies
|
||||
@ -377,7 +376,7 @@
|
||||
;; requested, export it to a file
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (trial-balance-renderer report-obj choice filename)
|
||||
(define (trial-balance-renderer report-obj)
|
||||
(define (get-option pagename optname)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option
|
||||
@ -386,53 +385,35 @@
|
||||
(gnc:report-starting reportname)
|
||||
|
||||
;; get all option's values
|
||||
(let* (
|
||||
(report-title (get-option gnc:pagename-general optname-report-title))
|
||||
(let* ((report-title (get-option gnc:pagename-general optname-report-title))
|
||||
(company-name (get-option gnc:pagename-general optname-party-name))
|
||||
(start-date-printable (gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-start-date)))
|
||||
(start-date-printable
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general optname-start-date)))
|
||||
(start-date (gnc:time64-end-day-time
|
||||
(gnc:time64-previous-day start-date-printable)))
|
||||
(end-date (gnc:time64-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-end-date))))
|
||||
(report-variant (get-option gnc:pagename-general
|
||||
optname-report-variant))
|
||||
(accounts (get-option gnc:pagename-accounts
|
||||
optname-accounts))
|
||||
(get-option gnc:pagename-general optname-end-date))))
|
||||
(report-variant (get-option gnc:pagename-general optname-report-variant))
|
||||
(accounts (get-option gnc:pagename-accounts optname-accounts))
|
||||
(ga-accounts (get-option pagename-merchandising
|
||||
optname-gross-adjustment-accounts))
|
||||
(is-accounts (get-option pagename-merchandising
|
||||
optname-income-summary-accounts))
|
||||
(depth-limit (get-option gnc:pagename-accounts
|
||||
optname-depth-limit))
|
||||
(adjusting-str (get-option pagename-entries
|
||||
optname-adjusting-pattern))
|
||||
(adjusting-cased (get-option pagename-entries
|
||||
optname-adjusting-casing))
|
||||
(adjusting-regexp (get-option pagename-entries
|
||||
optname-adjusting-regexp))
|
||||
(closing-str (get-option pagename-entries
|
||||
optname-closing-pattern))
|
||||
(closing-cased (get-option pagename-entries
|
||||
optname-closing-casing))
|
||||
(closing-regexp (get-option pagename-entries
|
||||
optname-closing-regexp))
|
||||
(report-commodity (get-option pagename-commodities
|
||||
optname-report-commodity))
|
||||
(price-source (get-option pagename-commodities
|
||||
optname-price-source))
|
||||
(show-fcur? (get-option pagename-commodities
|
||||
optname-show-foreign))
|
||||
(show-rates? (get-option pagename-commodities
|
||||
optname-show-rates))
|
||||
;;(show-zb-accts? (get-option gnc:pagename-display
|
||||
;; optname-show-zb-accts))
|
||||
(show-zb-accts? #t) ;; see FIXME above
|
||||
(use-links? (get-option gnc:pagename-display
|
||||
optname-account-links))
|
||||
(depth-limit (get-option gnc:pagename-accounts optname-depth-limit))
|
||||
(adjusting-str (get-option pagename-entries optname-adjusting-pattern))
|
||||
(adjusting-cased (get-option pagename-entries optname-adjusting-casing))
|
||||
(adjusting-regexp (get-option pagename-entries optname-adjusting-regexp))
|
||||
(closing-str (get-option pagename-entries optname-closing-pattern))
|
||||
(closing-cased (get-option pagename-entries optname-closing-casing))
|
||||
(closing-regexp (get-option pagename-entries optname-closing-regexp))
|
||||
(report-commodity (get-option pagename-commodities optname-report-commodity))
|
||||
(price-source (get-option pagename-commodities optname-price-source))
|
||||
(show-fcur? (get-option pagename-commodities optname-show-foreign))
|
||||
(show-rates? (get-option pagename-commodities optname-show-rates))
|
||||
(show-zb-accts? #t)
|
||||
(use-links? (get-option gnc:pagename-display optname-account-links))
|
||||
(indent 0)
|
||||
|
||||
;; decompose the account list
|
||||
@ -442,7 +423,7 @@
|
||||
(liability-accounts
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-LIABILITY))
|
||||
(income-expense-accounts
|
||||
(append (assoc-ref split-up-accounts ACCT-TYPE-INCOME)
|
||||
(append-reverse (assoc-ref split-up-accounts ACCT-TYPE-INCOME)
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)))
|
||||
(equity-accounts
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
|
||||
@ -478,17 +459,15 @@
|
||||
(period-for (string-append " " (_ "for Period"))))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
doc (if (equal? report-variant 'current)
|
||||
(format #f (string-append "~a ~a ~a")
|
||||
doc (if (eq? report-variant 'current)
|
||||
(format #f "~a ~a ~a"
|
||||
company-name report-title
|
||||
(qof-print-date end-date))
|
||||
(format #f (string-append "~a ~a "
|
||||
(_ "For Period Covering ~a to ~a"))
|
||||
company-name report-title
|
||||
(qof-print-date start-date-printable)
|
||||
(qof-print-date end-date))
|
||||
)
|
||||
)
|
||||
(qof-print-date end-date))))
|
||||
|
||||
(if (null? accounts)
|
||||
|
||||
@ -518,8 +497,7 @@
|
||||
(is-debits (gnc:make-commodity-collector))
|
||||
(is-credits (gnc:make-commodity-collector))
|
||||
(bs-debits (gnc:make-commodity-collector))
|
||||
(bs-credits (gnc:make-commodity-collector))
|
||||
)
|
||||
(bs-credits (gnc:make-commodity-collector)))
|
||||
|
||||
;; Wrapper to call gnc:html-table-add-labeled-amount-line!
|
||||
;; with the proper arguments.
|
||||
@ -530,28 +508,19 @@
|
||||
report-commodity exchange-fn show-fcur?))
|
||||
(credit? (double-col
|
||||
'credit-q signed-balance
|
||||
report-commodity exchange-fn show-fcur?))
|
||||
)
|
||||
report-commodity exchange-fn show-fcur?)))
|
||||
(gnc:html-table-add-labeled-amount-line!
|
||||
table
|
||||
(+ account-cols 2)
|
||||
"primary-subheading"
|
||||
#f
|
||||
label indented-depth 1 "text-cell"
|
||||
entry
|
||||
(+ account-cols (if credit? 1 0)) 1 "number-cell"
|
||||
)
|
||||
table (+ account-cols 2) "primary-subheading"
|
||||
#f label indented-depth 1 "text-cell"
|
||||
entry (+ account-cols (if credit? 1 0)) 1 "number-cell")
|
||||
;; update the running totals
|
||||
(if credit?
|
||||
(credit-tot 'minusmerge signed-balance #f)
|
||||
(debit-tot 'merge signed-balance #f)
|
||||
)
|
||||
)
|
||||
)
|
||||
(debit-tot 'merge signed-balance #f))))
|
||||
|
||||
(define (get-val alist key)
|
||||
(let ((lst (assoc-ref alist key)))
|
||||
(if lst (car lst) lst)))
|
||||
(let ((lst (assq-ref alist key)))
|
||||
(and lst (car lst))))
|
||||
|
||||
(define pa-col 0) ;; pre-adjustments column
|
||||
(define adj-col 1) ;; adjustments column
|
||||
@ -562,29 +531,24 @@
|
||||
|
||||
(define (report-val amt)
|
||||
(gnc:sum-collector-commodity
|
||||
amt report-commodity exchange-fn)
|
||||
)
|
||||
amt report-commodity exchange-fn))
|
||||
|
||||
;; Returns a gnc:html-table-cell containing the absolute value
|
||||
;; of the given amount in the report commodity.
|
||||
(define (tot-abs-amt-cell amt)
|
||||
(let* ((neg-amt (gnc:make-commodity-collector))
|
||||
(rv (report-val amt))
|
||||
(neg? (gnc-numeric-negative-p
|
||||
(gnc:gnc-monetary-amount rv)))
|
||||
(cell #f)
|
||||
)
|
||||
(rv (report-val amt)))
|
||||
(neg-amt 'minusmerge amt #f)
|
||||
(set! cell
|
||||
(gnc:make-html-table-cell/markup
|
||||
"total-number-cell" (if neg? (report-val neg-amt) rv)))
|
||||
(let ((cell (gnc:make-html-table-cell/markup
|
||||
"total-number-cell"
|
||||
(if (negative? (gnc:gnc-monetary-amount rv))
|
||||
(report-val neg-amt)
|
||||
rv))))
|
||||
(gnc:html-table-cell-set-style!
|
||||
cell "total-number-cell"
|
||||
'attribute '("align" "right")
|
||||
'attribute '("valign" "top")
|
||||
)
|
||||
cell)
|
||||
)
|
||||
'attribute '("valign" "top"))
|
||||
cell)))
|
||||
|
||||
;; sum any unrealized gains
|
||||
;;
|
||||
@ -599,110 +563,89 @@
|
||||
;;
|
||||
;; This procedure returns a commodity collector.
|
||||
(define (collect-unrealized-gains)
|
||||
(if (equal? price-source 'average-cost)
|
||||
(if (eq? price-source 'average-cost)
|
||||
;; No need to calculate if doing valuation at cost.
|
||||
(gnc:make-commodity-collector)
|
||||
(let ((book-balance (gnc:make-commodity-collector))
|
||||
(unrealized-gain-collector (gnc:make-commodity-collector))
|
||||
(cost-fn (gnc:case-exchange-fn 'average-cost
|
||||
report-commodity
|
||||
end-date))
|
||||
(value #f)
|
||||
(cost #f))
|
||||
(cost-fn (gnc:case-exchange-fn
|
||||
'average-cost report-commodity end-date)))
|
||||
|
||||
;; Calculate book balance.
|
||||
;; assets - liabilities - equity; normally 0
|
||||
(map
|
||||
(for-each
|
||||
(lambda (acct)
|
||||
(book-balance 'merge
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
acct end-date #f)
|
||||
(book-balance
|
||||
'merge
|
||||
(gnc:account-get-comm-balance-at-date acct end-date #f)
|
||||
#f))
|
||||
all-accounts)
|
||||
|
||||
;; Get the value of all holdings.
|
||||
(set! value (gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity book-balance
|
||||
report-commodity
|
||||
exchange-fn)))
|
||||
|
||||
;; Get the cost of all holdings.
|
||||
(set! cost (gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity book-balance
|
||||
report-commodity
|
||||
cost-fn)))
|
||||
(let ((value (gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
book-balance report-commodity exchange-fn)))
|
||||
(cost (gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
book-balance report-commodity cost-fn))))
|
||||
|
||||
;; Get the unrealized gain or loss (value minus cost).
|
||||
(unrealized-gain-collector 'add
|
||||
report-commodity
|
||||
(gnc-numeric-sub-fixed value cost))
|
||||
unrealized-gain-collector)))
|
||||
(unrealized-gain-collector
|
||||
'add report-commodity (- value cost))
|
||||
unrealized-gain-collector))))
|
||||
|
||||
|
||||
;; set default cell alignment
|
||||
(gnc:html-table-set-style!
|
||||
build-table "td"
|
||||
'attribute '("align" "right")
|
||||
'attribute '("valign" "top")
|
||||
)
|
||||
'attribute '("valign" "top"))
|
||||
|
||||
(gnc:report-percent-done 4)
|
||||
|
||||
;; Get any unrealized gains/losses.
|
||||
(neg-unrealized-gain-collector 'minusmerge
|
||||
(collect-unrealized-gains)
|
||||
#f)
|
||||
(neg-unrealized-gain-collector
|
||||
'minusmerge (collect-unrealized-gains) #f)
|
||||
|
||||
(set! table-env
|
||||
(list
|
||||
(list 'start-date #f)
|
||||
(list 'end-date end-date)
|
||||
(list 'display-tree-depth
|
||||
(if (integer? depth-limit) depth-limit #f))
|
||||
(and (integer? depth-limit) depth-limit))
|
||||
(list 'depth-limit-behavior 'flatten)
|
||||
(list 'report-commodity report-commodity)
|
||||
(list 'exchange-fn exchange-fn)
|
||||
(list 'parent-account-subtotal-mode #f)
|
||||
(list 'zero-balance-mode (if show-zb-accts?
|
||||
'show-leaf-acct
|
||||
(list 'zero-balance-mode (if show-zb-accts? 'show-leaf-acct
|
||||
'omit-leaf-acct))
|
||||
(list 'account-label-mode (if use-links?
|
||||
'anchor
|
||||
'name))
|
||||
)
|
||||
)
|
||||
(list 'account-label-mode (if use-links? 'anchor 'name))))
|
||||
|
||||
(set! acct-table
|
||||
(gnc:make-html-acct-table/env/accts table-env all-accounts))
|
||||
|
||||
(gnc:report-percent-done 80)
|
||||
(let* ((env (gnc:html-acct-table-get-row-env acct-table 0)))
|
||||
(set! account-cols (get-val env 'account-cols))
|
||||
)
|
||||
(set! account-cols (get-val env 'account-cols)))
|
||||
|
||||
;; Workaround to force gtkhtml into displaying wide
|
||||
;; enough columns.
|
||||
(let ((space
|
||||
(make-list
|
||||
(+ account-cols
|
||||
(if (equal? report-variant 'work-sheet) 10 2))
|
||||
" ")
|
||||
))
|
||||
(if (eq? report-variant 'work-sheet) 10 2))
|
||||
" ")))
|
||||
(gnc:html-table-append-row! build-table space)
|
||||
(set! header-rows (+ header-rows 1))
|
||||
)
|
||||
(set! header-rows (+ header-rows 1)))
|
||||
;; add the double-column headers if required
|
||||
(if (equal? report-variant 'work-sheet)
|
||||
(if (eq? report-variant 'work-sheet)
|
||||
(let* ((headings
|
||||
(list
|
||||
(_ "Trial Balance")
|
||||
(_ "Adjustments")
|
||||
(_ "Adjusted Trial Balance")
|
||||
(_ "Income Statement")
|
||||
(_ "Balance Sheet")
|
||||
))
|
||||
(parent-headings #f)
|
||||
)
|
||||
(_ "Balance Sheet")))
|
||||
(parent-headings #f))
|
||||
(set! parent-headings
|
||||
(apply append
|
||||
(map
|
||||
@ -710,18 +653,13 @@
|
||||
(list
|
||||
(gnc:make-html-table-cell/size/markup 1 1 "th" heading)
|
||||
(gnc:html-make-empty-cell)))
|
||||
headings)
|
||||
)
|
||||
)
|
||||
headings)))
|
||||
(gnc:html-table-append-row!
|
||||
build-table
|
||||
(append
|
||||
(gnc:html-make-empty-cells account-cols)
|
||||
parent-headings)
|
||||
)
|
||||
(set! header-rows (+ header-rows 1))
|
||||
)
|
||||
)
|
||||
parent-headings))
|
||||
(set! header-rows (+ header-rows 1))))
|
||||
;; add the DEBIT/CREDIT headers
|
||||
(let* ((debit-cell
|
||||
(gnc:make-html-table-cell/markup
|
||||
@ -734,26 +672,16 @@
|
||||
"th" (_ "Account Name")))
|
||||
(gnc:html-make-empty-cells (- account-cols 1))
|
||||
(list debit-cell)
|
||||
(list credit-cell))
|
||||
)
|
||||
(ws-col 0)
|
||||
)
|
||||
(if (equal? report-variant 'work-sheet)
|
||||
(list credit-cell)))
|
||||
(ws-col 0))
|
||||
(if (eq? report-variant 'work-sheet)
|
||||
(let ((rownum 0)
|
||||
(ws-cols 4)
|
||||
)
|
||||
(ws-cols 4))
|
||||
(while (< rownum ws-cols)
|
||||
(set! row (append row (list debit-cell credit-cell)))
|
||||
(set! rownum (+ rownum 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
(gnc:html-table-append-row!
|
||||
build-table
|
||||
row
|
||||
)
|
||||
(set! header-rows (+ header-rows 1))
|
||||
)
|
||||
(set! rownum (+ rownum 1)))))
|
||||
(gnc:html-table-append-row! build-table row)
|
||||
(set! header-rows (+ header-rows 1)))
|
||||
|
||||
;; now, for each account, calculate all the column values
|
||||
;; and store them in the utility object...
|
||||
@ -762,12 +690,11 @@
|
||||
;; accounts specially. instead of storing a commodity collector,
|
||||
;; it stores a two-element list of commodity collectors:
|
||||
;; (list debit-collector credit-collector)
|
||||
(let ((row 0)
|
||||
(rows (gnc:html-acct-table-num-rows acct-table))
|
||||
)
|
||||
(let* ((row 0)
|
||||
(rows (gnc:html-acct-table-num-rows acct-table)))
|
||||
|
||||
(while (< row rows)
|
||||
(let* ((env
|
||||
(gnc:html-acct-table-get-row-env acct-table row))
|
||||
(let* ((env (gnc:html-acct-table-get-row-env acct-table row))
|
||||
(acct (get-val env 'account))
|
||||
(group (list acct))
|
||||
(curr-bal (get-val env 'account-bal))
|
||||
@ -800,25 +727,19 @@
|
||||
(list (list 'str adjusting-str)
|
||||
(list 'cased adjusting-cased)
|
||||
(list 'regexp adjusting-regexp)
|
||||
(list 'positive #t)
|
||||
)
|
||||
start-date end-date
|
||||
)
|
||||
))
|
||||
(list 'positive #t))
|
||||
start-date end-date)))
|
||||
(neg-adjusting
|
||||
(and pos-adjusting (gnc:make-commodity-collector)))
|
||||
(pre-closing-bal (gnc:make-commodity-collector))
|
||||
(pre-adjusting-bal (gnc:make-commodity-collector))
|
||||
(atb #f) ;; adjusted trial balance
|
||||
)
|
||||
(atb #f))
|
||||
|
||||
;; +P_ADJ + -N_ADJ = xADJ. xADJ - +P_ADJ = -N_ADJ.
|
||||
;; That is, credit values are stored as such (negative).
|
||||
(if neg-adjusting
|
||||
(begin
|
||||
(when neg-adjusting
|
||||
(neg-adjusting 'merge adjusting #f)
|
||||
(neg-adjusting 'minusmerge pos-adjusting #f)
|
||||
))
|
||||
(neg-adjusting 'minusmerge pos-adjusting #f))
|
||||
|
||||
(pre-closing-bal 'merge curr-bal #f)
|
||||
;; remove closing entries
|
||||
@ -835,20 +756,16 @@
|
||||
;; the atb value... so we check is?.
|
||||
(if is?
|
||||
(let* ((debit (gnc:make-commodity-collector))
|
||||
(credit (gnc:make-commodity-collector))
|
||||
)
|
||||
(credit (gnc:make-commodity-collector)))
|
||||
(debit 'merge pos-adjusting #f)
|
||||
(credit 'merge neg-adjusting #f)
|
||||
(if (double-col
|
||||
'credit-q pre-adjusting-bal
|
||||
report-commodity exchange-fn show-fcur?)
|
||||
(credit 'merge pre-adjusting-bal #f)
|
||||
(debit 'merge pre-adjusting-bal #f)
|
||||
)
|
||||
(list debit credit)
|
||||
)
|
||||
pre-closing-bal)
|
||||
)
|
||||
(debit 'merge pre-adjusting-bal #f))
|
||||
(list debit credit))
|
||||
pre-closing-bal))
|
||||
|
||||
(gnc:html-acct-table-set-cell!
|
||||
acct-table row pa-col pre-adjusting-bal)
|
||||
@ -856,50 +773,35 @@
|
||||
acct-table row adj-col
|
||||
(if ga-or-is?
|
||||
(list pos-adjusting neg-adjusting)
|
||||
adjusting)
|
||||
)
|
||||
(gnc:html-acct-table-set-cell!
|
||||
acct-table row atb-col atb)
|
||||
adjusting))
|
||||
(gnc:html-acct-table-set-cell! acct-table row atb-col atb)
|
||||
(gnc:html-acct-table-set-cell!
|
||||
acct-table row
|
||||
(if (or (gnc:account-is-inc-exp? acct) is?)
|
||||
is-col bs-col)
|
||||
atb
|
||||
)
|
||||
(gnc:html-acct-table-set-cell!
|
||||
acct-table row bal-col curr-bal)
|
||||
atb)
|
||||
(gnc:html-acct-table-set-cell! acct-table row bal-col curr-bal)
|
||||
|
||||
(set! row (+ row 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! row (+ row 1)))))
|
||||
|
||||
;; next, set up the account tree and pre-adjustment balances
|
||||
;; (This fills in the Account Title and Trial Balance columns.)
|
||||
(let ((row 0)
|
||||
(rows (gnc:html-acct-table-num-rows acct-table)))
|
||||
(while (< row rows)
|
||||
(let* ((env
|
||||
(gnc:html-acct-table-get-row-env acct-table row))
|
||||
(let* ((env (gnc:html-acct-table-get-row-env acct-table row))
|
||||
(account-bal
|
||||
(gnc:html-acct-table-get-cell
|
||||
acct-table
|
||||
row
|
||||
(get-val (list (list 'pre-adj pa-col)
|
||||
(list 'work-sheet pa-col)
|
||||
(list 'current bal-col)
|
||||
)
|
||||
report-variant)
|
||||
))
|
||||
(label (get-val env 'account-label))
|
||||
)
|
||||
acct-table row
|
||||
(assq-ref (list (cons 'pre-adj pa-col)
|
||||
(cons 'work-sheet pa-col)
|
||||
(cons 'current bal-col))
|
||||
report-variant)))
|
||||
(label (get-val env 'account-label)))
|
||||
;; yeah, i know, global vars are devil... so deal with it
|
||||
(set! indented-depth (get-val env 'indented-depth))
|
||||
(add-line build-table label account-bal)
|
||||
)
|
||||
(set! row (+ row 1))
|
||||
)
|
||||
)
|
||||
(add-line build-table label account-bal))
|
||||
(set! row (+ row 1))))
|
||||
|
||||
;; handle any unrealized gains
|
||||
;;
|
||||
@ -914,45 +816,27 @@
|
||||
report-commodity exchange-fn show-fcur?))
|
||||
(entry (double-col
|
||||
'entry neg-unrealized-gain-collector
|
||||
report-commodity exchange-fn show-fcur?))
|
||||
)
|
||||
report-commodity exchange-fn show-fcur?)))
|
||||
(add-line build-table
|
||||
(if credit?
|
||||
(_ "Unrealized Gains")
|
||||
(_ "Unrealized Losses"))
|
||||
neg-unrealized-gain-collector)
|
||||
(if (equal? report-variant 'work-sheet)
|
||||
(begin
|
||||
(when (eq? report-variant 'work-sheet)
|
||||
;; make table line wide enough
|
||||
(gnc:html-table-set-cell!
|
||||
build-table
|
||||
ug-row
|
||||
(+ account-cols (* 2 bs-col) 1)
|
||||
#f)
|
||||
build-table ug-row (+ account-cols (* 2 bs-col) 1) #f)
|
||||
(gnc:html-table-set-cell!
|
||||
build-table
|
||||
ug-row
|
||||
(+ account-cols (* 2 atb-col) (if credit? 1 0))
|
||||
entry)
|
||||
build-table ug-row
|
||||
(+ account-cols (* 2 atb-col) (if credit? 1 0)) entry)
|
||||
(gnc:html-table-set-cell!
|
||||
build-table
|
||||
ug-row
|
||||
(+ account-cols (* 2 bs-col) (if credit? 1 0))
|
||||
entry)
|
||||
build-table ug-row
|
||||
(+ account-cols (* 2 bs-col) (if credit? 1 0)) entry)
|
||||
(if credit?
|
||||
(and (atb-credits 'minusmerge
|
||||
neg-unrealized-gain-collector #f)
|
||||
(bs-credits 'minusmerge
|
||||
neg-unrealized-gain-collector #f))
|
||||
(and (atb-debits 'merge
|
||||
neg-unrealized-gain-collector #f)
|
||||
(bs-debits 'merge
|
||||
neg-unrealized-gain-collector #f))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(and (atb-credits 'minusmerge neg-unrealized-gain-collector #f)
|
||||
(bs-credits 'minusmerge neg-unrealized-gain-collector #f))
|
||||
(and (atb-debits 'merge neg-unrealized-gain-collector #f)
|
||||
(bs-debits 'merge neg-unrealized-gain-collector #f))))))
|
||||
|
||||
;;
|
||||
;; now, if requested, complete the worksheet
|
||||
@ -961,133 +845,72 @@
|
||||
;; around, reading acct-table, putting values in the right
|
||||
;; build-table cells... which is comparatively easy.
|
||||
;;
|
||||
(if (equal? report-variant 'work-sheet)
|
||||
(if (eq? report-variant 'work-sheet)
|
||||
(let ((row 0)
|
||||
(rows (gnc:html-acct-table-num-rows acct-table))
|
||||
(last-col #f)
|
||||
(html-row #f)
|
||||
)
|
||||
(html-row #f))
|
||||
(while (< row rows)
|
||||
(map (lambda (colpair debit-coll credit-coll)
|
||||
(for-each
|
||||
(lambda (colpair debit-coll credit-coll)
|
||||
(set! html-row (+ row header-rows))
|
||||
(let* ((bal
|
||||
(gnc:html-acct-table-get-cell
|
||||
acct-table
|
||||
row
|
||||
colpair))
|
||||
(let* ((bal (gnc:html-acct-table-get-cell acct-table row colpair))
|
||||
(gross-bal? (list? bal))
|
||||
(entry (and bal
|
||||
(not gross-bal?)
|
||||
(double-col
|
||||
'entry bal
|
||||
report-commodity
|
||||
exchange-fn
|
||||
show-fcur?)))
|
||||
'entry bal report-commodity
|
||||
exchange-fn show-fcur?)))
|
||||
(credit? (and bal
|
||||
(or gross-bal?
|
||||
(double-col
|
||||
'credit-q bal
|
||||
report-commodity
|
||||
exchange-fn
|
||||
show-fcur?)
|
||||
)
|
||||
))
|
||||
(non-credit? (and bal
|
||||
(or gross-bal?
|
||||
(not credit?))
|
||||
))
|
||||
(debit (or
|
||||
(and gross-bal? (car bal))
|
||||
(and non-credit? bal)
|
||||
))
|
||||
(credit (or
|
||||
(and gross-bal? (cadr bal))
|
||||
(and credit? bal)
|
||||
))
|
||||
'credit-q bal report-commodity
|
||||
exchange-fn show-fcur?))))
|
||||
(non-credit? (and bal (or gross-bal? (not credit?))))
|
||||
(debit (or (and gross-bal? (car bal))
|
||||
(and non-credit? bal)))
|
||||
(credit (or (and gross-bal? (cadr bal))
|
||||
(and credit? bal)))
|
||||
(debit-entry
|
||||
(and gross-bal?
|
||||
(double-col
|
||||
'entry debit
|
||||
report-commodity
|
||||
exchange-fn
|
||||
show-fcur?))
|
||||
)
|
||||
(double-col 'entry debit report-commodity
|
||||
exchange-fn show-fcur?)))
|
||||
(credit-entry
|
||||
(and gross-bal?
|
||||
(double-col
|
||||
'entry credit
|
||||
report-commodity
|
||||
exchange-fn
|
||||
show-fcur?))
|
||||
)
|
||||
(double-col 'entry credit report-commodity
|
||||
exchange-fn show-fcur?)))
|
||||
(col (+ account-cols
|
||||
(* 2 colpair)
|
||||
(if non-credit? 0 1))
|
||||
)
|
||||
)
|
||||
(if non-credit? 0 1))))
|
||||
(gnc:html-table-set-cell!
|
||||
build-table
|
||||
html-row
|
||||
col
|
||||
(or entry debit-entry)
|
||||
)
|
||||
build-table html-row col (or entry debit-entry))
|
||||
(if gross-bal?
|
||||
(gnc:html-table-set-cell!
|
||||
build-table
|
||||
html-row
|
||||
(+ col 1)
|
||||
credit-entry
|
||||
)
|
||||
)
|
||||
(gnc:html-table-set-cell! build-table html-row
|
||||
(+ col 1) credit-entry))
|
||||
;; update the corresponding running total
|
||||
(and bal
|
||||
(begin
|
||||
(if credit?
|
||||
(credit-coll 'minusmerge
|
||||
(if gross-bal?
|
||||
credit bal)
|
||||
#f)
|
||||
)
|
||||
(if non-credit?
|
||||
(debit-coll 'merge
|
||||
(if gross-bal?
|
||||
debit bal)
|
||||
#f)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(when bal
|
||||
(when credit?
|
||||
(credit-coll 'minusmerge (if gross-bal? credit bal) #f))
|
||||
(when non-credit?
|
||||
(debit-coll 'merge (if gross-bal? debit bal) #f)))))
|
||||
(list adj-col atb-col is-col bs-col)
|
||||
(list adj-debits atb-debits
|
||||
is-debits bs-debits)
|
||||
(list adj-credits atb-credits
|
||||
is-credits bs-credits)
|
||||
)
|
||||
(list adj-debits atb-debits is-debits bs-debits)
|
||||
(list adj-credits atb-credits is-credits bs-credits))
|
||||
;; make sure the row extends to the final column
|
||||
(set! last-col (+ account-cols (* 2 bs-col) 1))
|
||||
(or
|
||||
(gnc:html-table-get-cell
|
||||
build-table html-row last-col)
|
||||
(gnc:html-table-set-cell!
|
||||
build-table html-row last-col #f)
|
||||
)
|
||||
(set! row (+ row 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
(or (gnc:html-table-get-cell build-table html-row last-col)
|
||||
(gnc:html-table-set-cell! build-table html-row last-col #f))
|
||||
(set! row (+ row 1)))))
|
||||
|
||||
;; now do the column totals
|
||||
(let ()
|
||||
(gnc:html-table-append-row/markup!
|
||||
build-table "primary-subheading"
|
||||
(append
|
||||
(list (gnc:make-html-table-cell/markup
|
||||
"total-label-cell" #f))
|
||||
(list (gnc:make-html-table-cell/markup "total-label-cell" #f))
|
||||
(gnc:html-make-empty-cells (- account-cols 1))
|
||||
(list (tot-abs-amt-cell debit-tot))
|
||||
(list (tot-abs-amt-cell credit-tot))
|
||||
(if (equal? report-variant 'work-sheet)
|
||||
(if (eq? report-variant 'work-sheet)
|
||||
(list
|
||||
(tot-abs-amt-cell adj-debits)
|
||||
(tot-abs-amt-cell adj-credits)
|
||||
@ -1096,14 +919,9 @@
|
||||
(tot-abs-amt-cell is-debits)
|
||||
(tot-abs-amt-cell is-credits)
|
||||
(tot-abs-amt-cell bs-debits)
|
||||
(tot-abs-amt-cell bs-credits)
|
||||
)
|
||||
(list)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (equal? report-variant 'work-sheet)
|
||||
(tot-abs-amt-cell bs-credits))
|
||||
'())))
|
||||
(if (eq? report-variant 'work-sheet)
|
||||
(let* ((net-is (gnc:make-commodity-collector))
|
||||
(net-bs (gnc:make-commodity-collector))
|
||||
(tot-is (gnc:make-commodity-collector))
|
||||
@ -1113,42 +931,32 @@
|
||||
(bs-entry #f)
|
||||
(bs-credit? #f)
|
||||
(tbl-width (+ account-cols (* 2 bs-col) 2))
|
||||
(this-row (gnc:html-table-num-rows build-table))
|
||||
)
|
||||
(this-row (gnc:html-table-num-rows build-table)))
|
||||
(net-is 'merge is-debits #f)
|
||||
(net-is 'minusmerge is-credits #f)
|
||||
(net-bs 'merge bs-debits #f)
|
||||
(net-bs 'minusmerge bs-credits #f)
|
||||
(set! is-entry
|
||||
(double-col
|
||||
'entry net-is report-commodity
|
||||
exchange-fn show-fcur?))
|
||||
(double-col 'entry net-is report-commodity exchange-fn show-fcur?))
|
||||
(set! is-credit?
|
||||
(double-col
|
||||
'credit-q net-is report-commodity
|
||||
(double-col 'credit-q net-is report-commodity
|
||||
exchange-fn show-fcur?))
|
||||
(set! bs-entry
|
||||
(double-col
|
||||
'entry net-bs report-commodity
|
||||
(double-col 'entry net-bs report-commodity
|
||||
exchange-fn show-fcur?))
|
||||
(set! bs-credit?
|
||||
(double-col
|
||||
'credit-q net-bs report-commodity
|
||||
(double-col 'credit-q net-bs report-commodity
|
||||
exchange-fn show-fcur?))
|
||||
(gnc:html-table-add-labeled-amount-line!
|
||||
build-table tbl-width "primary-subheading" #f
|
||||
(if is-credit? (_ "Net Income") (_ "Net Loss"))
|
||||
0 1 "total-label-cell"
|
||||
is-entry
|
||||
0 1 "total-label-cell" is-entry
|
||||
(+ account-cols (* 2 is-col) (if is-credit? 0 1))
|
||||
1 "total-number-cell"
|
||||
)
|
||||
1 "total-number-cell")
|
||||
(gnc:html-table-set-cell!
|
||||
build-table
|
||||
this-row
|
||||
build-table this-row
|
||||
(+ account-cols (* 2 bs-col) (if bs-credit? 0 1))
|
||||
(tot-abs-amt-cell net-bs)
|
||||
)
|
||||
(tot-abs-amt-cell net-bs))
|
||||
(set! this-row (+ this-row 1))
|
||||
|
||||
;; now slap on the grand totals
|
||||
@ -1162,23 +970,15 @@
|
||||
(tot-bs 'merge net-bs #f))
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
build-table
|
||||
"primary-subheading"
|
||||
build-table "primary-subheading"
|
||||
(append
|
||||
(gnc:html-make-empty-cells (+ account-cols (* 2 is-col)))
|
||||
(list
|
||||
(tot-abs-amt-cell (if is-credit? tot-is is-debits))
|
||||
(list (tot-abs-amt-cell (if is-credit? tot-is is-debits))
|
||||
(tot-abs-amt-cell (if is-credit? is-credits tot-is))
|
||||
(tot-abs-amt-cell (if bs-credit? tot-bs bs-debits))
|
||||
(tot-abs-amt-cell (if bs-credit? bs-credits tot-bs))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(tot-abs-amt-cell (if bs-credit? bs-credits tot-bs)))))))
|
||||
|
||||
;; ...and that's a complete trial balance/work sheet
|
||||
|
||||
(gnc:html-document-add-object! doc build-table)
|
||||
|
||||
;; add currency information if requested
|
||||
@ -1188,14 +988,7 @@
|
||||
doc
|
||||
(gnc:html-make-exchangerates
|
||||
report-commodity exchange-fn accounts)))
|
||||
(gnc:report-percent-done 100)
|
||||
|
||||
;; if sending the report to a file, do so now
|
||||
(if filename
|
||||
(let* ((port (open-output-file filename)))
|
||||
(gnc:display-report-list-item
|
||||
(list doc) port " trial-balance.scm ")
|
||||
(close-output-port port)))))
|
||||
(gnc:report-percent-done 100)))
|
||||
|
||||
(gnc:report-finished)
|
||||
|
||||
@ -1207,10 +1000,6 @@
|
||||
'report-guid "216cd0cf6931453ebcce85415aba7082"
|
||||
'menu-path (list gnc:menuname-income-expense)
|
||||
'options-generator trial-balance-options-generator
|
||||
'renderer (lambda (report-obj)
|
||||
(trial-balance-renderer report-obj #f #f))
|
||||
'export-types #f
|
||||
'export-thunk (lambda (report-obj choice filename)
|
||||
(trial-balance-renderer report-obj #f filename)))
|
||||
'renderer trial-balance-renderer)
|
||||
|
||||
;; END
|
||||
|
||||
Loading…
Reference in New Issue
Block a user