IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[register] *delete-trailing-whitespace/reindent/untabify*

Browse Source
This commit is contained in:
Christopher Lam 2019-02-22 17:18:06 +08:00
parent 3759099e1e
commit beaf945907
1 changed files with 124 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

248
gnucash/report/standard-reports/register.scm
View File

@ -22,7 +22,7 @@
(define-module (gnucash report standard-reports register)) (define-module (gnucash report standard-reports register))
(use-modules (gnucash utilities)) (use-modules (gnucash utilities))
(use-modules (srfi srfi-1)) (use-modules (srfi srfi-1))
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(use-modules (gnucash gettext)) (use-modules (gnucash gettext))
@ -62,16 +62,16 @@
(define columns-used-size 15) (define columns-used-size 15)
(define (num-columns-required columns-used) (define (num-columns-required columns-used)
(do ((i 0 (+ i 1)) (do ((i 0 (+ i 1))
(col-req 0 col-req)) (col-req 0 col-req))
((>= i columns-used-size) col-req) ((>= i columns-used-size) col-req)
(if (vector-ref columns-used i) (if (vector-ref columns-used i)
(set! col-req (+ col-req 1))))) (set! col-req (+ col-req 1)))))
(define (build-column-used options) (define (build-column-used options)
(define (opt-val section name) (define (opt-val section name)
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name))) (gnc:lookup-option options section name)))
(define (make-set-col col-vector) (define (make-set-col col-vector)
(let ((col 0)) (let ((col 0))
@ -81,25 +81,25 @@
(vector-set! col-vector index col) (vector-set! col-vector index col)
(set! col (+ col 1))) (set! col (+ col 1)))
(vector-set! col-vector index #f))))) (vector-set! col-vector index #f)))))
(let* ((col-vector (make-vector columns-used-size #f)) (let* ((col-vector (make-vector columns-used-size #f))
(set-col (make-set-col col-vector))) (set-col (make-set-col col-vector)))
(set-col (opt-val "Display" "Date") 0) (set-col (opt-val "Display" "Date") 0)
(set-col (if (gnc:lookup-option options "Display" "Num") (set-col (if (gnc:lookup-option options "Display" "Num")
(opt-val "Display" "Num") (opt-val "Display" "Num")
(opt-val "Display" "Num/Action")) 1) (opt-val "Display" "Num/Action")) 1)
(set-col (set-col
(if (opt-val "__reg" "journal") (if (opt-val "__reg" "journal")
(or (opt-val "Display" "Memo") (opt-val "Display" "Description") (opt-val "__reg" "double") ) (or (opt-val "Display" "Memo")
(opt-val "Display" "Description") (opt-val "Display" "Description")
) (opt-val "__reg" "double") )
2) (opt-val "Display" "Description"))
(set-col 2)
(if (opt-val "__reg" "journal") (set-col
#f (if (opt-val "__reg" "journal")
(opt-val "Display" "Memo") #f
) (opt-val "Display" "Memo"))
3) 3)
(set-col (opt-val "Display" "Account") 4) (set-col (opt-val "Display" "Account") 4)
(set-col (opt-val "Display" "Shares") 5) (set-col (opt-val "Display" "Shares") 5)
(set-col (opt-val "Display" "Lot") 14) (set-col (opt-val "Display" "Lot") 14)
@ -191,77 +191,77 @@
(addto! row-contents (addto! row-contents
(if transaction-info? (if transaction-info?
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"date-cell" "date-cell"
(qof-print-date (qof-print-date
(xaccTransGetDate parent))) (xaccTransGetDate parent)))
" "))) " ")))
(if (num-col column-vector) (if (num-col column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if transaction-info? (if transaction-info?
(if (and action-for-num? ledger-type?) (if (and action-for-num? ledger-type?)
(gnc-get-num-action parent #f) (gnc-get-num-action parent #f)
(gnc-get-num-action parent split)) (gnc-get-num-action parent split))
(if split-info? (if split-info?
(gnc-get-action-num #f split) (gnc-get-action-num #f split)
" "))))) " ")))))
(if (description-col column-vector) (if (description-col column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if transaction-info? (if transaction-info?
(if description? (if description?
(xaccTransGetDescription parent) (xaccTransGetDescription parent)
" " ) " " )
(if split-info? (if split-info?
(if memo? (if memo?
(xaccSplitGetMemo split) (xaccSplitGetMemo split)
" ") " ")
" "))))) " ")))))
(if (memo-col column-vector) (if (memo-col column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if transaction-info? (if transaction-info?
(xaccSplitGetMemo split) (xaccSplitGetMemo split)
" ")))) " "))))
(if (account-col column-vector) (if (account-col column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if split-info? (if split-info?
(if transaction-info? (if transaction-info?
(let ((other-split (let ((other-split
(xaccSplitGetOtherSplit split))) (xaccSplitGetOtherSplit split)))
(if (not (null? other-split)) (if (not (null? other-split))
(gnc-account-get-full-name (gnc-account-get-full-name
(xaccSplitGetAccount other-split)) (xaccSplitGetAccount other-split))
(_ "-- Split Transaction --"))) (_ "-- Split Transaction --")))
(gnc-account-get-full-name account)) (gnc-account-get-full-name account))
" ")))) " "))))
(if (shares-col column-vector) (if (shares-col column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if split-info? (if split-info?
(xaccSplitGetAmount split) (xaccSplitGetAmount split)
" ")))) " "))))
(if (lot-col column-vector) (if (lot-col column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if split-info? (if split-info?
(gnc-lot-get-title (xaccSplitGetLot split)) (gnc-lot-get-title (xaccSplitGetLot split))
" ")))) " "))))
(if (price-col column-vector) (if (price-col column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if split-info? (if split-info?
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
currency (xaccSplitGetSharePrice split)) currency (xaccSplitGetSharePrice split))
" ")))) " "))))
(if (amount-single-col column-vector) (if (amount-single-col column-vector)
(addto! row-contents (addto! row-contents
(if split-info? (if split-info?
@ -294,7 +294,7 @@
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"number-cell" "number-cell"
(gnc:make-gnc-monetary trans-currency (gnc:make-gnc-monetary trans-currency
(xaccSplitGetValue split))) (xaccSplitGetValue split)))
" "))) " ")))
(if (value-debit-col column-vector) (if (value-debit-col column-vector)
(addto! row-contents (addto! row-contents
@ -312,9 +312,9 @@
(gnc:make-gnc-monetary trans-currency (gnc:make-gnc-monetary trans-currency
(gnc-numeric-neg (xaccSplitGetValue split)))) (gnc-numeric-neg (xaccSplitGetValue split))))
" "))) " ")))
; For single account registers, use the split's cached balance to remain ;; For single account registers, use the split's cached balance to remain
; consistent with the balances shown in the register itself ;; consistent with the balances shown in the register itself
; For others, use the cumulated balance from the totals-collector ;; For others, use the cumulated balance from the totals-collector
(if (balance-col column-vector) (if (balance-col column-vector)
(addto! row-contents (addto! row-contents
(if transaction-info? (if transaction-info?
@ -323,44 +323,44 @@
(gnc:html-split-anchor (gnc:html-split-anchor
split split
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
currency currency
(if ledger-type? (if ledger-type?
(cadr (total-collector 'getpair currency #f)) (cadr (total-collector 'getpair currency #f))
(xaccSplitGetBalance split))))) (xaccSplitGetBalance split)))))
" "))) " ")))
(gnc:html-table-append-row/markup! table row-style (gnc:html-table-append-row/markup! table row-style
(reverse row-contents)) (reverse row-contents))
(if (and double? transaction-info?) (if (and double? transaction-info?)
(if (or (num-col column-vector) (description-col column-vector)) (if (or (num-col column-vector) (description-col column-vector))
(begin (begin
(let ((count 0)) (let ((count 0))
(set! row-contents '()) (set! row-contents '())
(if (date-col column-vector) (if (date-col column-vector)
(begin (begin
(set! count (+ count 1)) (set! count (+ count 1))
(addto! row-contents " "))) (addto! row-contents " ")))
(if (and (num-col column-vector) (description-col column-vector)) (if (and (num-col column-vector) (description-col column-vector))
(begin (begin
(set! count (+ count 1)) (set! count (+ count 1))
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"text-cell" "text-cell"
(if (and action-for-num? (not ledger-type?)) (if (and action-for-num? (not ledger-type?))
(gnc-get-num-action parent #f) (gnc-get-num-action parent #f)
" "))))) " ")))))
(if (description-col column-vector) (if (description-col column-vector)
(addto! row-contents ;; (addto! row-contents ;;
(gnc:make-html-table-cell/size
1 (- (num-columns-required column-vector) count)
(xaccTransGetNotes parent)))
(gnc:make-html-table-cell/size (gnc:make-html-table-cell/size
1 (- (num-columns-required column-vector) count)
(xaccTransGetNotes parent)))
(gnc:make-html-table-cell/size
1 (- (num-columns-required column-vector) (- count 1)) 1 (- (num-columns-required column-vector) (- count 1))
(if (and action-for-num? (not ledger-type?)) (if (and action-for-num? (not ledger-type?))
(gnc-get-num-action parent #f) (gnc-get-num-action parent #f)
" "))) " ")))
(gnc:html-table-append-row/markup! table row-style (gnc:html-table-append-row/markup! table row-style
(reverse row-contents)))))) (reverse row-contents))))))
split-value)) split-value))
(define (lookup-sort-key sort-option) (define (lookup-sort-key sort-option)
@ -442,7 +442,7 @@
(gnc:register-reg-option (gnc:register-reg-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
(N_ "Display") (N_ "Amount") (N_ "Display") (N_ "Amount")
"ia" (N_ "Display the amount?") "ia" (N_ "Display the amount?")
'double 'double
(list (list
(vector 'single (N_ "Single") (N_ "Single Column Display.")) (vector 'single (N_ "Single") (N_ "Single Column Display."))
@ -528,7 +528,7 @@
(gnc:make-html-text (gnc:html-markup-hr))))) (gnc:make-html-text (gnc:html-markup-hr)))))
(for-each (lambda (currency) (for-each (lambda (currency)
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
subtotal-style subtotal-style
(append (cons (gnc:make-html-table-cell/markup (append (cons (gnc:make-html-table-cell/markup
@ -567,10 +567,10 @@
(if (not (null? current)) (if (not (null? current))
(begin (begin
(add-split-row table current used-columns row-style #f #t (add-split-row table current used-columns row-style #f #t
action-for-num? ledger-type? #f action-for-num? ledger-type? #f
(opt-val "Display" "Memo") (opt-val "Display" "Memo")
(opt-val "Display" "Description") (opt-val "Display" "Description")
total-collector) total-collector)
(other-rows-driver split parent table (other-rows-driver split parent table
used-columns (+ i 1)))))) used-columns (+ i 1))))))
@ -595,7 +595,7 @@
(ledger-type? (reg-report-ledger-type?)) (ledger-type? (reg-report-ledger-type?))
(double? (reg-report-double?)) (double? (reg-report-double?))
(action-for-num? (qof-book-use-split-action-for-num-field (action-for-num? (qof-book-use-split-action-for-num-field
(gnc-get-current-book)))) (gnc-get-current-book))))
(gnc:html-table-set-col-headers! (gnc:html-table-set-col-headers!
table table
@ -614,8 +614,8 @@
(double? double?) (double? double?)
(odd-row? #t) (odd-row? #t)
(total-collector (gnc:make-commodity-collector)) (total-collector (gnc:make-commodity-collector))
(debit-collector (gnc:make-commodity-collector)) (debit-collector (gnc:make-commodity-collector))
(credit-collector (gnc:make-commodity-collector)) (credit-collector (gnc:make-commodity-collector))
(total-value (gnc:make-commodity-collector)) (total-value (gnc:make-commodity-collector))
(debit-value (gnc:make-commodity-collector)) (debit-value (gnc:make-commodity-collector))
(credit-value (gnc:make-commodity-collector))) (credit-value (gnc:make-commodity-collector)))
@ -623,23 +623,23 @@
;; ---------------------------------- ;; ----------------------------------
;; exit condition reached ;; exit condition reached
;; ---------------------------------- ;; ----------------------------------
(begin (begin
;; ------------------------------------ ;; ------------------------------------
;; add debit/credit totals to the table ;; add debit/credit totals to the table
;; ------------------------------------ ;; ------------------------------------
(if (reg-report-show-totals?) (if (reg-report-show-totals?)
(begin (begin
(add-subtotal-row (_ "Total Debits") leader table used-columns (add-subtotal-row (_ "Total Debits") leader table used-columns
debit-collector "grand-total" #f) debit-collector "grand-total" #f)
(add-subtotal-row (_ "Total Credits") leader table used-columns (add-subtotal-row (_ "Total Credits") leader table used-columns
credit-collector "grand-total" #f) credit-collector "grand-total" #f)
(add-subtotal-row (_ "Total Value Debits") leader table used-columns (add-subtotal-row (_ "Total Value Debits") leader table used-columns
debit-value "grand-total" #t) debit-value "grand-total" #t)
(add-subtotal-row (_ "Total Value Credits") leader table used-columns (add-subtotal-row (_ "Total Value Credits") leader table used-columns
credit-value "grand-total" #t))) credit-value "grand-total" #t)))
(if ledger-type? (if ledger-type?
(add-subtotal-row (_ "Net Change") leader table used-columns (add-subtotal-row (_ "Net Change") leader table used-columns
total-collector "grand-total" #f)) total-collector "grand-total" #f))
(add-subtotal-row (_ "Value Change") leader table used-columns (add-subtotal-row (_ "Value Change") leader table used-columns
total-value "grand-total" #t)) total-value "grand-total" #t))
@ -694,19 +694,19 @@
rest rest
table table
used-columns used-columns
width width
multi-rows? multi-rows?
action-for-num? action-for-num?
ledger-type? ledger-type?
double? double?
(not odd-row?) (not odd-row?)
total-collector total-collector
debit-collector debit-collector
credit-collector credit-collector
total-value total-value
debit-value debit-value
credit-value)))) credit-value))))
table)) table))
(define (reg-renderer report-obj) (define (reg-renderer report-obj)