1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;; budget-income-statement.scm: income statement (a.k.a. Profit & Loss)
3;;
4;; Copyright (c) the following:
5;;
6;;  Forest Bond <forest@alittletooquiet.net>
7;;  David Montenegro <sunrise2000@comcast.net>
8;;
9;;  * BUGS:
10;;
11;;    The Company Name field does not currently default to the name
12;;    in (gnc-get-current-book).
13;;
14;;    Line & column alignments may still not conform with
15;;    textbook accounting practice (they're close though!).
16;;
17;;    Progress bar functionality is currently mostly broken.
18;;
19;;    The variables in this code could use more consistent naming.
20;;
21;;    See also all the "FIXME"s in the code.
22;;
23;; This program is free software; you can redistribute it and/or
24;; modify it under the terms of the GNU General Public License as
25;; published by the Free Software Foundation; either version 2 of
26;; the License, or (at your option) any later version.
27;;
28;; This program is distributed in the hope that it will be useful,
29;; but WITHOUT ANY WARRANTY; without even the implied warranty of
30;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
31;; GNU General Public License for more details.
32;;
33;; You should have received a copy of the GNU General Public License
34;; along with this program; if not, contact:
35;;
36;; Free Software Foundation           Voice:  +1-617-542-5942
37;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652
38;; Boston, MA  02110-1301,  USA       gnu@gnu.org
39;;
40;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41
42(define-module (gnucash reports standard budget-income-statement))
43(use-modules (gnucash engine))
44(use-modules (gnucash utilities))
45(use-modules (gnucash core-utils))
46(use-modules (gnucash app-utils))
47(use-modules (gnucash report))
48(use-modules (ice-9 format))
49
50;; define all option's names and help text so that they are properly
51;; defined in *one* place.
52(define optname-report-title (N_ "Report Title"))
53(define opthelp-report-title (N_ "Title for this report."))
54
55(define optname-party-name (N_ "Company name"))
56(define opthelp-party-name (N_ "Name of company/individual."))
57
58(define optname-budget (N_ "Budget"))
59(define opthelp-budget (N_ "Budget to use."))
60
61(define optname-use-budget-period-range
62  (N_ "Report for range of budget periods"))
63(define opthelp-use-budget-period-range
64  (N_ "Create report for a budget period range instead of the entire budget."))
65
66(define optname-budget-period-start (N_ "Range start"))
67(define opthelp-budget-period-start
68  (N_ "Select a budget period that begins the reporting range."))
69
70(define optname-budget-period-end (N_ "Range end"))
71(define opthelp-budget-period-end
72  (N_ "Select a budget period that ends the reporting range."))
73
74(define optname-accounts (N_ "Accounts"))
75(define opthelp-accounts
76  (N_ "Report on these accounts, if display depth allows."))
77(define optname-depth-limit (N_ "Levels of Subaccounts"))
78(define opthelp-depth-limit
79  (N_ "Maximum number of levels in the account tree displayed."))
80(define optname-bottom-behavior (N_ "Flatten list to depth limit"))
81(define opthelp-bottom-behavior
82  (N_ "Displays accounts which exceed the depth limit at the depth limit."))
83
84(define optname-parent-balance-mode (N_ "Parent account balances"))
85(define optname-parent-total-mode (N_ "Parent account subtotals"))
86
87(define optname-show-zb-accts (N_ "Include accounts with zero total balances"))
88(define opthelp-show-zb-accts
89  (N_ "Include accounts with zero total (recursive) balances in this report."))
90(define optname-omit-zb-bals (N_ "Omit zero balance figures"))
91(define opthelp-omit-zb-bals
92  (N_ "Show blank space in place of any zero balances which would be shown."))
93
94(define optname-use-rules (N_ "Show accounting-style rules"))
95(define opthelp-use-rules
96  (N_ "Use rules beneath columns of added numbers like accountants do."))
97
98(define optname-account-links (N_ "Display accounts as hyperlinks"))
99(define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window."))
100
101(define optname-label-revenue (N_ "Label the revenue section"))
102(define opthelp-label-revenue
103  (N_ "Whether or not to include a label for the revenue section."))
104(define optname-total-revenue (N_ "Include revenue total"))
105(define opthelp-total-revenue
106  (N_ "Whether or not to include a line indicating total revenue."))
107(define optname-label-expense (N_ "Label the expense section"))
108(define opthelp-label-expense
109  (N_ "Whether or not to include a label for the expense section."))
110(define optname-total-expense (N_ "Include expense total"))
111(define opthelp-total-expense
112  (N_ "Whether or not to include a line indicating total expense."))
113
114(define pagename-commodities (N_ "Commodities"))
115(define optname-report-commodity (N_ "Report's currency"))
116(define optname-price-source (N_ "Price Source"))
117(define optname-show-foreign (N_ "Show Foreign Currencies"))
118(define opthelp-show-foreign
119  (N_ "Display any foreign currency amount in an account."))
120(define optname-show-rates (N_ "Show Exchange Rates"))
121(define opthelp-show-rates (N_ "Show the exchange rates used."))
122
123(define optname-two-column
124  (N_ "Display as a two column report"))
125(define opthelp-two-column
126  (N_ "Divides the report into an income column and an expense column."))
127(define optname-standard-order
128  (N_ "Display in standard, income first, order"))
129(define opthelp-standard-order
130  (N_ "Causes the report to display in the standard order, placing income before expenses."))
131
132;; options generator
133(define (budget-income-statement-options-generator-internal reportname)
134  (let* ((options (gnc:new-options))
135         (book (gnc-get-current-book)) ; XXX Find a way to get the book that opened the report
136         (add-option
137          (lambda (new-option)
138            (gnc:register-option options new-option))))
139
140    (add-option
141      (gnc:make-string-option
142      gnc:pagename-general optname-report-title
143      "a" opthelp-report-title (G_ reportname)))
144    (add-option
145      (gnc:make-string-option
146      gnc:pagename-general optname-party-name
147      "b" opthelp-party-name (or (gnc:company-info book gnc:*company-name*) "")))
148
149    (add-option
150     (gnc:make-budget-option
151      gnc:pagename-general optname-budget
152      "c" opthelp-budget))
153
154    (add-option
155     (gnc:make-complex-boolean-option
156      gnc:pagename-general
157      optname-use-budget-period-range
158      "d"
159      opthelp-use-budget-period-range
160      #f
161      #f
162      ;; Make budget-period-start and budget-period-end option widgets
163      ;; selectable only when we are running the report for a budget period
164      ;; range.
165      (lambda (value)
166        (gnc-option-db-set-option-selectable-by-name
167          options
168          gnc:pagename-general
169          optname-budget-period-start
170          value)
171        (gnc-option-db-set-option-selectable-by-name
172          options
173          gnc:pagename-general
174          optname-budget-period-end
175          value))))
176
177    (add-option
178     (gnc:make-number-range-option
179      gnc:pagename-general optname-budget-period-start
180      "e" opthelp-budget-period-start
181      ;; FIXME: It would be nice if the max number of budget periods (60) was
182      ;; defined globally somewhere so we could reference it here.  However, it
183      ;; only appears to be defined currently in src/gnome/glade/budget.glade.
184      1 1 60 0 1))
185
186    (add-option
187     (gnc:make-number-range-option
188      gnc:pagename-general optname-budget-period-end
189      "f" opthelp-budget-period-end
190      ;; FIXME: It would be nice if the max number of budget periods (60) was
191      ;; defined globally somewhere so we could reference it here.  However, it
192      ;; only appears to be defined currently in src/gnome/glade/budget.glade.
193      1 1 60 0 1))
194
195    ;; accounts to work on
196    (add-option
197     (gnc:make-account-list-option
198      gnc:pagename-accounts optname-accounts
199      "a"
200      opthelp-accounts
201      (lambda ()
202	(gnc:filter-accountlist-type
203	 ;; select, by default, only income and expense accounts
204	 (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
205	 (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
206      #f #t))
207    (gnc:options-add-account-levels!
208     options gnc:pagename-accounts optname-depth-limit
209     "b" opthelp-depth-limit 3)
210    (add-option
211     (gnc:make-simple-boolean-option
212      gnc:pagename-accounts optname-bottom-behavior
213      "c" opthelp-bottom-behavior #f))
214
215    ;; all about currencies
216    (gnc:options-add-currency!
217     options pagename-commodities
218     optname-report-commodity "a")
219
220    (gnc:options-add-price-source!
221     options pagename-commodities
222     optname-price-source "b" 'pricedb-nearest)
223
224    (add-option
225     (gnc:make-simple-boolean-option
226      pagename-commodities optname-show-foreign
227      "c" opthelp-show-foreign #t))
228
229    (add-option
230     (gnc:make-simple-boolean-option
231      pagename-commodities optname-show-rates
232      "d" opthelp-show-rates #f))
233
234    ;; what to show for zero-balance accounts
235    (add-option
236     (gnc:make-simple-boolean-option
237      gnc:pagename-display optname-show-zb-accts
238      "a" opthelp-show-zb-accts #t))
239    (add-option
240     (gnc:make-simple-boolean-option
241      gnc:pagename-display optname-omit-zb-bals
242      "b" opthelp-omit-zb-bals #f))
243    ;; what to show for non-leaf accounts
244    (gnc:options-add-subtotal-view!
245     options gnc:pagename-display
246     optname-parent-balance-mode optname-parent-total-mode
247     "c")
248
249    ;; some detailed formatting options
250    (add-option
251     (gnc:make-simple-boolean-option
252      gnc:pagename-display optname-account-links
253      "d" opthelp-account-links #t))
254    (add-option
255     (gnc:make-simple-boolean-option
256      gnc:pagename-display optname-use-rules
257      "e" opthelp-use-rules #f))
258
259    (add-option
260     (gnc:make-simple-boolean-option
261      gnc:pagename-display optname-label-revenue
262      "f" opthelp-label-revenue #t))
263    (add-option
264     (gnc:make-simple-boolean-option
265      gnc:pagename-display optname-total-revenue
266      "g" opthelp-total-revenue #t))
267
268    (add-option
269     (gnc:make-simple-boolean-option
270      gnc:pagename-display optname-label-expense
271      "h" opthelp-label-expense #t))
272    (add-option
273     (gnc:make-simple-boolean-option
274      gnc:pagename-display optname-total-expense
275      "i" opthelp-total-expense #t))
276
277    (add-option
278     (gnc:make-simple-boolean-option
279      gnc:pagename-display optname-two-column
280      "j" opthelp-two-column #f))
281
282    (add-option
283     (gnc:make-simple-boolean-option
284      gnc:pagename-display optname-standard-order
285      "k" opthelp-standard-order #t))
286
287    ;; Set the accounts page as default option tab
288    (gnc:options-set-default-section options gnc:pagename-accounts)
289
290    options))
291
292  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
293;; budget-income-statement-renderer
294;; set up the document and add the table
295  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
296
297(define (budget-income-statement-renderer-internal report-obj reportname)
298  (define (get-option pagename optname)
299    (gnc:option-value
300     (gnc:lookup-option
301      (gnc:report-options report-obj) pagename optname)))
302
303  (define (get-assoc-account-balances-budget
304           budget accountlist period-start period-end get-balance-fn)
305    (gnc:get-assoc-account-balances
306     accountlist (lambda (account)
307                   (get-balance-fn budget account period-start period-end))))
308
309  (define (get-budget-account-budget-balance budget account period-start period-end)
310    (let ((bal (gnc:budget-account-get-net budget account period-start period-end)))
311      (if (gnc-reverse-budget-balance account #t) (gnc:collector- bal) bal)))
312
313  (gnc:report-starting reportname)
314
315  ;; get all option's values
316  (let* (
317	 (report-title (get-option gnc:pagename-general optname-report-title))
318	 (company-name (get-option gnc:pagename-general optname-party-name))
319         (budget (get-option gnc:pagename-general optname-budget))
320         (budget-valid? (and budget (not (null? budget))))
321         (use-budget-period-range?
322           (get-option gnc:pagename-general optname-use-budget-period-range))
323         (user-budget-period-start
324           (if use-budget-period-range?
325             (inexact->exact
326               (truncate
327                 (get-option gnc:pagename-general optname-budget-period-start)))
328             #f))
329         (user-budget-period-end
330           (if use-budget-period-range?
331             (inexact->exact
332               (truncate
333                 (get-option gnc:pagename-general optname-budget-period-end)))
334             #f))
335         (period-start
336           (if use-budget-period-range? (- user-budget-period-start 1) #f))
337         (period-end
338           (if use-budget-period-range? user-budget-period-end #f))
339         (date-t64
340           (if budget-valid?
341             (gnc-budget-get-period-start-date
342               budget
343               (if use-budget-period-range? period-start 0))
344             #f))
345         (accounts (get-option gnc:pagename-accounts
346                               optname-accounts))
347	 (depth-limit (get-option gnc:pagename-accounts
348				  optname-depth-limit))
349	 (bottom-behavior (get-option gnc:pagename-accounts
350				  optname-bottom-behavior))
351         (report-commodity (get-option pagename-commodities
352                                      optname-report-commodity))
353         (price-source (get-option pagename-commodities
354                                   optname-price-source))
355         (show-fcur? (get-option pagename-commodities
356                                 optname-show-foreign))
357         (show-rates? (get-option pagename-commodities
358                                  optname-show-rates))
359         (parent-balance-mode (get-option gnc:pagename-display
360                                           optname-parent-balance-mode))
361         (parent-total-mode
362	  (assq-ref '((t . #t) (f . #f))
363		    (get-option gnc:pagename-display
364				optname-parent-total-mode)))
365         (show-zb-accts? (get-option gnc:pagename-display
366				     optname-show-zb-accts))
367         (omit-zb-bals? (get-option gnc:pagename-display
368				    optname-omit-zb-bals))
369         (label-revenue? (get-option gnc:pagename-display
370				    optname-label-revenue))
371         (total-revenue? (get-option gnc:pagename-display
372				    optname-total-revenue))
373         (label-expense? (get-option gnc:pagename-display
374				    optname-label-expense))
375         (total-expense? (get-option gnc:pagename-display
376				    optname-total-expense))
377         (use-links? (get-option gnc:pagename-display
378				     optname-account-links))
379         (use-rules? (get-option gnc:pagename-display
380				    optname-use-rules))
381	 (two-column? (get-option gnc:pagename-display
382				  optname-two-column))
383	 (standard-order? (get-option gnc:pagename-display
384				      optname-standard-order))
385
386         ;; decompose the account list
387         (split-up-accounts (gnc:decompose-accountlist accounts))
388	 (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
389	 (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
390
391         (doc (gnc:make-html-document))
392	 ;; this can occasionally put extra (blank) columns in our
393	 ;; table (when there is one account at the maximum depth and
394	 ;; it has at least one of its ancestors deselected), but this
395	 ;; is the only simple way to ensure that both tables
396	 ;; (revenue, expense) have the same width.
397         (tree-depth (if (equal? depth-limit 'all)
398                         (gnc:get-current-account-tree-depth)
399			 depth-limit))
400         ;; exchange rates calculation parameters
401	 (exchange-fn
402	  (gnc:case-exchange-fn price-source report-commodity date-t64))
403
404         (price-fn (gnc:case-price-fn price-source report-commodity date-t64)))
405
406    (define (add-subtotal-line table pos-label neg-label signed-balance)
407      (let* ((neg? (and signed-balance neg-label
408			(negative?
409			 (gnc:gnc-monetary-amount
410			  (gnc:sum-collector-commodity
411			   signed-balance report-commodity exchange-fn)))))
412	     (label (if neg? (or neg-label pos-label) pos-label))
413	     (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
414	(gnc:html-table-add-labeled-amount-line!
415	 table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
416	 (gnc:sum-collector-commodity balance report-commodity exchange-fn)
417	 (1- (* tree-depth 2)) 1 "total-number-cell")))
418
419    (cond
420     ((null? accounts)
421      ;; No accounts selected.
422      (gnc:html-document-add-object!
423       doc
424       (gnc:html-make-no-account-warning
425        reportname (gnc:report-id report-obj))))
426
427     ((not budget-valid?)
428      ;; No budget selected.
429      (gnc:html-document-add-object!
430       doc (gnc:html-make-generic-budget-warning report-title)))
431
432     ((and use-budget-period-range?
433           (< user-budget-period-end user-budget-period-start))
434      ;; User has selected a range with end period lower than start period.
435      (gnc:html-document-add-object!
436       doc (gnc:html-make-generic-simple-warning
437            report-title
438            (G_ "Reporting range end period cannot be less than start period."))))
439
440     (else
441      ;; Get all the balances for each of the account types.
442      (let* ((revenue-account-balances
443              (get-assoc-account-balances-budget
444               budget revenue-accounts period-start period-end
445               get-budget-account-budget-balance))
446
447             (expense-account-balances
448              (get-assoc-account-balances-budget
449               budget expense-accounts period-start period-end
450               get-budget-account-budget-balance))
451
452             (revenue-total
453              (gnc:get-assoc-account-balances-total revenue-account-balances))
454
455             (expense-total
456              (gnc:get-assoc-account-balances-total expense-account-balances))
457
458             (net-income
459              (gnc:collector- revenue-total expense-total))
460
461             (table-env
462              (list
463               (list 'display-tree-depth tree-depth)
464               (list 'depth-limit-behavior
465                     (if bottom-behavior 'flatten 'summarize))
466               (list 'report-commodity report-commodity)
467               (list 'exchange-fn exchange-fn)
468               (list 'parent-account-subtotal-mode parent-total-mode)
469               (list 'zero-balance-mode
470                     (if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct))
471               (list 'account-label-mode (if use-links? 'anchor 'name))))
472
473             (params
474              (list
475               (list 'parent-account-balance-mode parent-balance-mode)
476               (list 'zero-balance-display-mode
477                     (if omit-zb-bals? 'omit-balance 'show-balance))
478               (list 'multicommodity-mode (and show-fcur? 'table))
479               (list 'rule-mode use-rules?)))
480
481             (revenue-get-balance-fn
482              (lambda (acct start-date end-date)
483                (gnc:collector-
484                 (gnc:select-assoc-account-balance revenue-account-balances acct))))
485
486             (revenue-table
487              (gnc:make-html-acct-table/env/accts
488               (cons (list 'get-balance-fn revenue-get-balance-fn) table-env)
489               revenue-accounts))
490
491             (expense-get-balance-fn
492              (lambda (acct start-date end-date)
493                (gnc:select-assoc-account-balance expense-account-balances acct)))
494
495             (expense-table
496              (gnc:make-html-acct-table/env/accts
497               (cons (list 'get-balance-fn expense-get-balance-fn) table-env)
498               expense-accounts))
499
500             (space (make-list tree-depth (gnc:make-html-table-cell/min-width 60)))
501
502             (inc-table
503              (let ((table (gnc:make-html-table)))
504                (gnc:html-table-append-row! table space)
505                (when label-revenue?
506                  (add-subtotal-line table (G_ "Revenues") #f #f))
507                (gnc:html-table-add-account-balances table revenue-table params)
508                (when total-revenue?
509                  (add-subtotal-line table (G_ "Total Revenue") #f revenue-total))
510                table))
511
512             (exp-table
513              (let ((table (gnc:make-html-table)))
514                (gnc:html-table-append-row! table space)
515                (when label-expense?
516                  (add-subtotal-line table (G_ "Expenses") #f #f))
517                (gnc:html-table-add-account-balances table expense-table params)
518                (when total-expense?
519                  (add-subtotal-line table (G_ "Total Expenses") #f expense-total))
520                table))
521
522             (budget-name (gnc-budget-get-name budget))
523
524             (period-for
525              (cond
526               ((not use-budget-period-range?)
527                (format #f (G_ "for Budget ~a") budget-name))
528               ((= user-budget-period-start user-budget-period-end)
529                (format #f (G_ "for Budget ~a Period ~d")
530                        budget-name user-budget-period-start))
531               (else
532                (format #f (G_ "for Budget ~a Periods ~d - ~d")
533                        budget-name user-budget-period-start
534                        user-budget-period-end)))))
535
536        ;; a helper to add a line to our report
537        (define (report-line
538                 table pos-label neg-label amount col exchange-fn rule? row-style)
539          (let* ((neg? (and amount neg-label
540                            (negative?
541                             (gnc:gnc-monetary-amount
542                              (gnc:sum-collector-commodity
543                               amount report-commodity exchange-fn)))))
544                 (label (if neg? (or neg-label pos-label) pos-label))
545                 (abs-amt (if neg? (gnc:collector- amount) amount))
546                 (bal (gnc:sum-collector-commodity
547                       abs-amt report-commodity exchange-fn)))
548            (gnc:html-table-add-labeled-amount-line!
549             table (* 2 tree-depth)  row-style rule?
550             label                0  1 "text-cell"
551             bal           (1+ col)  1 "number-cell")))
552
553        (gnc:report-percent-done 30)
554
555        (gnc:html-document-set-title!
556         doc (format #f "~a ~a ~a" company-name report-title period-for))
557
558        (report-line
559         (if standard-order? exp-table inc-table)
560         (string-append (G_ "Net income") " " period-for)
561         (string-append (G_ "Net loss") " " period-for)
562         net-income
563         (* 2 (1- tree-depth)) exchange-fn #f #f)
564
565        (let ((build-table (gnc:make-html-table))
566                (inc-cell (gnc:make-html-table-cell inc-table))
567                (exp-cell (gnc:make-html-table-cell exp-table)))
568            (define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
569            (cond
570             ((and two-column? standard-order?)
571              (add-cells inc-cell exp-cell))
572
573             (two-column?
574              (add-cells exp-cell inc-cell))
575
576             (standard-order?
577              (add-cells inc-cell)
578              (add-cells exp-cell))
579
580             (else
581              (add-cells exp-cell)
582              (add-cells inc-cell)))
583
584            (gnc:html-table-set-style!
585             build-table "td"
586             'attribute '("align" "left")
587             'attribute '("valign" "top"))
588            (gnc:html-document-add-object! doc build-table))
589
590        ;; add currency information if requested
591        (gnc:report-percent-done 90)
592        (when show-rates?
593          (gnc:html-document-add-object!
594           doc (gnc:html-make-rates-table report-commodity price-fn accounts)))
595        (gnc:report-percent-done 100))))
596
597    (gnc:report-finished)
598
599    doc))
600
601(define is-reportname (N_ "Budget Income Statement"))
602(define pnl-reportname (N_ "Budget Profit & Loss"))
603
604(define (budget-income-statement-options-generator)
605  (budget-income-statement-options-generator-internal is-reportname))
606(define (budget-income-statement-renderer report-obj)
607  (budget-income-statement-renderer-internal report-obj is-reportname))
608
609(define (budget-profit-and-loss-options-generator)
610  (budget-income-statement-options-generator-internal pnl-reportname))
611(define (budget-profit-and-loss-renderer report-obj)
612  (budget-income-statement-renderer-internal report-obj is-reportname))
613
614
615(gnc:define-report
616 'version 1
617 'name is-reportname
618 'report-guid "583c313fcc484efc974c4c844404f454"
619 'menu-path (list gnc:menuname-budget)
620 'options-generator budget-income-statement-options-generator
621 'renderer budget-income-statement-renderer
622 )
623
624;; Also make a "Profit & Loss" report, even if it's the exact same one,
625;; just relabeled.
626(gnc:define-report
627 'version 1
628 'name pnl-reportname
629 'report-guid "e5fa5ce805e840ecbeca4dba3fa4ead9"
630 'menu-path (list gnc:menuname-budget)
631 'options-generator budget-profit-and-loss-options-generator
632 'renderer budget-profit-and-loss-renderer
633 )
634
635;; END
636