Bug #568327: Budget reports without a budget will crash

Fixes crashes and also improves error message when no budgets exists (for all
budget reports).

Patch by Forest Bond.
BP

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

src/report/report-system/html-utilities.scm

@@ -785,6 +785,17 @@
     table))
 
 
+(define (gnc:html-make-generic-budget-warning report-title-string)
+  (let ((p (gnc:make-html-text)))
+    (gnc:html-text-append!
+     p
+     (gnc:html-markup-h2 (string-append (_ report-title-string) ":"))
+     (gnc:html-markup-h2 "")
+     (gnc:html-markup-p
+       (_ "No budgets exist.  You must create at least one budget.")))
+    p))
+
+
 ;; TODO: How 'bout factoring the "Edit report options" stuff out of
 ;; these 3 functions?
 

src/report/report-system/report-system.scm

@@ -90,6 +90,7 @@
 (export gnc:first-html-build-acct-table)
 (export gnc:html-make-exchangerates)
 (export gnc:html-make-no-account-warning)
+(export gnc:html-make-generic-budget-warning)
 (export gnc:html-make-generic-options-warning)
 (export gnc:html-make-empty-data-warning)
 

src/report/standard-reports/budget-balance-sheet.scm

@@ -311,7 +311,8 @@
 	 (report-title (get-option gnc:pagename-general optname-report-title))
 	 (company-name (get-option gnc:pagename-general optname-party-name))
          (budget (get-option gnc:pagename-general optname-budget))
-         (date-tp (gnc:budget-get-start-date budget))
+         (budget-valid? (and budget (not (null? budget))))
+         (date-tp (if budget-valid? (gnc:budget-get-start-date budget) #f))
          (report-form? (get-option gnc:pagename-general
                                optname-report-form))
          (accounts (get-option gnc:pagename-accounts
@@ -381,7 +382,6 @@
          ;; exchange rates calculation parameters
 	 (exchange-fn
 	  (gnc:case-exchange-fn price-source report-commodity date-tp))
-
 	 )
     
     ;; Wrapper to call gnc:html-table-add-labeled-amount-line!
@@ -423,23 +423,18 @@
        (+ (* 2 tree-depth)
 	  (if (equal? tabbing 'canonically-tabbed) 1 0))))
 
-    ;;(gnc:warn "account names" liability-account-names)
+    (cond
-    (gnc:html-document-set-title! 
+      ((null? accounts)
-     doc (string-append company-name " " report-title " "
+        ;; No accounts selected.
-                        (gnc-budget-get-name budget))
-     )
-    
-    (if (null? accounts)
-	
-        ;; error condition: no accounts specified
-	;; is this *really* necessary??
-	;; i'd be fine with an all-zero balance sheet
-	;; that would, technically, be correct....
         (gnc:html-document-add-object! 
          doc 
          (gnc:html-make-no-account-warning 
-	  reportname (gnc:report-id report-obj)))
+	  reportname (gnc:report-id report-obj))))
-	
+      ((not budget-valid?)
+        ;; No budget selected.
+        (gnc:html-document-add-object!
+          doc (gnc:html-make-generic-budget-warning reportname)))
+      (else (begin
         ;; Get all the balances for each of the account types.
         (let* ((asset-balance #f)
                (asset-account-initial-balances #f)
@@ -485,6 +480,8 @@
 	       (left-table (gnc:make-html-table)) ;; gnc:html-table
 	       (right-table (if report-form? left-table
 				(gnc:make-html-table)))
+
+               (budget-name (gnc-budget-get-name budget))
 	       )
 	  
 
@@ -710,6 +707,8 @@
 
 	  (gnc:report-percent-done 30)
 	  
+          (gnc:html-document-set-title! 
+            doc (string-append company-name " " report-title " " budget-name))
 
 	  (set! table-env
 		(list
@@ -917,13 +916,11 @@
 		)
 	      )
 	  )
-	)
+	))) ;; end cond
     
     (gnc:report-finished)
     
-    doc
+    doc))
-    )
-  )
 
 (gnc:define-report 
  'version 1

src/report/standard-reports/budget-barchart.scm

@@ -177,28 +177,34 @@
 
   (let* (
       (budget (get-option gnc:pagename-general optname-budget))
+      (budget-valid? (and budget (not (null? budget))))
       (running-sum (get-option gnc:pagename-general optname-running-sum))
       (accounts (get-option gnc:pagename-accounts optname-accounts))
       (report-title (get-option gnc:pagename-general
         gnc:optname-reportname))
       (document (gnc:make-html-document))
     )
-    (if (null? accounts)
+    (cond
-      ;; No accounts selected
+      ((null? accounts)
-      (gnc:html-document-add-object!
+        ;; No accounts selected
-        document
+        (gnc:html-document-add-object!
-          (gnc:html-make-no-account-warning 
+          document
-            report-title (gnc:report-id report-obj)))
+            (gnc:html-make-no-account-warning 
+              report-title (gnc:report-id report-obj))))
+
+      ((not budget-valid?)
+        ;; No budget selected.
+        (gnc:html-document-add-object!
+          document (gnc:html-make-generic-budget-warning reportname)))
 
       ;; Else create chart for each account
-      (for-each (lambda (acct)
+      (else
+        (for-each (lambda (acct)
           (if (null? (gnc-account-get-descendants acct))
             (gnc:html-document-add-object! document
-              (gnc:chart-create-budget-actual budget acct running-sum)))
+              (gnc:chart-create-budget-actual budget acct running-sum))))
-        )
+          accounts))
-        accounts
+    ) ;; end cond
-      )
-    )
     
     document
 ))

