From 71c0fe98d9ef5c68be497784a516aff8f6542f15 Mon Sep 17 00:00:00 2001 From: Christian Stimming Date: Wed, 28 Jan 2009 20:59:57 +0000 Subject: [PATCH] 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 | 11 ++++++ src/report/report-system/report-system.scm | 1 + .../standard-reports/budget-balance-sheet.scm | 37 +++++++++---------- .../standard-reports/budget-barchart.scm | 30 +++++++++------ src/report/standard-reports/budget-flow.scm | 28 ++++++++------ .../budget-income-statement.scm | 35 ++++++++---------- src/report/standard-reports/budget.scm | 25 ++++++++----- 7 files changed, 95 insertions(+), 72 deletions(-) diff --git a/src/report/report-system/html-utilities.scm b/src/report/report-system/html-utilities.scm index 2a12b367d2..d9dfce02f9 100644 --- a/src/report/report-system/html-utilities.scm +++ b/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? diff --git a/src/report/report-system/report-system.scm b/src/report/report-system/report-system.scm index a8f061d080..5c36035399 100644 --- a/src/report/report-system/report-system.scm +++ b/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) diff --git a/src/report/standard-reports/budget-balance-sheet.scm b/src/report/standard-reports/budget-balance-sheet.scm index 9f6d2b3b38..2bab0be4b9 100644 --- a/src/report/standard-reports/budget-balance-sheet.scm +++ b/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) - (gnc:html-document-set-title! - doc (string-append company-name " " report-title " " - (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.... + (cond + ((null? accounts) + ;; No accounts selected. (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 diff --git a/src/report/standard-reports/budget-barchart.scm b/src/report/standard-reports/budget-barchart.scm index a2caa14170..b9e3bc9ece 100644 --- a/src/report/standard-reports/budget-barchart.scm +++ b/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) - ;; No accounts selected - (gnc:html-document-add-object! - document - (gnc:html-make-no-account-warning - report-title (gnc:report-id report-obj))) + (cond + ((null? accounts) + ;; No accounts selected + (gnc:html-document-add-object! + document + (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))) - ) - accounts - ) - ) + (gnc:chart-create-budget-actual budget acct running-sum)))) + accounts)) + ) ;; end cond document )) diff --git a/src/report/standard-reports/budget-flow.scm b/src/report/standard-reports/budget-flow.scm index 9eb1925c10..d967a18d66 100644 --- a/src/report/standard-reports/budget-flow.scm +++ b/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 - (if (not (or (null? accounts) (null? budget) (not budget))) - (let* ( + (cond + ((null? accounts) + ;; 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) - ) - - ;; 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:html-document-add-object! doc html-table))))) ;; Update progress bar (gnc:report-finished) diff --git a/src/report/standard-reports/budget-income-statement.scm b/src/report/standard-reports/budget-income-statement.scm index ea46a3c3c8..29188f023d 100644 --- a/src/report/standard-reports/budget-income-statement.scm +++ b/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! - doc (sprintf #f "%s %s %s" company-name report-title budget-name)) - - (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.... + (cond + ((null? accounts) + ;; No accounts selected. (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")) diff --git a/src/report/standard-reports/budget.scm b/src/report/standard-reports/budget.scm index 1d7d73b09b..f5bfcbc8bd 100644 --- a/src/report/standard-reports/budget.scm +++ b/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) - ) - - ;; 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:html-document-add-object! doc html-table)))) + ) ;; end cond (gnc:report-finished) doc))