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

2002-11-30 Herbert Thoma <herbie@hthoma.de>

Browse Source 
* src/report/standard-reports/cash-flow.scm: Added new option
	for output formating, make the output "nicer"


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7576 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins 2002-11-30 19:25:20 +00:00
parent 161125bc00
commit e543b3bd01
2 changed files with 130 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
ChangeLog
View File

@ -1,3 +1,8 @@
2002-11-30 Herbert Thoma <herbie@hthoma.de>
* src/report/standard-reports/cash-flow.scm: Added new option
for output formating, make the output "nicer"
2002-11-30 Christian Stimming <stimming@tuhh.de> 2002-11-30 Christian Stimming <stimming@tuhh.de>
* src/import-export/hbci/gnc-hbci-getbalance.c: More graceful * src/import-export/hbci/gnc-hbci-getbalance.c: More graceful

133
src/report/standard-reports/cash-flow.scm
View File

@ -33,6 +33,7 @@
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(require 'printf) (require 'printf)
(require 'sort)
(gnc:module-load "gnucash/report/report-system" 0) (gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/gnome-utils" 0) ;for gnc:html-build-url (gnc:module-load "gnucash/gnome-utils" 0) ;for gnc:html-build-url
@ -51,6 +52,7 @@
(define optname-report-currency (N_ "Report's currency")) (define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source")) (define optname-price-source (N_ "Price Source"))
(define optname-show-rates (N_ "Show Exchange Rates")) (define optname-show-rates (N_ "Show Exchange Rates"))
(define optname-show-full-names (N_ "Show Full Account Names"))
;; options generator ;; options generator
(define (cash-flow-options-generator) (define (cash-flow-options-generator)
@ -74,7 +76,13 @@
options options
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-general optname-show-rates gnc:pagename-general optname-show-rates
"d" (N_ "Show the exchange rates used") #t)) "d" (N_ "Show the exchange rates used") #f))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-general optname-show-full-names
"e" (N_ "Show full account names (including parent accounts)") #t))
;; accounts to work on ;; accounts to work on
(gnc:options-add-account-selection! (gnc:options-add-account-selection!
@ -106,7 +114,11 @@
(gnc:report-starting reportname) (gnc:report-starting reportname)
;; get all option's values ;; get all option's values
(let* ((accounts (get-option gnc:pagename-accounts (let* ((display-depth (get-option gnc:pagename-accounts
optname-display-depth))
(show-subaccts? (get-option gnc:pagename-accounts
optname-show-subaccounts))
(accounts (get-option gnc:pagename-accounts
optname-accounts)) optname-accounts))
(work-done 0) (work-done 0)
(work-to-do 0) (work-to-do 0)
@ -116,6 +128,8 @@
optname-price-source)) optname-price-source))
(show-rates? (get-option gnc:pagename-general (show-rates? (get-option gnc:pagename-general
optname-show-rates)) optname-show-rates))
(show-full-names? (get-option gnc:pagename-general
optname-show-full-names))
(from-date-tp (gnc:timepair-start-day-time (from-date-tp (gnc:timepair-start-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(get-option gnc:pagename-general (get-option gnc:pagename-general
@ -129,6 +143,8 @@
(exchange-fn (gnc:case-exchange-fn (exchange-fn (gnc:case-exchange-fn
price-source report-currency to-date-tp)) price-source report-currency to-date-tp))
(separator (gnc:account-separator-char))
(doc (gnc:make-html-document)) (doc (gnc:make-html-document))
(table (gnc:make-html-table)) (table (gnc:make-html-table))
(txt (gnc:make-html-text))) (txt (gnc:make-html-text)))
@ -151,6 +167,28 @@
((same-account? (caar alist) account) (car alist)) ((same-account? (caar alist) account) (car alist))
(else (account-in-alist account (cdr alist)))))) (else (account-in-alist account (cdr alist))))))
;; helper for sorting of account list
(define (account-full-name<? a b)
(string<? (gnc:account-get-full-name a) (gnc:account-get-full-name b)))
;; helper for account depth
(define (account-get-depth account)
(define (account-get-depth-internal account-internal depth)
(let ((parent (gnc:account-get-parent-account account-internal)))
(if parent
(account-get-depth-internal parent (+ depth 1))
depth)))
(account-get-depth-internal account 1))
(define (accounts-get-children-depth accounts)
(apply max
(map (lambda (acct)
(let ((children
(gnc:account-get-immediate-subaccounts acct)))
(if (null? children)
1
(+ 1 (accounts-get-children-depth children)))))
accounts)))
(gnc:html-document-set-title! (gnc:html-document-set-title!
@ -158,9 +196,25 @@
(get-option gnc:pagename-general gnc:optname-reportname) (get-option gnc:pagename-general gnc:optname-reportname)
(gnc:print-date from-date-tp) (gnc:print-date to-date-tp))) (gnc:print-date from-date-tp) (gnc:print-date to-date-tp)))
;; add subaccounts if requested
(if show-subaccts?
(let ((sub-accounts (gnc:acccounts-get-all-subaccounts accounts)))
(for-each
(lambda (sub-account)
(if (not (account-in-list? sub-account accounts))
(set! accounts (append accounts sub-accounts))))
sub-accounts)))
(if (not (null? accounts)) (if (not (null? accounts))
(let* ((money-in-accounts '()) (let* ((tree-depth (if (equal? display-depth 'all)
(accounts-get-children-depth accounts)
display-depth))
(account-disp-list '())
(money-in-accounts '())
(money-in-alist '()) (money-in-alist '())
(money-in-collector (gnc:make-commodity-collector)) (money-in-collector (gnc:make-commodity-collector))
@ -262,25 +316,44 @@
(money-diff-collector 'merge money-in-collector #f) (money-diff-collector 'merge money-in-collector #f)
(money-diff-collector 'minusmerge money-out-collector #f) (money-diff-collector 'minusmerge money-out-collector #f)
(set! accounts (sort accounts account-full-name<?))
(set! money-in-accounts (sort money-in-accounts account-full-name<?))
(set! money-out-accounts (sort money-out-accounts account-full-name<?))
(set! work-done 0) (set! work-done 0)
(set! work-to-do (length accounts)) (set! work-to-do (length accounts))
(for-each
(lambda (account)
(set! work-done (+ 1 work-done))
(gnc:report-percent-done (+ 85 (* 5 (/ work-done work-to-do))))
(if (<= (account-get-depth account) tree-depth)
(let* ((anchor (gnc:html-markup/format
(if (and (= (account-get-depth account) tree-depth)
(not (eq? (gnc:account-get-immediate-subaccounts account) '())))
(if show-subaccts?
(_ "%s and subaccounts")
(_ "%s and selected subaccounts"))
"%s")
(gnc:html-markup-anchor
(gnc:account-anchor-text account)
(if show-full-names?
(gnc:account-get-full-name account)
(gnc:account-get-name account))))))
(set! account-disp-list (cons anchor account-disp-list))
)
)
)
accounts
)
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc doc
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-ul (gnc:html-markup-ul
(map (reverse account-disp-list))))
(lambda (acct)
(set! work-done (+ 1 work-done))
(gnc:report-percent-done (+ 85 (* 5 (/ work-done work-to-do))))
(gnc:html-markup-anchor
(gnc:html-build-url gnc:url-type-register
(string-append "account="
(gnc:account-get-full-name
acct))
#f)
(gnc:account-get-name acct)))
accounts))))
(gnc:html-table-append-ruler! table 2) (gnc:html-table-append-ruler! table 2)
@ -294,18 +367,27 @@
(set! work-done 0) (set! work-done 0)
(set! work-to-do (length money-in-alist)) (set! work-to-do (length money-in-alist))
(for-each (for-each
(lambda (pair) (lambda (account)
(set! work-done (+ 1 work-done)) (set! work-done (+ 1 work-done))
(gnc:report-percent-done (+ 90 (* 5 (/ work-done work-to-do)))) (gnc:report-percent-done (+ 90 (* 5 (/ work-done work-to-do))))
(let* ((pair (account-in-alist account money-in-alist))
(acct (car pair)))
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
"normal-row" "normal-row"
(list (list
(gnc:html-account-anchor (car pair)) ;(gnc:html-account-anchor acct)
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:account-anchor-text acct)
(if show-full-names?
(gnc:account-get-full-name acct)
(gnc:account-get-name acct))))
(gnc:make-html-table-header-cell/markup (gnc:make-html-table-header-cell/markup
"number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn)))) "number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))
) )
money-in-alist )
money-in-accounts
) )
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
@ -328,18 +410,27 @@
(set! work-done 0) (set! work-done 0)
(set! work-to-do (length money-out-alist)) (set! work-to-do (length money-out-alist))
(for-each (for-each
(lambda (pair) (lambda (account)
(set! work-done (+ 1 work-done)) (set! work-done (+ 1 work-done))
(gnc:report-percent-done (+ 95 (* 5 (/ work-done work-to-do)))) (gnc:report-percent-done (+ 95 (* 5 (/ work-done work-to-do))))
(let* ((pair (account-in-alist account money-out-alist))
(acct (car pair)))
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
"normal-row" "normal-row"
(list (list
(gnc:html-account-anchor (car pair)) ;(gnc:html-account-anchor acct)
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:account-anchor-text acct)
(if show-full-names?
(gnc:account-get-full-name acct)
(gnc:account-get-name acct))))
(gnc:make-html-table-header-cell/markup (gnc:make-html-table-header-cell/markup
"number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn)))) "number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))
) )
money-out-alist )
money-out-accounts
) )
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!