diff --git a/ChangeLog b/ChangeLog index 8adb45de44..a9ec0bd091 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2002-11-26 David Hampton + + * src/report/report-system/commodity-utilities.scm: + * src/report/report-system/html-utilities.scm: + * src/report/report-system/report-utilities.scm: + * src/report/report-system/report.scm: + * src/report/standard-reports/*.scm: + * src/business/business-reports/*.scm: Provide progress updates + while creating reports. + + * src/gnome-utils/gw-gnome-utils-spec.scm: Make the + set_busy_cursor and unset_busy_cursor routines available from + scheme. + 2002-11-25 Derek Atkins * src/engine/QueryCore.c -- make sure we have a string diff --git a/src/business/business-reports/aging.scm b/src/business/business-reports/aging.scm index 33a405c2b0..920372f86e 100644 --- a/src/business/business-reports/aging.scm +++ b/src/business/business-reports/aging.scm @@ -346,7 +346,7 @@ totals to report currency") (set! begindate (decdate begindate ThirtyDayDelta)) (gnc:make-date-list begindate to-date ThirtyDayDelta))) -(define (aging-renderer report-obj account reverse?) +(define (aging-renderer report-obj reportname account reverse?) (define (get-name a) (let* ((owner (company-get-owner-obj (cdr a)))) @@ -478,6 +478,7 @@ totals to report currency") (map fmt-function collector-list))) + (gnc:report-starting reportname) (let* ((companys (make-hash-table 23)) (report-title (op-value gnc:pagename-general gnc:optname-reportname)) ;; document will be the HTML document that we return. @@ -497,6 +498,8 @@ totals to report currency") (table (gnc:make-html-table)) (query (gnc:malloc-query)) (company-list '()) + (work-done 0) + (work-to-do 0) (document (gnc:make-html-document))) ; (gnc:debug "Account: " account) @@ -520,7 +523,10 @@ totals to report currency") ; (gnc:debug "splits" splits) ;; build the table + (set! work-to-do (length splits)) (for-each (lambda (split) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 50 (/ work-done work-to-do))) (update-company-hash companys split interval-vec @@ -538,7 +544,10 @@ totals to report currency") sort-pred)) ;; build the table + (set! work-to-do (length company-list)) (for-each (lambda (company-list-entry) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (+ 50 (* 50 (/ work-done work-to-do)))) (let* ((monetary-list (convert-to-monetary-list (company-get-buckets (cdr company-list-entry)) @@ -589,6 +598,7 @@ totals to report currency") (gnc:make-html-text "No Valid Account Selected"))) (gnc:free-query query) + (gnc:report-finished) document)) (export aging-options-generator) diff --git a/src/business/business-reports/payables.scm b/src/business/business-reports/payables.scm index 17f47e7eb9..006511a4de 100644 --- a/src/business/business-reports/payables.scm +++ b/src/business/business-reports/payables.scm @@ -58,7 +58,7 @@ (let ((payables-account (opt-val acc-page this-acc))) (gnc:debug "payables-account" payables-account) - (aging-renderer report-obj payables-account #f))) + (aging-renderer report-obj this-acc payables-account #f))) ;; Here we define the actual report with gnc:define-report (gnc:define-report diff --git a/src/business/business-reports/receivables.scm b/src/business/business-reports/receivables.scm index 605727ae3d..67c0a8464a 100644 --- a/src/business/business-reports/receivables.scm +++ b/src/business/business-reports/receivables.scm @@ -59,7 +59,7 @@ (let* ((receivables-account (op-value acc-page this-acc))) (gnc:debug "receivables-account" receivables-account) - (aging-renderer report-obj receivables-account #t))) + (aging-renderer report-obj this-acc receivables-account #t))) ;; Here we define the actual report with gnc:define-report (gnc:define-report diff --git a/src/gnome-utils/gw-gnome-utils-spec.scm b/src/gnome-utils/gw-gnome-utils-spec.scm index 6a2205f025..37415d20de 100644 --- a/src/gnome-utils/gw-gnome-utils-spec.scm +++ b/src/gnome-utils/gw-gnome-utils-spec.scm @@ -35,6 +35,7 @@ "#include \n" "#include \n" "#include \n" + "#include \n" "#include \n" "#include \n" "#include \n" @@ -66,6 +67,7 @@ '() "Shutdown the GnuCash gnome system.") + (gw:wrap-as-wct ws ' "GtkWidget*" "const GtkWidget*") (gw:wrap-as-wct ws ' "gncUIWidget" "const gncUIWidget") (gw:wrap-as-wct ws ' "GNCMDIInfo*" "const GNCMDIInfo*") (gw:wrap-as-wct ws ' "GNCOptionWin*" "const GNCOptionWin*") @@ -466,4 +468,23 @@ be left empty") '((( caller-owned const) message) ( percentage)) "Autosize the columns of a clist including the titles.") + + (gw:wrap-function + ws + 'gnc:set_busy_cursor + ' + "gnc_set_busy_cursor" + '(( window) + ( update_now)) + "Set a busy cursor for a specific window. If null, the busy cursor will be set on all windows.") + + (gw:wrap-function + ws + 'gnc:unset_busy_cursor + ' + "gnc_unset_busy_cursor" + '(( window)) + "Remove a busy cursor for a specific window. If null, the busy cursor will be removed on all windows.") ) + + diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm index 095300489e..c044ba31d4 100644 --- a/src/report/report-system/commodity-utilities.scm +++ b/src/report/report-system/commodity-utilities.scm @@ -197,12 +197,19 @@ ;; of the foreign-currency and the appropriate list from ;; gnc:get-commodity-totalavg-prices, see there. (define (gnc:get-commoditylist-totalavg-prices - commodity-list report-currency end-date-tp) + commodity-list report-currency end-date-tp + start-percent delta-percent) (let ((currency-accounts (filter gnc:account-has-shares? (gnc:group-get-subaccounts - (gnc:get-current-group))))) + (gnc:get-current-group)))) + (work-to-do (length commodity-list)) + (work-done 0)) (map (lambda (c) + (set! work-done (+ 1 work-done)) + (if start-percent + (gnc:report-percent-done + (+ start-percent (* delta-percent (/ work-done work-to-do))))) (cons c (gnc:get-commodity-totalavg-prices currency-accounts end-date-tp c report-currency))) @@ -287,12 +294,19 @@ ;; consists of the foreign-currency and the appropriate list from ;; gnc:get-commodity-inst-prices, see there. (define (gnc:get-commoditylist-inst-prices - commodity-list report-currency end-date-tp) + commodity-list report-currency end-date-tp + start-percent delta-percent) (let ((currency-accounts (filter gnc:account-has-shares? (gnc:group-get-subaccounts - (gnc:get-current-group))))) + (gnc:get-current-group)))) + (work-to-do (length commodity-list)) + (work-done 0)) (map (lambda (c) + (set! work-done (+ 1 work-done)) + (if start-percent + (gnc:report-percent-done + (+ start-percent (* delta-percent (/ work-done work-to-do))))) (cons c (gnc:get-commodity-inst-prices currency-accounts end-date-tp c report-currency))) @@ -798,12 +812,18 @@ ;; Return a ready-to-use function. Which one to use is determined by ;; the value of 'source-option', whose possible values are set in ;; gnc:options-add-price-source!. +;; +;; start-percent, delta-percent: Fill in the [start:start+delta] +;; section of the progress bar while running this function. +;; (define (gnc:case-exchange-time-fn - source-option report-currency commodity-list to-date-tp) + source-option report-currency commodity-list to-date-tp + start-percent delta-percent) (case source-option ('weighted-average (let ((pricealist (gnc:get-commoditylist-totalavg-prices - commodity-list report-currency to-date-tp))) + commodity-list report-currency to-date-tp + start-percent delta-percent))) (lambda (foreign domestic date) (gnc:exchange-by-pricealist-nearest pricealist foreign domestic date)))) diff --git a/src/report/report-system/html-utilities.scm b/src/report/report-system/html-utilities.scm index 5fd7688e76..b8064ef641 100644 --- a/src/report/report-system/html-utilities.scm +++ b/src/report/report-system/html-utilities.scm @@ -316,6 +316,8 @@ ;; total-name, get-total-fn), group-types?, ;; show-parent-balance?, show-parent-total? ;; +;; Feedback while building -- start-percent, delta-percent +;; ;; Note: The returned table object will have 2*tree-depth columns if ;; show-other-curr?==#f, else it will have 3*tree-depth columns. ;; @@ -362,14 +364,20 @@ ;; non-report-currencies will additionally be displayed in the ;; second-rightmost column. ;; +;; start-percent, delta-percent: Fill in the [start:start+delta] +;; section of the progress bar while running this function. +;; (define (gnc:html-build-acct-table start-date end-date tree-depth show-subaccts? accounts + start-percent delta-percent show-col-headers? show-total? get-total-fn total-name group-types? show-parent-balance? show-parent-total? show-other-curr? report-commodity exchange-fn show-zero-entries?) (let ((table (gnc:make-html-table)) + (work-to-do 0) + (work-done 0) (topl-accounts (gnc:group-get-account-list (gnc:get-current-group)))) @@ -515,6 +523,22 @@ row-style boldface? group-header-line?))) + (define (count-accounts! current-depth accnts) + (if (<= current-depth tree-depth) + (let ((sum 0)) + (for-each + (lambda (acct) + (let ((subaccts (filter + use-acct? + (gnc:account-get-immediate-subaccounts acct)))) + (set! sum (+ sum 1)) + (if (or (= current-depth tree-depth) (null? subaccts)) + sum + (set! sum (+ sum (count-accounts! (+ 1 current-depth) subaccts)))))) + accnts) + sum) + 0)) + ;; This prints *all* the rows that belong to one group: the title ;; row, the subaccount tree, and the Total row with the balance of ;; the subaccounts. groupname may be a string or a html-text @@ -574,6 +598,10 @@ (let ((subaccts (filter use-acct? (gnc:account-get-immediate-subaccounts acct)))) + (set! work-done (+ 1 work-done)) + (if start-percent + (gnc:report-percent-done + (+ start-percent (* delta-percent (/ work-done work-to-do))))) (if (or (= current-depth tree-depth) (null? subaccts)) (begin (if (show-acct? acct) @@ -591,6 +619,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; start the recursive account processing + (set! work-to-do (count-accounts! + (if group-types? 2 1) + (filter use-acct? topl-accounts))) (if group-types? ;; Print a subtotal for each group. (for-each diff --git a/src/report/report-system/report-utilities.scm b/src/report/report-system/report-utilities.scm index 8369c5e307..8e5bdc534a 100644 --- a/src/report/report-system/report-utilities.scm +++ b/src/report/report-system/report-utilities.scm @@ -669,7 +669,10 @@ (gnc:transaction-get-void-status trans))) (define (gnc:report-starting report-name) - (gnc:mdi_show_progress (sprintf #f (_ "Building '%s' report ...") report-name) 0)) + (gnc:mdi_show_progress (sprintf #f + (_ "Building '%s' report ...") + (gnc:gettext report-name)) + 0)) (define (gnc:report-percent-done percent) (gnc:mdi_show_progress #f (truncate percent))) diff --git a/src/report/report-system/report.scm b/src/report/report-system/report.scm index de544867e8..33ed8b2c4f 100644 --- a/src/report/report-system/report.scm +++ b/src/report/report-system/report.scm @@ -362,8 +362,10 @@ ;; otherwise, rerun the report (let ((template (hash-ref *gnc:_report-templates_* - (gnc:report-type report)))) - (if template + (gnc:report-type report))) + (doc #f)) + (gnc:set_busy_cursor #f #t) + (set! doc (if template (let* ((renderer (gnc:report-template-renderer template)) (stylesheet (gnc:report-stylesheet report)) (doc (renderer report)) @@ -373,7 +375,9 @@ (gnc:report-set-ctext! report html) (gnc:report-set-dirty?! report #f) html) - #f)))) + #f)) + (gnc:unset_busy_cursor #f) + doc))) (define (gnc:report-run id) (gnc:backtrace-if-exception diff --git a/src/report/standard-reports/account-piecharts.scm b/src/report/standard-reports/account-piecharts.scm index 893d440dbf..ea8d0158e4 100644 --- a/src/report/standard-reports/account-piecharts.scm +++ b/src/report/standard-reports/account-piecharts.scm @@ -156,6 +156,8 @@ balance at a given time")) (gnc:lookup-option (gnc:report-options report-obj) section name))) + (gnc:report-starting reportname) + ;; Get all options (let ((to-date-tp (gnc:timepair-end-day-time (gnc:date-option-absolute-time @@ -181,6 +183,8 @@ balance at a given time")) (height (get-option gnc:pagename-display optname-plot-height)) (width (get-option gnc:pagename-display optname-plot-width)) + (work-done 0) + (work-to-do 0) (document (gnc:make-html-document)) (chart (gnc:make-html-piechart)) (topl-accounts (gnc:filter-accountlist-type @@ -230,6 +234,17 @@ balance at a given time")) c report-currency exchange-fn)))) + (define (count-accounts current-depth accts) + (if (< current-depth tree-depth) + (let ((sum 0)) + (for-each + (lambda (a) + (set! sum (+ sum (+ 1 (count-accounts (+ 1 current-depth) + (gnc:account-get-immediate-subaccounts a)))))) + accts) + sum) + (length (filter show-acct? accts)))) + ;; Calculates all account's balances. Returns a list of ;; balance <=> account pairs, like '((10.0 Earnings) (142.5 ;; Gifts)). If current-depth >= tree-depth, then the balances @@ -246,6 +261,8 @@ balance at a given time")) (for-each (lambda (a) (begin + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 100 (/ work-done work-to-do))) (if (show-acct? a) (set! res (cons (list (collector->double (profit-fn a #f)) a) @@ -259,6 +276,8 @@ balance at a given time")) res) (map (lambda (a) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 100 (/ work-done work-to-do))) (list (collector->double (profit-fn a #t)) a)) (filter show-acct? accts)))) @@ -273,6 +292,7 @@ balance at a given time")) (if (not (null? accounts)) (begin + (set! work-to-do (count-accounts 1 topl-accounts)) (set! combined (sort (filter (lambda (pair) (not (>= 0.0 (car pair)))) (fix-signs @@ -407,6 +427,7 @@ balance at a given time")) (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) + (gnc:report-finished) document))) (for-each diff --git a/src/report/standard-reports/account-summary.scm b/src/report/standard-reports/account-summary.scm index 75d7a41e9f..e297ee1942 100644 --- a/src/report/standard-reports/account-summary.scm +++ b/src/report/standard-reports/account-summary.scm @@ -38,7 +38,9 @@ ;; prints a table of account information with clickable ;; links to open the corresponding register window. -;; first define all option's names such that typos etc. are no longer +(define reportname (N_ "Account Summary")) + +;; define all option's names such that typos etc. are no longer ;; possible. (define optname-date (N_ "Date")) (define optname-display-depth (N_ "Account Display Depth")) @@ -134,6 +136,7 @@ (gnc:lookup-option (gnc:report-options report-obj) pagename optname))) + (gnc:report-starting reportname) (let ((display-depth (get-option gnc:pagename-accounts optname-display-depth )) (show-subaccts? (get-option gnc:pagename-accounts @@ -175,19 +178,27 @@ (gnc:get-current-group-depth) display-depth) (if do-grouping? 1 0))) - (exchange-fn (gnc:case-exchange-fn + (exchange-fn #f) + (table #f)) + + (gnc:report-percent-done 2) + (set! exchange-fn (gnc:case-exchange-fn price-source report-currency date-tp)) - ;; do the processing here - (table (gnc:html-build-acct-table + (gnc:report-percent-done 10) + + ;; do the processing here + (set! table (gnc:html-build-acct-table #f date-tp tree-depth show-subaccts? accounts + 10 80 #t #t gnc:accounts-get-comm-total-assets (_ "Total") do-grouping? show-parent-balance? show-parent-total? - show-fcur? report-currency exchange-fn #t))) + show-fcur? report-currency exchange-fn #t)) ;; add the table + (gnc:report-percent-done 90) (gnc:html-document-add-object! doc table) ;; add currency information @@ -208,10 +219,11 @@ (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) + (gnc:report-finished) doc)) (gnc:define-report 'version 1 - 'name (N_ "Account Summary") + 'name reportname 'options-generator accsum-options-generator 'renderer accsum-renderer) diff --git a/src/report/standard-reports/advanced-portfolio.scm b/src/report/standard-reports/advanced-portfolio.scm index 1a53ce2c6e..8bfd47895b 100644 --- a/src/report/standard-reports/advanced-portfolio.scm +++ b/src/report/standard-reports/advanced-portfolio.scm @@ -36,6 +36,8 @@ (gnc:module-load "gnucash/report/report-system" 0) +(define reportname (N_ "Advanced Portfolio")) + (define optname-price-source (N_ "Price Source")) (define optname-zero-shares (N_ "Include accounts with no shares")) @@ -91,6 +93,9 @@ ;; defined above. (define (advanced-portfolio-renderer report-obj) + (let ((work-done 0) + (work-to-do 0)) + ;; These are some helper functions for looking up option values. (define (get-op section name) (gnc:lookup-option (gnc:report-options report-obj) section name)) @@ -106,7 +111,9 @@ (string=? (gnc:split-get-guid s1) (gnc:split-get-guid s2))) (define (table-add-stock-rows table accounts to-date - currency price-fn include-empty total-value total-moneyin total-moneyout total-gain) + currency price-fn include-empty + total-value total-moneyin total-moneyout + total-gain) (define (table-add-stock-rows-internal accounts odd-row?) (if (null? accounts) total-value @@ -145,6 +152,8 @@ ;; (gnc:debug "---" name "---") (for-each (lambda (split) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 100 (/ work-done work-to-do))) (let ((parent (gnc:split-get-parent split))) (if (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date) (for-each @@ -230,8 +239,12 @@ ) (table-add-stock-rows-internal rest odd-row?))))) + (set! work-to-do (gnc:accounts-count-splits accounts)) (table-add-stock-rows-internal accounts #t)) + ;; Tell the user that we're starting. + (gnc:report-starting reportname) + ;; The first thing we do is make local variables for all the specific ;; options in the set of options given to the function. This set will ;; be generated by the options generator above. @@ -362,11 +375,12 @@ (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) - document)) + (gnc:report-finished) + document))) (gnc:define-report 'version 1 - 'name (N_ "Advanced Portfolio") + 'name reportname 'menu-path (list gnc:menuname-asset-liability) 'options-generator options-generator 'renderer advanced-portfolio-renderer) diff --git a/src/report/standard-reports/average-balance.scm b/src/report/standard-reports/average-balance.scm index 7f4d303e85..51872fcf4b 100644 --- a/src/report/standard-reports/average-balance.scm +++ b/src/report/standard-reports/average-balance.scm @@ -15,6 +15,8 @@ (use-modules (gnucash gnc-module)) (gnc:module-load "gnucash/report/report-system" 0) +(define reportname (N_ "Average Balance")) + (define optname-from-date (N_ "From")) (define optname-to-date (N_ "To")) (define optname-stepsize (N_ "Step Size")) @@ -261,6 +263,7 @@ (gnc:option-value (gnc:lookup-option (gnc:report-options report-obj) section name))) + (gnc:report-starting reportname) (let* ((report-title (get-option gnc:pagename-general gnc:optname-reportname)) (begindate (gnc:timepair-start-day-time @@ -284,14 +287,8 @@ (document (gnc:make-html-document)) - (commodity-list (gnc:accounts-get-commodities - (append - (gnc:acccounts-get-all-subaccounts accounts) - accounts) - report-currency)) - (exchange-fn (gnc:case-exchange-time-fn - price-source report-currency - commodity-list enddate)) + (commodity-list #f) + (exchange-fn #f) (beforebegindate (gnc:timepair-end-day-time (gnc:timepair-previous-day begindate))) @@ -318,6 +315,26 @@ (splits '()) (data '())) + ;; The percentage done numbers here are a hack so that + ;; something gets displayed. On my system the + ;; gnc:case-exchange-time-fn takes about 20% of the time + ;; building up a list of prices for later use. Either this + ;; routine needs to send progress reports, or the price + ;; lookup should be distributed and done when actually + ;; needed so as to amortize the cpu time properly. + (gnc:report-percent-done 1) + (set! commodity-list (gnc:accounts-get-commodities + (append + (gnc:acccounts-get-all-subaccounts accounts) + accounts) + report-currency)) + (gnc:report-percent-done 5) + (set! exchange-fn (gnc:case-exchange-time-fn + price-source report-currency + commodity-list enddate + 5 20)) + (gnc:report-percent-done 20) + ;; initialize the query to find splits in the right ;; date range and accounts (gnc:query-set-book query (gnc:get-current-book)) @@ -327,6 +344,7 @@ (gnc:query-set-match-non-voids-only! query (gnc:get-current-book)) ;; add accounts to the query (include subaccounts ;; if requested) + (gnc:report-percent-done 25) (if dosubs? (let ((subaccts '())) (for-each @@ -342,6 +360,7 @@ ;; then use a linear algorithm. (set! accounts (delete-duplicates (append accounts subaccts))))) + (gnc:report-percent-done 30) (gnc:query-add-account-match query accounts 'guid-match-any 'query-and) @@ -355,6 +374,7 @@ ;; get the query results (set! splits (gnc:query-get-splits query)) + (gnc:report-percent-done 40) ;; find the net starting balance for the set of accounts (set! startbal @@ -363,6 +383,7 @@ (lambda (acct) (gnc:account-get-comm-balance-at-date acct beforebegindate #f)) gnc:account-reverse-balance?)) + (gnc:report-percent-done 50) (set! startbal (gnc:numeric-to-double @@ -372,11 +393,13 @@ report-currency (lambda (a b) (exchange-fn a b beforebegindate)))))) - + (gnc:report-percent-done 60) + ;; and analyze the data (set! data (analyze-splits splits startbal begindate enddate stepsize monetary->double)) + (gnc:report-percent-done 70) ;; make a plot (optionally)... if both plot and table, ;; plot comes first. @@ -473,6 +496,7 @@ report-title (gnc:report-id report-obj)))))) ;; make a table (optionally) + (gnc:report-percent-done 80) (if show-table? (let ((table (gnc:make-html-table))) (gnc:html-table-set-col-headers! @@ -497,11 +521,12 @@ document (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) + (gnc:report-finished) document)) (gnc:define-report 'version 1 - 'name (N_ "Average Balance") + 'name reportname 'menu-path (list gnc:menuname-asset-liability) 'options-generator options-generator 'renderer renderer) diff --git a/src/report/standard-reports/balance-sheet.scm b/src/report/standard-reports/balance-sheet.scm index c6dabe88c1..0db0c98456 100644 --- a/src/report/standard-reports/balance-sheet.scm +++ b/src/report/standard-reports/balance-sheet.scm @@ -34,7 +34,9 @@ (gnc:module-load "gnucash/report/report-system" 0) -;; first define all option's names so that they are properly defined +(define reportname (N_ "Balance Sheet")) + +;; define all option's names so that they are properly defined ;; in *one* place. (define optname-to-date (N_ "To")) @@ -143,6 +145,8 @@ (gnc:lookup-option (gnc:report-options report-obj) pagename optname))) + (gnc:report-starting reportname) + ;; get all option's values (let* ((display-depth (get-option gnc:pagename-accounts optname-display-depth)) @@ -185,11 +189,8 @@ (gnc:get-current-group-depth) display-depth)) ;; calculate the exchange rates - (exchange-fn (gnc:case-exchange-fn - price-source report-currency to-date-tp)) - (totals-get-balance (lambda (account) - (gnc:account-get-comm-balance-at-date - account to-date-tp #f)))) + (exchange-fn #f) + (totals-get-balance #f)) ;; Wrapper to call the right html-utility function. (define (add-subtotal-line table label balance) @@ -213,51 +214,89 @@ (if (not (null? accounts)) ;; Get all the balances for each account group. - (let* ((asset-balance + (let* ((asset-balance #f) + (liability-balance #f) + (equity-balance #f) + (sign-reversed-liability-balance #f) + (neg-retained-profit-balance #f) + (retained-profit-balance #f) + (total-equity-balance #f) + (equity-plus-liability #f) + (unrealized-gain-collector #f) + + ;; Create the account tables below where their + ;; percentage time can be tracked. + (asset-table #f) + (liability-table #f) + (equity-table #f)) + + (gnc:report-percent-done 2) + (set! totals-get-balance (lambda (account) + (gnc:account-get-comm-balance-at-date + account to-date-tp #f))) + (gnc:report-percent-done 4) + (set! asset-balance (gnc:accounts-get-comm-total-assets asset-accounts totals-get-balance)) - (liability-balance + (gnc:report-percent-done 6) + (set! liability-balance (gnc:accounts-get-comm-total-assets liability-accounts totals-get-balance)) - (equity-balance + (gnc:report-percent-done 8) + (set! equity-balance (gnc:accounts-get-comm-total-assets equity-accounts totals-get-balance)) - (sign-reversed-liability-balance + (gnc:report-percent-done 10) + (set! sign-reversed-liability-balance (gnc:make-commodity-collector)) - (neg-retained-profit-balance + (gnc:report-percent-done 12) + (set! neg-retained-profit-balance (accountlist-get-comm-balance-at-date income-expense-accounts to-date-tp)) - (retained-profit-balance (gnc:make-commodity-collector)) - (total-equity-balance (gnc:make-commodity-collector)) - (equity-plus-liability (gnc:make-commodity-collector)) - (unrealized-gain-collector (gnc:make-commodity-collector)) + (gnc:report-percent-done 14) + (set! retained-profit-balance (gnc:make-commodity-collector)) + (gnc:report-percent-done 16) + (set! total-equity-balance (gnc:make-commodity-collector)) + (gnc:report-percent-done 18) + (set! equity-plus-liability (gnc:make-commodity-collector)) + (set! unrealized-gain-collector (gnc:make-commodity-collector)) - ;; Create the account tables here. - (asset-table + (gnc:report-percent-done 20) + (set! exchange-fn (gnc:case-exchange-fn + price-source report-currency to-date-tp)) + (gnc:report-percent-done 30) + + ;;; Arbitrarily declare that the building of these tables + ;;; takes 50% of the total amount of time spent building + ;;; this report. (from 30%-80%) + (set! asset-table (gnc:html-build-acct-table #f to-date-tp tree-depth show-subaccts? asset-accounts + 30 20 #f #f #f #f #f show-parent-balance? show-parent-total? show-fcur? report-currency exchange-fn #t)) - (liability-table + (set! liability-table (gnc:html-build-acct-table #f to-date-tp tree-depth show-subaccts? liability-accounts + 50 20 #f #f #f #f #f show-parent-balance? show-parent-total? show-fcur? report-currency exchange-fn #t)) - (equity-table + (set! equity-table (gnc:html-build-acct-table #f to-date-tp tree-depth show-subaccts? equity-accounts + 70 10 #f #f #f #f #f show-parent-balance? show-parent-total? - show-fcur? report-currency exchange-fn #t))) + show-fcur? report-currency exchange-fn #t)) (retained-profit-balance 'minusmerge neg-retained-profit-balance @@ -279,6 +318,7 @@ ;; Now concatenate the tables. This first prepend-row has ;; to be written out by hand -- we can't use the function ;; append-something because we have to prepend. + (gnc:report-percent-done 80) (gnc:html-table-prepend-row/markup! asset-table "primary-subheading" @@ -299,6 +339,7 @@ (gnc:html-table-append-ruler! asset-table (* (if show-fcur? 3 2) tree-depth)) + (gnc:report-percent-done 85) (add-subtotal-line asset-table (_ "Liabilities") #f) (html-table-merge asset-table liability-table) @@ -332,6 +373,8 @@ (gnc:html-table-append-ruler! asset-table (* (if show-fcur? 3 2) tree-depth)) + + (gnc:report-percent-done 88) (add-subtotal-line asset-table (_ "Equity") #f) (html-table-merge asset-table equity-table) @@ -347,11 +390,13 @@ (gnc:html-document-add-object! doc asset-table) ;; add currency information + (gnc:report-percent-done 90) (if show-rates? (gnc:html-document-add-object! doc ;;(gnc:html-markup-p (gnc:html-make-exchangerates - report-currency exchange-fn accounts)))) + report-currency exchange-fn accounts))) + (gnc:report-percent-done 100)) ;; error condition: no accounts specified @@ -360,11 +405,12 @@ doc (gnc:html-make-no-account-warning (_ "Balance Sheet") (gnc:report-id report-obj)))) + (gnc:report-finished) doc)) (gnc:define-report 'version 1 - 'name (N_ "Balance Sheet") + 'name reportname 'menu-path (list gnc:menuname-asset-liability) 'options-generator balance-sheet-options-generator 'renderer balance-sheet-renderer) diff --git a/src/report/standard-reports/cash-flow.scm b/src/report/standard-reports/cash-flow.scm index e32fde63b5..105be7bb0c 100644 --- a/src/report/standard-reports/cash-flow.scm +++ b/src/report/standard-reports/cash-flow.scm @@ -37,7 +37,9 @@ (gnc:module-load "gnucash/report/report-system" 0) (gnc:module-load "gnucash/gnome-utils" 0) ;for gnc:html-build-url -;; first define all option's names so that they are properly defined +(define reportname (N_ "Cash Flow")) + +;; define all option's names so that they are properly defined ;; in *one* place. (define optname-from-date (N_ "From")) (define optname-to-date (N_ "To")) @@ -101,9 +103,13 @@ (gnc:lookup-option (gnc:report-options report-obj) pagename optname))) + (gnc:report-starting reportname) + ;; get all option's values (let* ((accounts (get-option gnc:pagename-accounts optname-accounts)) + (work-done 0) + (work-to-do 0) (report-currency (get-option gnc:pagename-general optname-report-currency)) (price-source (get-option gnc:pagename-general @@ -162,7 +168,8 @@ (money-out-alist '()) (money-out-collector (gnc:make-commodity-collector)) - (money-diff-collector (gnc:make-commodity-collector))) + (money-diff-collector (gnc:make-commodity-collector)) + (splits-to-do (gnc:accounts-count-splits accounts))) ;; function to add inflow and outflow of money (define (calc-money-in-out accounts) @@ -179,6 +186,8 @@ (for-each (lambda (split) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 85 (/ work-done splits-to-do))) (let ((parent (gnc:split-get-parent split))) (if (and (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date-tp) (gnc:timepair-ge (gnc:transaction-get-date-posted parent) from-date-tp)) @@ -254,12 +263,16 @@ (money-diff-collector 'minusmerge money-out-collector #f) + (set! work-done 0) + (set! work-to-do (length accounts)) (gnc:html-document-add-object! doc (gnc:make-html-text (gnc:html-markup-ul (map (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=" @@ -278,8 +291,12 @@ (_ "Money In") "")) + (set! work-done 0) + (set! work-to-do (length money-in-alist)) (for-each (lambda (pair) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (+ 90 (* 5 (/ work-done work-to-do)))) (gnc:html-table-append-row/markup! table "normal-row" @@ -308,8 +325,12 @@ (_ "Money Out") "")) + (set! work-done 0) + (set! work-to-do (length money-out-alist)) (for-each (lambda (pair) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (+ 95 (* 5 (/ work-done work-to-do)))) (gnc:html-table-append-row/markup! table "normal-row" @@ -356,12 +377,14 @@ (gnc:html-document-add-object! doc (gnc:html-make-no-account-warning - (_ "Cash Flow") (gnc:report-id report-obj)))) + reportname (gnc:report-id report-obj)))) + + (gnc:report-finished) doc)) (gnc:define-report 'version 1 - 'name (N_ "Cash Flow") + 'name reportname 'menu-path (list gnc:menuname-income-expense) 'options-generator cash-flow-options-generator 'renderer cash-flow-renderer) diff --git a/src/report/standard-reports/category-barchart.scm b/src/report/standard-reports/category-barchart.scm index 580ce2b911..bfe56e39ad 100644 --- a/src/report/standard-reports/category-barchart.scm +++ b/src/report/standard-reports/category-barchart.scm @@ -168,6 +168,7 @@ developing over time")) (gnc:lookup-option (gnc:report-options report-obj) section name))) + (gnc:report-starting reportname) (let ((to-date-tp (gnc:timepair-end-day-time (gnc:date-option-absolute-time (get-option gnc:pagename-general @@ -193,6 +194,8 @@ developing over time")) (height (get-option gnc:pagename-display optname-plot-height)) (width (get-option gnc:pagename-display optname-plot-width)) + (work-done 0) + (work-to-do 0) (document (gnc:make-html-document)) (chart (gnc:make-html-barchart)) (topl-accounts (gnc:filter-accountlist-type @@ -205,19 +208,12 @@ developing over time")) (define (show-acct? a) (member a accounts)) - (gnc:debug accounts) + ;;(gnc:debug accounts) (if (not (null? accounts)) ;; Define more helper variables. - - (let* ((commodity-list (gnc:accounts-get-commodities - (append - (gnc:acccounts-get-all-subaccounts accounts) - accounts) - report-currency)) - (exchange-fn (gnc:case-exchange-time-fn - price-source report-currency - commodity-list to-date-tp)) + (let* ((commodity-list #f) + (exchange-fn #f) (tree-depth (if (equal? account-levels 'all) (gnc:get-current-group-depth) account-levels)) @@ -283,6 +279,17 @@ developing over time")) (lambda (d) (get-balance account d subacct?)) dates-list)) + (define (count-accounts current-depth accts) + (if (< current-depth tree-depth) + (let ((sum 0)) + (for-each + (lambda (a) + (set! sum (+ sum (+ 1 (count-accounts (+ 1 current-depth) + (gnc:account-get-immediate-subaccounts a)))))) + accts) + sum) + (length (filter show-acct? accts)))) + ;; Calculates all account's balances. Returns a list of pairs: ;; ( ), like '((Earnings (10.0 11.2)) ;; (Gifts (12.3 14.5))), where each element of @@ -303,6 +310,8 @@ developing over time")) (for-each (lambda (a) (begin + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do)))) (if (show-acct? a) (set! res (cons (list a (account->balance-list a #f)) @@ -317,9 +326,30 @@ developing over time")) ;; else (i.e. current-depth == tree-depth) (map (lambda (a) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do)))) (list a (account->balance-list a #t))) (filter show-acct? accts)))) - + + ;; The percentage done numbers here are a hack so that + ;; something gets displayed. On my system the + ;; gnc:case-exchange-time-fn takes about 20% of the time + ;; building up a list of prices for later use. Either this + ;; routine needs to send progress reports, or the price + ;; lookup should be distributed and done when actually + ;; needed so as to amortize the cpu time properly. + (gnc:report-percent-done 1) + (set! commodity-list (gnc:accounts-get-commodities + (append + (gnc:acccounts-get-all-subaccounts accounts) + accounts) + report-currency)) + (set! exchange-fn (gnc:case-exchange-time-fn + price-source report-currency + commodity-list to-date-tp + 5 15)) + (set! work-to-do (count-accounts 1 topl-accounts)) + ;; Sort the account list according to the account code field. (set! all-data (sort (filter (lambda (l) @@ -396,12 +426,14 @@ developing over time")) ;; This adds the data. Note the apply-zip stuff: This ;; transposes the data, i.e. swaps rows and columns. Pretty ;; cool, eh? Courtesy of dave_p. + (gnc:report-percent-done 92) (if (not (null? all-data)) (gnc:html-barchart-set-data! chart (apply zip (map cadr all-data)))) ;; Labels and colors + (gnc:report-percent-done 94) (gnc:html-barchart-set-col-labels! chart (map (lambda (pair) (if (string? (car pair)) @@ -415,6 +447,7 @@ developing over time")) (gnc:assign-colors (length all-data))) ;; set the URLs; the slices are links to other reports + (gnc:report-percent-done 96) (let ((urls (map @@ -453,6 +486,7 @@ developing over time")) (gnc:html-barchart-set-button-1-legend-urls! chart (append urls urls))) + (gnc:report-percent-done 98) (gnc:html-document-add-object! document chart)) ;; else if empty data @@ -467,6 +501,7 @@ developing over time")) (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) + (gnc:report-finished) document)) (for-each diff --git a/src/report/standard-reports/net-barchart.scm b/src/report/standard-reports/net-barchart.scm index 3d80054af8..3bd799de4e 100644 --- a/src/report/standard-reports/net-barchart.scm +++ b/src/report/standard-reports/net-barchart.scm @@ -35,6 +35,8 @@ (gnc:module-load "gnucash/report/report-system" 0) +(define reportname (N_ "Income/Expense Chart")) + (define optname-from-date (N_ "From")) (define optname-to-date (N_ "To")) (define optname-stepsize (N_ "Step Size")) @@ -139,6 +141,7 @@ (gnc:option-value (gnc:lookup-option (gnc:report-options report-obj) section name))) + (gnc:report-starting reportname) (let* ((to-date-tp (gnc:timepair-end-day-time (gnc:date-option-absolute-time (get-option gnc:pagename-general @@ -164,14 +167,8 @@ (height (get-option gnc:pagename-display optname-plot-height)) (width (get-option gnc:pagename-display optname-plot-width)) - (commodity-list (gnc:accounts-get-commodities - (append - (gnc:acccounts-get-all-subaccounts accounts) - accounts) - report-currency)) - (exchange-fn (gnc:case-exchange-time-fn - price-source report-currency - commodity-list to-date-tp)) + (commodity-list #f) + (exchange-fn #f) (dates-list ((if inc-exp? gnc:make-date-interval-list gnc:make-date-list) @@ -228,22 +225,24 @@ (if inc-exp? (second date) date))) dates)) + (gnc:report-percent-done 1) + (set! commodity-list (gnc:accounts-get-commodities + (append + (gnc:acccounts-get-all-subaccounts accounts) + accounts) + report-currency)) + (gnc:report-percent-done 10) + (set! exchange-fn (gnc:case-exchange-time-fn + price-source report-currency + commodity-list to-date-tp + 10 40)) + (gnc:report-percent-done 50) + (if (not (null? accounts)) - (let* ((assets-list - (process-datelist - (if inc-exp? - accounts - (assoc-ref classified-accounts 'asset)) - dates-list #t)) - (liability-list - (process-datelist - (if inc-exp? - accounts - (assoc-ref classified-accounts 'liability)) - dates-list #f)) - (net-list - (map + assets-list liability-list)) + (let* ((assets-list #f) + (liability-list #f) + (net-list #f) (date-string-list (map (if inc-exp? (lambda (date-list-item) @@ -252,6 +251,24 @@ gnc:print-date) dates-list))) + (set! assets-list + (process-datelist + (if inc-exp? + accounts + (assoc-ref classified-accounts 'asset)) + dates-list #t)) + (gnc:report-percent-done 70) + (set! liability-list + (process-datelist + (if inc-exp? + accounts + (assoc-ref classified-accounts 'liability)) + dates-list #f)) + (gnc:report-percent-done 80) + (set! net-list + (map + assets-list liability-list)) + (gnc:report-percent-done 90) + (gnc:html-barchart-set-title! chart report-title) (gnc:html-barchart-set-subtitle! @@ -351,6 +368,7 @@ (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) + (gnc:report-finished) document)) ;; Here we define the actual report @@ -363,7 +381,7 @@ (gnc:define-report 'version 1 - 'name (N_ "Income/Expense Chart") + 'name reportname 'menu-name (N_ "Income & Expense Chart") 'menu-path (list gnc:menuname-income-expense) 'options-generator (lambda () (options-generator #t)) diff --git a/src/report/standard-reports/pnl.scm b/src/report/standard-reports/pnl.scm index 66821702ed..66f050fcd5 100644 --- a/src/report/standard-reports/pnl.scm +++ b/src/report/standard-reports/pnl.scm @@ -37,7 +37,9 @@ ;; something different under this name, but they are welcomed to ;; contribute their changes :-) -;; first define all option's names so that they are properly defined +(define reportname (N_ "Profit And Loss")) + +;; define all option's names so that they are properly defined ;; in *one* place. (define optname-from-date (N_ "From")) (define optname-to-date (N_ "To")) @@ -129,6 +131,8 @@ (gnc:lookup-option (gnc:report-options report-obj) pagename optname))) + (gnc:report-starting reportname) + ;; get all option's values (let* ((display-depth (get-option gnc:pagename-accounts optname-display-depth)) @@ -174,18 +178,24 @@ (gnc:get-current-group-depth) display-depth) (if do-grouping? 1 0))) - ;; calculate the exchange rates - (exchange-fn (gnc:case-exchange-fn + + (exchange-fn #f) + (table #f)) + + ;; calculate the exchange rates + (gnc:report-percent-done 1) + (set! exchange-fn (gnc:case-exchange-fn price-source report-currency to-date-tp)) - ;; do the processing here - (table (gnc:html-build-acct-table + (gnc:report-percent-done 10) + + ;; do the processing here + (set! table (gnc:html-build-acct-table from-date-tp to-date-tp - tree-depth show-subaccts? accounts #f + tree-depth show-subaccts? accounts 10 80 #f #t gnc:accounts-get-comm-total-profit (_ "Profit") do-grouping? show-parent-balance? show-parent-total? - show-fcur? report-currency exchange-fn #t))) - + show-fcur? report-currency exchange-fn #t)) ;; add the table (gnc:html-document-add-object! doc table) @@ -199,7 +209,8 @@ (lambda (a) (gnc:group-get-subaccounts (gnc:account-get-children a))) - accounts))))) + accounts)))) + (gnc:report-percent-done 100)) ;; error condition: no accounts specified @@ -207,11 +218,12 @@ doc (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) + (gnc:report-finished) doc)) (gnc:define-report 'version 1 - 'name (N_ "Profit And Loss") + 'name reportname 'menu-name (N_ "Profit & Loss") 'menu-path (list gnc:menuname-income-expense) 'options-generator pnl-options-generator diff --git a/src/report/standard-reports/portfolio.scm b/src/report/standard-reports/portfolio.scm index 8444838438..10b01b4cce 100644 --- a/src/report/standard-reports/portfolio.scm +++ b/src/report/standard-reports/portfolio.scm @@ -32,6 +32,8 @@ (gnc:module-load "gnucash/report/report-system" 0) +(define reportname (N_ "Investment Portfolio")) + (define optname-price-source (N_ "Price Source")) (define optname-zero-shares (N_ "Include accounts with no shares")) @@ -86,6 +88,9 @@ ;; to the function is one created by the options-generator function ;; defined above. (define (portfolio-renderer report-obj) + + (let ((work-done 0) + (work-to-do 0)) ;; These are some helper functions for looking up option values. (define (get-op section name) @@ -118,6 +123,9 @@ GNC-RND-ROUND)) (value (gnc:make-gnc-monetary currency value-num))) + + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 100 (/ work-done work-to-do))) (if (or include-empty (not (gnc:numeric-zero-p units))) (begin (collector 'add currency value-num) (gnc:html-table-append-row/markup! @@ -139,8 +147,12 @@ (table-add-stock-rows-internal rest (not odd-row?))) (table-add-stock-rows-internal rest odd-row?))))) + (set! work-to-do (length accounts)) (table-add-stock-rows-internal accounts #t)) + ;; Tell the user that we're starting. + (gnc:report-starting reportname) + ;; The first thing we do is make local variables for all the specific ;; options in the set of options given to the function. This set will ;; be generated by the options generator above. @@ -241,11 +253,12 @@ (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))) - document)) + (gnc:report-finished) + document))) (gnc:define-report 'version 1 - 'name (N_ "Investment Portfolio") + 'name reportname 'menu-path (list gnc:menuname-asset-liability) 'options-generator options-generator 'renderer portfolio-renderer)