diff --git a/src/scm/report/Makefile.am b/src/scm/report/Makefile.am index 58e979c00b..21e25d659e 100644 --- a/src/scm/report/Makefile.am +++ b/src/scm/report/Makefile.am @@ -2,6 +2,7 @@ gncscmdir = ${GNC_SCM_INSTALL_DIR}/report gncscm_DATA = \ + account-summary.scm \ average-balance.scm \ balance-and-pnl.scm \ budget-report.scm \ diff --git a/src/scm/report/Makefile.in b/src/scm/report/Makefile.in index 0e4a623b48..f50099e223 100644 --- a/src/scm/report/Makefile.in +++ b/src/scm/report/Makefile.in @@ -117,7 +117,7 @@ l = @l@ gncscmdir = ${GNC_SCM_INSTALL_DIR}/report -gncscm_DATA = average-balance.scm balance-and-pnl.scm budget-report.scm folio.scm hello-world.scm report-list.scm transaction-report.scm +gncscm_DATA = account-summary.scm average-balance.scm balance-and-pnl.scm budget-report.scm folio.scm hello-world.scm report-list.scm transaction-report.scm EXTRA_DIST = .cvsignore ${gncscm_DATA} diff --git a/src/scm/report/account-summary.scm b/src/scm/report/account-summary.scm new file mode 100644 index 0000000000..4cc226aa3d --- /dev/null +++ b/src/scm/report/account-summary.scm @@ -0,0 +1,247 @@ +;; -*-scheme-*- +;; account-summary.scm +;; account(s) summary report +;; +;; Author makes no implicit or explicit guarantee of accuracy of +;; these calculations and accepts no responsibility for direct +;; or indirect losses incurred as a result of using this software. +;; +;; Terry D. Boldt (tboldt@attglobal.net> +;; created by modifying other report files extensively - the authors of +;; the modified report files are graciously thanked for their efforts. + +(gnc:support "report/account-balance.scm") +(gnc:depend "report-utilities") +(gnc:depend "html-generator.scm") +(gnc:depend "date-utilities.scm") + +(let () + + ;; Options + (define (accsum-options-generator) + (let* + ((gnc:*accsum-track-options* (gnc:new-options)) + ;; register a configuration option for the report + (gnc:register-accsum-option + (lambda (new-option) + (gnc:register-option gnc:*accsum-track-options* + new-option)))) + + ;; to-date + (gnc:register-accsum-option + (gnc:make-date-option + "Report Options" "To" + "a" "Report up to and including this date" + (lambda () + (let ((bdtime (localtime (current-time)))) + (set-tm:sec bdtime 59) + (set-tm:min bdtime 59) + (set-tm:hour bdtime 23) + (cons (car (mktime bdtime)) 0))) + #f)) + + ;; account(s) to do report on + (gnc:register-accsum-option + (gnc:make-account-list-option + "Report Options" "Account" + "b" "Report on these account(s)" + (lambda () + (let ((current-accounts (gnc:get-current-accounts)) + (num-accounts + (gnc:group-get-num-accounts (gnc:get-current-group)))) + + (cond ((not (null? current-accounts)) current-accounts) + (else + (let ((acctlist '())) + (gnc:for-loop + (lambda(x) + (set! acctlist + (append! + acctlist + (list (gnc:group-get-account + (gnc:get-current-group) x))))) + 0 num-accounts 1) + acctlist))))) + #f #t)) + + (gnc:register-accsum-option + (gnc:make-simple-boolean-option + "Report Options" "Sub-Accounts" + "c" "Include Sub-Accounts of each selected Account" #f)) + + gnc:*accsum-track-options*)) + +;; I copied the following html generation code from the html-generation file +;; because I like the numbers in the balance column aligned at the top of the +;; cell - this aligns the number with the account name - rather than placing +;; the balance number in the default position of the vertical center of cell +;; which makes it difficult to match the balance with the account name. + +;; Create a column entry + (define (accsum_html-table-col val) + (string-append "" (tostring val) "")) + + (define (accsum_html-table-col-align val align) + (string-append "" (tostring val) "")) + +;; Create an html table row from a list of entries + (define (accsum_html-table-row lst) + (cond ((string? lst) lst) + (else + (string-append + "" + (apply string-append (map accsum_html-table-col lst)) + "")))) + +; Create an html table row from a list of entries + (define (accsum_html-table-row-align lst align-list) + (cond ((string? lst) lst) + (else + (string-append + "" + (apply string-append (map accsum_html-table-col-align lst align-list)) + "")))) + +;; Create an html table from a list of rows, each containing +;; a list of column entries + (define (accsum_html-table hdrlst llst) + (string-append + (accsum_html-table-header hdrlst) + (apply string-append (map accsum_html-table-row llst)) + (accsum_html-table-footer))) + + (define (accsum_html-table-headcol val) + (string-append "" (tostring val) "")) + + (define (accsum_html-table-header vec) + (apply string-append "\n" + (map accsum_html-table-headcol vec))) + + (define (accsum_html-table-footer) + "
") + + ;; the following should be defined in the report-utilities file (Dave put it there I believe). + ;; Just in case I am including it here if your copy of report-utilities doesn't have it + ;; un-comment to use +;; (define (gnc:group-get-accounts group) +;; (gnc:group-map-accounts (lambda (a) a) group)) + + (define string-db (gnc:make-string-database)) + + (define (column-list) + (map (lambda (key) (string-db 'lookup key)) + (list 'account-name 'balance ))) + + (define (non-zero-at-date-accounts accts date) + (if (null? accts) + '() + (let ((acct (car accts)) + (rest (non-zero-at-date-accounts (cdr accts) date))) + (if (< (gnc:account-get-balance-at-date acct date #t) 0.01) + rest + (cons acct rest))))) + + ;; build the table rows for a single account + ;; date specifies the ending date for the account + ;; do-children specifies whether to expand the children + ;; in the table + ;; each row consists of two columns: account-name account-balance + ;; the children are a separate table enclosed in the account-name cell + ;; do not include accounts which have a zero balance + (define (acc-sum-table-row account date do-children?) + (let + ((acc-bal (gnc:account-get-balance-at-date account date #t)) + (children (gnc:account-get-children account))) + (list + (if (and do-children? (> (gnc:group-get-num-accounts children) 0)) + (string-append (gnc:account-get-name account) + (acc-sum-table + (non-zero-at-date-accounts + (gnc:group-get-accounts children) date) date #t)) + (gnc:account-get-name account)) + (gnc:amount->string acc-bal #f #t #f)))) + + ;; build the table for the list of 'accounts' passed + (define (acc-sum-table accnts date do-children?) + (let ((columns (column-list))) + (if (null? accnts) + "" + (accsum_html-table columns + (map (lambda (acct) + (acc-sum-table-row acct date do-children?)) + (non-zero-at-date-accounts accnts date)))))) + +;; get the total of a list of accounts at the specified date. +;; all children are included in the calculation + (define (account-total-at-date accnts date) + (apply + + (map (lambda (account) (gnc:account-get-balance-at-date account date #t)) accnts)) + ) + + + (define (accsum-renderer options) + (let ((acctcurrency "USD") + (acctname "") + (enddate (gnc:option-value + (gnc:lookup-option options "Report Options" "To"))) + (accounts (gnc:option-value + (gnc:lookup-option options "Report Options" "Account"))) + (dosubs (gnc:option-value + (gnc:lookup-option options + "Report Options" "Sub-Accounts"))) + (prefix (list "" "" "" + "Account Summary" "" "" "")) + (suffix (list "" "")) + (rept-data '()) + (rept-text "") + (rept-total ()) + (slist '())) + + (if (null? accounts) + (set! rept-text + (list "" + (string-db 'lookup 'no-account) + "")) + (begin + + (set! rept-total (gnc:amount->string (account-total-at-date accounts enddate) #f #t #f)) + + ; Grab account names + (set! acctname + (string-join (map gnc:account-get-name accounts) " , ")) + + ;; Create HTML + (set! rept-data (acc-sum-table accounts enddate dosubs)))) + + (list prefix + (if (null? accounts) + rept-text + (list (sprintf #f + (string-db 'lookup + (if dosubs + 'report-for-and + 'report-for)) + (gnc:print-date enddate) + acctname + rept-total) + "

\n")) + rept-data +;; rept-total + suffix))) + + ;; Define the strings + (string-db 'store 'account-name "Account Name") + (string-db 'store 'balance "Balance") + (string-db 'store 'no-account "You have not selected an account.") + (string-db 'store 'report-for "Date: %s
Report for %s.
Accounts Total: %s") + (string-db 'store 'report-for-and "Date: %s
Report for %s and all Sub-Accounts.
Accounts Total: %s") + + (gnc:define-report + ;; version + 'version 1 + ;; Name + 'name "Account Summary" + ;; Options + 'options-generator accsum-options-generator + ;; renderer + 'renderer accsum-renderer)) diff --git a/src/scm/report/report-list.scm b/src/scm/report/report-list.scm index 4f0e6652a0..8b0134b7b2 100644 --- a/src/scm/report/report-list.scm +++ b/src/scm/report/report-list.scm @@ -7,4 +7,4 @@ (gnc:depend "report/hello-world.scm") (gnc:depend "report/transaction-report.scm") (gnc:depend "report/budget-report.scm") - +(gnc:depend "report/account-summary.scm")