Provide progress updates while creating reports. #94280

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7560 57a11ea4-9604-0410-9ed3-97b8803252fd

ChangeLog

@@ -1,3 +1,17 @@
+2002-11-26  David Hampton  <hampton@employees.org>
+
+	* 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  <derek@ihtfp.com>
 
 	* src/engine/QueryCore.c -- make sure we have a string

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)

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

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

src/gnome-utils/gw-gnome-utils-spec.scm

@@ -35,6 +35,7 @@
       "#include <dialog-options.h>\n"
       "#include <dialog-utils.h>\n"
       "#include <druid-utils.h>\n"
+      "#include <gtk/gtk.h>\n"
       "#include <gnc-amount-edit.h>\n"
       "#include <gnc-date-edit.h>\n"
       "#include <gnc-gnome-utils.h>\n"
@@ -66,6 +67,7 @@
    '()
    "Shutdown the GnuCash gnome system.")
 
+  (gw:wrap-as-wct ws '<gtk:Widget*> "GtkWidget*" "const GtkWidget*")
   (gw:wrap-as-wct ws '<gnc:UIWidget> "gncUIWidget" "const gncUIWidget")
   (gw:wrap-as-wct ws '<gnc:mdi-info*> "GNCMDIInfo*" "const GNCMDIInfo*")
   (gw:wrap-as-wct ws '<gnc:OptionWin*> "GNCOptionWin*" "const GNCOptionWin*")
@@ -466,4 +468,23 @@ be left empty")
    '(((<gw:mchars> caller-owned const) message)
      (<gw:int> percentage))
    "Autosize the columns of a clist including the titles.")
+
+  (gw:wrap-function
+   ws
+   'gnc:set_busy_cursor
+   '<gw:void>
+   "gnc_set_busy_cursor"
+   '((<gtk:Widget*> window)
+     (<gw:bool> 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
+   '<gw:void>
+   "gnc_unset_busy_cursor"
+   '((<gtk:Widget*> window))
+   "Remove a busy cursor for a specific window. If null, the busy cursor will be removed on all windows.")
 )
+
+

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!.
+;;
+;; <int> 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))))

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.
 ;;
+;; <int> 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 

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)))

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))))
+                                (gnc:report-type report)))
-        (if template
+	    (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 

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 

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))
+	  (gnc:report-percent-done 10)
+
 	  ;; do the processing here
-               (table (gnc:html-build-acct-table 
+	  (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)

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)

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 
+	 (commodity-list #f)
-                          (append 
+	 (exchange-fn #f)
-                           (gnc:acccounts-get-all-subaccounts accounts)
-                           accounts)
-                          report-currency))
-         (exchange-fn (gnc:case-exchange-time-fn 
-                       price-source report-currency 
-                       commodity-list enddate))
 
          (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)

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 
+         (exchange-fn #f)
-                       price-source report-currency to-date-tp))
+         (totals-get-balance #f))
-         (totals-get-balance (lambda (account)
-                               (gnc:account-get-comm-balance-at-date 
-                                account to-date-tp #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))
+	  (gnc:report-percent-done 14)
-               (total-equity-balance (gnc:make-commodity-collector))
+	  (set! retained-profit-balance (gnc:make-commodity-collector))
-               (equity-plus-liability (gnc:make-commodity-collector))
+	  (gnc:report-percent-done 16)
-               (unrealized-gain-collector (gnc:make-commodity-collector))
+	  (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.
+	  (gnc:report-percent-done 20)
-               (asset-table 
+	  (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)

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)

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 #f)
-        (let* ((commodity-list (gnc:accounts-get-commodities 
+               (exchange-fn #f)
-                                (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))
                (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:
           ;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
           ;; (Gifts (12.3 14.5))), where each element of <balance-list>
@@ -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 

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 
+         (commodity-list #f)
-                          (append 
+         (exchange-fn #f)
-                           (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))
 
          (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
+     (let* ((assets-list #f)
-             (process-datelist
+            (liability-list #f)
-              (if inc-exp? 
+            (net-list #f)
-                  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))
             (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))

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)))
+
+               (exchange-fn #f)
+               (table #f))
+
 	  ;; calculate the exchange rates
-               (exchange-fn (gnc:case-exchange-fn
+	  (gnc:report-percent-done 1)
+	  (set! exchange-fn (gnc:case-exchange-fn
                              price-source report-currency to-date-tp))
+	  (gnc:report-percent-done 10)
+
 	  ;; do the processing here
-               (table (gnc:html-build-acct-table 
+	  (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

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"))
 
@@ -87,6 +89,9 @@
 ;; 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)
     (gnc:lookup-option (gnc:report-options report-obj) 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)