src/report/standard-reports/budget-flow.scm

@@ -266,6 +266,7 @@
   ;; get all option's values
   (let* (
       (budget (get-option gnc:pagename-general optname-budget))
+      (budget-valid? (and budget (not (null? budget))))
       (accounts (get-option gnc:pagename-accounts optname-accounts))
       (period (inexact->exact (get-option gnc:pagename-general
         optname-periods)))
@@ -282,9 +283,21 @@
       (doc (gnc:make-html-document))
     )
 
-    ;; If no account are select show a warring page    
+    (cond
-    (if (not (or (null? accounts) (null? budget) (not budget)))
+      ((null? accounts)
-      (let* (
+        ;; No accounts selected
+        (gnc:html-document-add-object!
+          doc
+            (gnc:html-make-no-account-warning 
+              report-title (gnc:report-id report-obj))))
+
+      ((not budget-valid?)
+        ;; No budget selected.
+        (gnc:html-document-add-object!
+          doc (gnc:html-make-generic-budget-warning reportname)))
+
+      (else (begin
+        (let* (
           (html-table (gnc:make-html-table))
           (report-name (get-option gnc:pagename-general
             gnc:optname-reportname))
@@ -306,14 +319,7 @@
         (gnc:html-table-add-budget-totals! html-table accounts-totals exchange-fn report-currency)
 
         ;; Display table
-        (gnc:html-document-add-object! doc html-table)
+        (gnc:html-document-add-object! doc html-table)))))
-      )
-
-      ;; error condition: either no accounts or no budgets specified
-      (gnc:html-document-add-object!
-        doc (gnc:html-make-generic-options-warning
-	  reportname (gnc:report-id report-obj)))
-    )
 
     ;; Update progress bar
     (gnc:report-finished)

src/report/standard-reports/budget-income-statement.scm

@@ -266,7 +266,8 @@
 	 (report-title (get-option gnc:pagename-general optname-report-title))
 	 (company-name (get-option gnc:pagename-general optname-party-name))
          (budget (get-option gnc:pagename-general optname-budget))
-         (date-tp (gnc:budget-get-start-date budget))
+         (budget-valid? (and budget (not (null? budget))))
+         (date-tp (if budget-valid? (gnc:budget-get-start-date budget) #f))
          (accounts (get-option gnc:pagename-accounts
                                optname-accounts))	 
 	 (depth-limit (get-option gnc:pagename-accounts 
@@ -328,8 +329,6 @@
          ;; exchange rates calculation parameters
 	 (exchange-fn
 	  (gnc:case-exchange-fn price-source report-commodity date-tp))
-
-         (budget-name (gnc-budget-get-name budget))
 	 )
     
     ;; Wrapper to call gnc:html-table-add-labeled-amount-line!
@@ -370,20 +369,18 @@
        (+ (* 2 tree-depth)
 	  (if (equal? tabbing 'canonically-tabbed) 1 0))))
     
-    (gnc:html-document-set-title! 
+    (cond
-     doc (sprintf #f "%s %s %s" company-name report-title budget-name))
+      ((null? accounts)
-    
+        ;; No accounts selected.
-    (if (null? accounts)
-	
-        ;; error condition: no accounts specified
-	;; is this *really* necessary??
-	;; i'd be fine with an all-zero P&L
-	;; that would, technically, be correct....
         (gnc:html-document-add-object! 
          doc 
          (gnc:html-make-no-account-warning 
-	  reportname (gnc:report-id report-obj)))
+	  reportname (gnc:report-id report-obj))))
-	
+      ((not budget-valid?)
+        ;; No budget selected.
+        (gnc:html-document-add-object!
+          doc (gnc:html-make-generic-budget-warning report-title)))
+      (else (begin
         ;; Get all the balances for each of the account types.
         (let* (
                (revenue-account-balances #f)
@@ -406,7 +403,7 @@
 	       (params #f)                         ;; and -add-account-
                (revenue-table #f)                  ;; gnc:html-acct-table
                (expense-table #f)                  ;; gnc:html-acct-table
-	       
+               (budget-name (gnc-budget-get-name budget))
 	       (period-for (string-append " " (_ "for Budget ") budget-name))
 	       )
 
@@ -499,6 +496,8 @@
 
 	  (gnc:report-percent-done 30)
 
+          (gnc:html-document-set-title! 
+            doc (sprintf #f "%s %s %s" company-name report-title budget-name))
 
 	  (set! table-env
 		(list
@@ -633,13 +632,11 @@
 	  (gnc:report-percent-done 100)
 	  
 	  )
-	)
+	))) ;; end cond
     
     (gnc:report-finished)
     
-    doc
+    doc))
-    )
-  )
 
 (define is-reportname (N_ "Budget Income Statement"))
 (define pnl-reportname (N_ "Budget Profit & Loss"))

src/report/standard-reports/budget.scm

@@ -293,6 +293,7 @@
 
   ;; get all option's values
   (let* ((budget (get-option gnc:pagename-general optname-budget))
+         (budget-valid? (and budget (not (null? budget))))
          (display-depth (get-option gnc:pagename-accounts
                                     optname-display-depth))
          (show-subaccts? (get-option gnc:pagename-accounts
@@ -363,8 +364,18 @@
                   (set! accounts (append accounts sub-accounts))))
             sub-accounts)))
 
-    (if (not (or (null? accounts) (null? budget) (not budget)))
+    (cond
-
+      ((null? accounts)
+        ;; No accounts selected.
+        (gnc:html-document-add-object! 
+         doc 
+         (gnc:html-make-no-account-warning 
+	  reportname (gnc:report-id report-obj))))
+      ((not budget-valid?)
+        ;; No budget selected.
+        (gnc:html-document-add-object!
+          doc (gnc:html-make-generic-budget-warning reportname)))
+      (else (begin
         (let* ((tree-depth (if (equal? display-depth 'all)
                                (accounts-get-children-depth accounts)
                                display-depth))
@@ -418,14 +429,8 @@
           ;; table width, since the add-account-balance had put stuff
           ;; there, but it doesn't seem to matter.
 
-          (gnc:html-document-add-object! doc html-table)
+          (gnc:html-document-add-object! doc html-table))))
-          )
+      ) ;; end cond
-
-        ;; error condition: either no accounts or no budgets specified
-        (gnc:html-document-add-object!
-         doc
-         (gnc:html-make-generic-options-warning
-	  reportname (gnc:report-id report-obj))))
 
     (gnc:report-finished)
     doc))