"Fossies" - the Fresh Open Source Software Archive

Member "gnucash-3.7/gnucash/report/business-reports/balsheet-eg.scm" (7 Sep 2019, 32192 Bytes) of package /linux/misc/gnucash-3.7.tar.bz2:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "balsheet-eg.scm": 3.6_vs_3.7.

    1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    2 ;; balsheet-eg.scm
    3 ;; by Chris Dennis  chris@starsoftanalysis.co.uk
    4 ;;
    5 ;; - eguile version of ...
    6 ;; balance-sheet.scm: balance sheet
    7 ;;
    8 ;; By Robert Merkel <rgmerk@mira.net>
    9 ;;
   10 ;; Heavily modified and Frankensteined by David Montenegro
   11 ;;   2004.06.12-2004.06.23 <sunrise2000@comcast.net>
   12 ;;
   13 ;; $Author: chris $ $Date: 2009/07/02 10:16:02 $ $Revision: 1.44 $
   14 ;;
   15 ;; This program is free software; you can redistribute it and/or
   16 ;; modify it under the terms of the GNU General Public License as
   17 ;; published by the Free Software Foundation; either version 2 of
   18 ;; the License, or (at your option) any later version.
   19 ;;
   20 ;; This program is distributed in the hope that it will be useful,
   21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
   22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   23 ;; GNU General Public License for more details.
   24 ;;
   25 ;; You should have received a copy of the GNU General Public License
   26 ;; along with this program; if not, contact:
   27 ;;
   28 ;; Free Software Foundation           Voice:  +1-617-542-5942
   29 ;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652
   30 ;; Boston, MA  02110-1301,  USA       gnu@gnu.org
   31 ;;
   32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   33 
   34 (define-module (gnucash report balsheet-eg))
   35 (use-modules (gnucash utilities))
   36 (use-modules (gnucash gnc-module))
   37 (use-modules (gnucash gettext))
   38 (use-modules (gnucash report eguile-gnc))
   39 (use-modules (gnucash report eguile-utilities))
   40 (use-modules (gnucash report eguile-html-utilities))
   41 
   42 (use-modules (ice-9 local-eval))  ; for the-environment
   43 (use-modules (srfi srfi-13)) ; for extra string functions
   44 
   45 (gnc:module-load "gnucash/report/report-system" 0)
   46 (gnc:module-load "gnucash/html" 0)
   47 
   48 (define debugging? #f)
   49 
   50 (define (debug . args)
   51   (if debugging?
   52     (for arg in args do
   53         (if (string? arg)
   54           (display (string-append arg " "))
   55           (display (string-append (dump arg) " "))))
   56       ))
   57 
   58 (define (hrule cols) ; in fact just puts in an empty row for spacing
   59   (display "<tr valign=\"center\"><td colspan=\"")
   60   (display cols)
   61   (display "\">&nbsp;</td></tr>\n"))
   62 
   63 (define (add-to-cc cc com num neg?)
   64   ; add a numeric and commodity to a commodity-collector,
   65   ; changing sign if required
   66   (if neg?
   67     (cc 'add com (gnc-numeric-neg num))
   68     (cc 'add com num)))
   69 
   70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   71 ;;
   72 ;; Define an account record for cacheing information about all the accounts
   73 (define (accrec-printer accrec port)
   74   ;; accrec printer.  This is for debugging reports, so it uses
   75   ;; HTML for pretty-printing
   76   (set-current-output-port port)
   77   (display "accrec:- ")
   78   (display " account: ")     (display (dump (accrec-account accrec)))
   79   (display " code: ")        (display (accrec-code accrec))
   80   (display " placeholder: ") (display (dump (accrec-placeholder? accrec)))
   81   (display " namelink: ")    (display (accrec-namelink accrec))
   82   (display " commodity: ")   (if (accrec-commodity accrec)
   83                                (display (gnc-commodity-get-mnemonic (accrec-commodity accrec)))
   84                                (display "#f"))
   85   (display " balance-num: ") (if (accrec-balance-num accrec)
   86                                (display (gnc-numeric-to-double (accrec-balance-num accrec)))
   87                                ;(display (gnc:monetary->string (accrec-balance-mny accrec)))
   88                                ;(display (format-monetary (accrec-balance-num accrec))) ; not this -- too fancy
   89                                (display "#f"))
   90   (display " depth: ")       (display (accrec-depth accrec))
   91   (display " treedepth: ")   (display (accrec-treedepth accrec))
   92   (display " non-zero?: ")   (display (accrec-non-zero? accrec))
   93   (display " summary?: ")    (display (accrec-summary? accrec))
   94   (display " subtotal-cc: ") (if (accrec-subtotal-cc accrec)
   95                                ;(display (get-comm-coll-total (accrec-subtotal-cc accrec) #f))
   96                                ;(display (format-comm-coll (accrec-subtotal-cc accrec)))
   97                                (display
   98                                  (string-concatenate
   99                                    (map-in-order
  100                                      (lambda (mny)
  101                                        (string-append (gnc:monetary->string mny) " "))
  102                                      ((accrec-subtotal-cc accrec) 'format gnc:make-gnc-monetary #f))))
  103                                (display "#f"))
  104   (display " sublist: ")     (if (accrec-sublist accrec)
  105                                (begin
  106                                  (display "\n<ul>")
  107                                  (for sub-accrec in (accrec-sublist accrec) do
  108                                      (display "\n<li>")
  109                                      (accrec-printer sub-accrec port)
  110                                      (display "</li>"))
  111                                  (display "</ul>"))
  112                                (display "#f")))
  113 (define accrectype (make-record-type "accrecc"
  114                                      '(account
  115                                         code
  116                                         placeholder?
  117                                         namelink ; a/c name, as link if required
  118                                         commodity
  119                                         balance-num ; excluding sublist
  120                                         depth
  121                                         treedepth
  122                                         non-zero?  ; #t if this or any sub-a/cs are non zero
  123                                         summary?   ; #t if subaccounts summarised here
  124                                         subtotal-cc ; of sublist plus this a/c
  125                                         sublist)
  126                                      accrec-printer))
  127 (define newaccrec-full (record-constructor accrectype))                ; requires all the fields
  128 (define newaccrec-empty (record-constructor accrectype '()))        ; all fields default to #f
  129 (define newaccrec (record-constructor accrectype '(account         ; most-likely-to-be-needed fields
  130                                                     code
  131                                                     placeholder?
  132                                                     namelink
  133                                                     commodity
  134                                                     balance-num
  135                                                     depth
  136                                                     treedepth)))
  137 (define (newaccrec-clean)
  138   ;; Create a new accrec with 'clean' empty values, e.g. strings are "", not #f
  139   (newaccrec-full #f         ; account
  140                   ""         ; code
  141                   #f         ; placeholder?
  142                   ""         ; namelink
  143                   (gnc-default-currency)         ; commodity
  144                   (gnc-numeric-zero) ; balance-num
  145                   0         ; depth
  146                   0         ; treedepth
  147                   #f         ; non-zero?
  148                   #f        ; summary?
  149                   (gnc:make-commodity-collector) ; subtotal-cc
  150                   #f        ;'()        ; sublist
  151                   ))
  152 (define accrec? (record-predicate accrectype))
  153 (define accrec-account      (record-accessor accrectype 'account))
  154 (define accrec-code         (record-accessor accrectype 'code))
  155 (define accrec-placeholder? (record-accessor accrectype 'placeholder?))
  156 (define accrec-namelink     (record-accessor accrectype 'namelink))
  157 (define accrec-commodity    (record-accessor accrectype 'commodity))
  158 (define accrec-balance-num  (record-accessor accrectype 'balance-num))
  159 (define (accrec-balance-mny accrec)
  160   (gnc:make-gnc-monetary (accrec-commodity accrec) (accrec-balance-num accrec)))
  161 (define accrec-depth        (record-accessor accrectype 'depth))
  162 (define accrec-treedepth    (record-accessor accrectype 'treedepth))
  163 (define accrec-non-zero?    (record-accessor accrectype 'non-zero?))
  164 (define accrec-summary?     (record-accessor accrectype 'summary?))
  165 (define accrec-subtotal-cc  (record-accessor accrectype 'subtotal-cc))
  166 (define accrec-sublist      (record-accessor accrectype 'sublist))
  167 (define accrec-set-account!      (record-modifier accrectype 'account))
  168 (define accrec-set-code!         (record-modifier accrectype 'code))
  169 (define accrec-set-placeholder?! (record-modifier accrectype 'placeholder?))
  170 (define accrec-set-namelink!     (record-modifier accrectype 'namelink))
  171 (define accrec-set-commodity!    (record-modifier accrectype 'commodity))
  172 (define accrec-set-balance-num!  (record-modifier accrectype 'balance-num))
  173 (define (accrec-set-balance-mny! accrec mny)
  174   (accrec-set-commodity!   accrec (gnc:gnc-monetary-commodity mny))
  175   (accrec-set-balance-num! accrec (gnc:gnc-monetary-amount    mny)))
  176 (define accrec-set-depth!        (record-modifier accrectype 'depth))
  177 (define accrec-set-treedepth!    (record-modifier accrectype 'treedepth))
  178 (define accrec-set-non-zero?!    (record-modifier accrectype 'non-zero?))
  179 (define accrec-set-summary?!     (record-modifier accrectype 'summary?))
  180 (define accrec-set-subtotal-cc!  (record-modifier accrectype 'subtotal-cc))
  181 (define accrec-set-sublist!      (record-modifier accrectype 'sublist))
  182 
  183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  184 ;; All the options stuff starts here
  185 
  186 (define reportname (_ "Balance Sheet (eguile)"))
  187 
  188 ;; define all option's names and help text so that they are properly
  189 ;; defined in *one* place.
  190 (define optname-report-title (N_ "Report Title"))
  191 (define opthelp-report-title (N_ "Title for this report."))
  192 
  193 (define optname-date    (N_ "Balance Sheet Date"))
  194 (define optname-columns (N_ "1- or 2-column report"))
  195 (define opthelp-columns
  196   (N_ "The balance sheet can be displayed with either 1 or 2 columns. 'auto' means that the layout will be adjusted to fit the width of the page."))
  197 
  198 (define optname-depth-limit (N_ "Levels of Subaccounts"))
  199 (define opthelp-depth-limit (N_ "Maximum number of levels in the account tree displayed."))
  200 (define optname-flatten?    (N_ "Flatten list to depth limit"))
  201 (define opthelp-flatten?
  202   (N_ "Displays accounts which exceed the depth limit at the depth limit."))
  203 
  204 (define optname-omit-zb-accts (N_ "Exclude accounts with zero total balances"))
  205 (define opthelp-omit-zb-accts
  206   (N_ "Exclude non-top-level accounts with zero balance and no non-zero sub-accounts."))
  207 
  208 (define optname-account-links (N_ "Display accounts as hyperlinks"))
  209 (define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window."))
  210 
  211 (define optname-neg-format (N_ "Negative amount format"))
  212 (define opthelp-neg-format
  213   (N_ "The formatting to use for negative amounts: with a leading sign, or enclosing brackets."))
  214 
  215 (define optname-font-family    (N_ "Font family"))
  216 (define opthelp-font-family    (N_ "Font definition in CSS font-family format."))
  217 (define optname-font-size      (N_ "Font size"))
  218 (define opthelp-font-size      (N_ "Font size in CSS font-size format (e.g. \"medium\" or \"10pt\")."))
  219 (define optname-template-file  (N_ "Template file"))
  220 (define opthelp-template-file
  221   (N_ "The file name of the eguile template part of this report. This file must be in your .gnucash directory, or else in its proper place within the GnuCash installation directories."))
  222 (define optname-css-file  (N_ "CSS stylesheet file"))
  223 (define opthelp-css-file
  224   (N_ "The file name of the CSS stylesheet to use with this report. If specified, this file should be in your .gnucash directory, or else in its proper place within the GnuCash installation directories."))
  225 (define optname-extra-notes (N_ "Extra Notes"))
  226 (define opthelp-extra-notes (N_ "Notes added at end of invoice -- may contain HTML markup."))
  227 
  228 (define optname-report-commodity (N_ "Report's currency"))
  229 (define optname-price-source (N_ "Price Source"))
  230 (define optname-show-foreign (N_ "Show Foreign Currencies"))
  231 (define opthelp-show-foreign
  232   (N_ "Display any foreign currency amount in an account."))
  233 
  234 (define accounts-page    gnc:pagename-accounts)
  235 (define commodities-page (N_ "Commodities"))
  236 (define display-page     gnc:pagename-display)
  237 (define general-page     gnc:pagename-general)
  238 (define notes-page       (N_ "Notes"))
  239 
  240 ;; options generator
  241 (define (balsheet-options-generator)
  242   (let* ((options (gnc:new-options))
  243          (add-option
  244            (lambda (new-option)
  245              (gnc:register-option options new-option))))
  246 
  247     ;; Accounts options
  248     (add-option (gnc:make-simple-boolean-option accounts-page optname-omit-zb-accts
  249                                                 "a" opthelp-omit-zb-accts #f))
  250     (add-option (gnc:make-simple-boolean-option accounts-page optname-account-links
  251                                                 "b" opthelp-account-links #t))
  252     (gnc:options-add-account-levels!  options accounts-page optname-depth-limit
  253                                       "c" opthelp-depth-limit 'all)
  254     (add-option (gnc:make-simple-boolean-option accounts-page optname-flatten?
  255                                                 "d" opthelp-flatten? #f))
  256 
  257     ;; Commodity options
  258     (gnc:options-add-currency! options commodities-page optname-report-commodity "a")
  259     (gnc:options-add-price-source!  options commodities-page
  260                                     optname-price-source "b" 'average-cost)
  261     (add-option (gnc:make-simple-boolean-option commodities-page optname-show-foreign
  262                                                 "c" opthelp-show-foreign #t))
  263 
  264     ;; Display options
  265     (add-option (gnc:make-multichoice-option
  266                   display-page optname-columns
  267                   "a" opthelp-columns 'onecol
  268                   (list (vector 'autocols
  269                                 (N_ "Auto")
  270                                 (N_ "Adjust the layout to fit the width of the screen or page."))
  271                         (vector 'onecol
  272                                 (N_ "One")
  273                                 (N_ "Display liabilities and equity below assets."))
  274                         (vector 'twocols
  275                                 (N_ "Two")
  276                                 (N_ "Display assets on the left, liabilities and equity on the right.")))))
  277     (add-option (gnc:make-multichoice-option
  278                   display-page optname-neg-format
  279                   "b" opthelp-neg-format 'negsign
  280                   (list (vector 'negsign
  281                                 (N_ "Sign")
  282                                 (N_ "Prefix negative amounts with a minus sign, e.g. -$10.00."))
  283                         (vector 'negbrackets
  284                                 (N_ "Brackets")
  285                                 (N_ "Surround negative amounts with brackets, e.g. ($100.00).")))))
  286     (add-option (gnc:make-string-option display-page optname-font-family "c"
  287                                         opthelp-font-family "sans"))
  288     (add-option (gnc:make-string-option display-page optname-font-size "d"
  289                                         opthelp-font-size "medium"))
  290     (add-option (gnc:make-string-option display-page optname-template-file "e"
  291                                         opthelp-template-file "balsheet-eg.eguile.scm"))
  292     (add-option (gnc:make-string-option display-page optname-css-file "f"
  293                                         opthelp-css-file "balsheet-eg.css"))
  294 
  295     ;; General options
  296     (add-option (gnc:make-string-option general-page optname-report-title
  297                                         "a" opthelp-report-title reportname))
  298     (gnc:options-add-report-date!  options general-page optname-date "b")
  299 
  300     ;; Notes options
  301     (add-option (gnc:make-text-option notes-page optname-extra-notes
  302                                       "a" opthelp-extra-notes
  303                                       (N_ "(Development version -- don't rely on the numbers on this report without double-checking them.<br>Change the 'Extra Notes' option to get rid of this message)")))
  304 
  305     ;; Set the accounts page as default option tab
  306     (gnc:options-set-default-section options general-page)
  307 
  308     options))
  309 
  310 ;; Create the report as a chunk of HTML, and return it
  311 ;; as a <html-doc> or plain HTML
  312 (define (balsheet-renderer report-obj)
  313 
  314   (define (get-option pagename optname)
  315     (gnc:option-value
  316       (gnc:lookup-option
  317         (gnc:report-options report-obj) pagename optname)))
  318 
  319   (gnc:report-starting reportname)
  320   (let* (
  321          ;; get all options' values
  322          (opt-omit-zb-accts?   (get-option accounts-page    optname-omit-zb-accts))
  323          (opt-use-links?       (get-option accounts-page    optname-account-links))
  324          (opt-depth-limit      (get-option accounts-page    optname-depth-limit))
  325          (opt-flatten?         (get-option accounts-page    optname-flatten?))
  326          (opt-report-commodity (get-option commodities-page optname-report-commodity))
  327          (opt-price-source     (get-option commodities-page optname-price-source))
  328          (opt-show-foreign?    (get-option commodities-page optname-show-foreign))
  329          (opt-report-title     (get-option general-page     gnc:optname-reportname))
  330          (opt-date             (gnc:time64-end-day-time
  331                                  (gnc:date-option-absolute-time
  332                                    (get-option general-page optname-date))))
  333          (opt-columns          (get-option display-page     optname-columns))
  334          (opt-font-family      (get-option display-page     optname-font-family))
  335          (opt-font-size        (get-option display-page     optname-font-size))
  336          (opt-template-file    (find-file
  337                                  (get-option display-page   optname-template-file)))
  338          (opt-css-file         (find-file
  339                                  (get-option display-page   optname-css-file)))
  340          (opt-flatten-depth    999); may get adjusted below
  341          (opt-neg-format       (get-option display-page     optname-neg-format))
  342          (opt-extra-notes      (get-option notes-page       optname-extra-notes))
  343 
  344          ;; non-option assignments
  345          ;;
  346          (accounts
  347            (gnc:filter-accountlist-type
  348              (list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT
  349                    ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY
  350                    ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY
  351                    ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE
  352                    ACCT-TYPE-EQUITY ACCT-TYPE-TRADING
  353                    ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
  354              (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
  355          ;; decompose the account list
  356          (split-up-accounts (gnc:decompose-accountlist accounts))
  357          (asset-accounts
  358            (assoc-ref split-up-accounts ACCT-TYPE-ASSET))
  359          (liability-accounts
  360            (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY))
  361          (equity-accounts
  362            (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
  363          (trading-accounts
  364            (assoc-ref split-up-accounts ACCT-TYPE-TRADING))
  365          (income-expense-accounts
  366            (append (assoc-ref split-up-accounts ACCT-TYPE-INCOME)
  367                    (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)))
  368 
  369 
  370          ;; exchange rates calculation parameters
  371          (exchange-fn
  372            (gnc:case-exchange-fn opt-price-source opt-report-commodity opt-date))
  373          ; List of commodities (other than the local one) used
  374          ; so that exchange rate table can be displayed.
  375          ; xlist will become an association list of (comm . #t) pairs
  376          ; to avoid duplicates.
  377          (xlist '())
  378 
  379          ;; XXX I haven't found a way to get the book for which the report was opened here
  380          (coyname (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
  381 
  382          (html #f))
  383 
  384     ;; end of all the lets.  time for some real code
  385 
  386     ;; The following routines are defined inside
  387     ;; the renderer to make options available:
  388 
  389     ;; number formatting stuff
  390     (define (fmtnumber n)
  391       ;; format double n with as many decimal places as required
  392       (number->string (if (integer? n) (inexact->exact n) n)))
  393     (define (fmtnumeric n)
  394       ;; format gnc-numeric n for printing
  395       (fmtnumber (gnc-numeric-to-double n)))
  396 
  397     ;; HTML-specific formatting
  398 
  399     (define (negstyle item)
  400       ;; apply styling for negative amounts
  401       (string-append "<span class=\"negative\">" item "</span>"))
  402 
  403     (define (foreignstyle item)
  404       ;; apply styling for amount in foreign currency
  405         (string-append "<span class=\"foreign\">" item "</span>")
  406         (string-append "<small><i>" item "</i></small>"))
  407 
  408     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  409     ;;; accrec-related routines
  410     ;;;
  411     ;;; The accrec record structure (defined above) and the following
  412     ;;; routines provide the basis for easy access to accounts
  413     ;;; from the main part of the report
  414 
  415     (define (one-depth-1 accrec)
  416       ; Return true if the accrec tree contains exactly 1 depth-1 account
  417       ; (expects a top-level accrec starting at depth 0)
  418       (and (accrec-sublist accrec)
  419            (= 1 (length (accrec-sublist accrec)))))
  420 
  421     (define (account-link account)
  422       ;; Return an HTML link to the given account,
  423       ;; e.g. <a href="gnc-register:acct-guid=abcdeaalsdfjkalsdk#">Account Name</a>
  424       (if opt-use-links?
  425         (string-append
  426           "<a href=\"gnc-register:acct-guid="
  427           (gncAccountGetGUID account)
  428           "\">"
  429           (xaccAccountGetName account)
  430           "</a>")
  431         (xaccAccountGetName account)))
  432 
  433     (define (excluded-acc? accrec)
  434       ;; Returns true if the account is to be excluded from the report
  435       ;; NOTE! The balance of excluded accounts will still be added
  436       ;;       into the report, so this only makes sense for zero-balance accounts
  437       (and (not (accrec-non-zero? accrec))
  438            (or
  439              ;; Reason 0: option to exclude zero-balance accounts (depth > 1 only)
  440              (and opt-omit-zb-accts?)
  441                   ;(> (accrec-depth accrec) 1))
  442              ;; Reason 1: zero Imbalance a/c
  443              ;; The line break in the next expressions will suppress comments as translator comments.
  444              (string-prefix?
  445                (_ "Imbalance") (xaccAccountGetName (accrec-account accrec)))
  446              ;; Reason 2: zero Orphan a/c
  447              (string-prefix?
  448                (_ "Orphan") (xaccAccountGetName (accrec-account accrec))))))
  449 
  450     (define (flattened-acc-depth acc)
  451       ;; Accounts deeper than required get moved to the requested depth
  452       (min (gnc-account-get-current-depth acc)
  453            opt-flatten-depth)) ; this is set to a large value if no flattening required
  454 
  455     (define (process-acc-list account-list neg?)
  456       ;; non-recursive wrapper around this:
  457       ;; Convert the account list to a tree structure for easier handling later
  458       (define (process-acc-list-r
  459                 account-list       ; list of accounts to process
  460                 curr-depth         ; set depth to 1 to start with
  461                 neg?)
  462         (let ((tree '())          ; gets tree of accounts from this depth down
  463               (maxdepth 0)        ; gets max depth of all at this level
  464               (any-non-zero? #f)  ; becomes true if any at this level are non-zero
  465               (total-cc (gnc:make-commodity-collector)))        ; gets grand total of all accounts
  466           ; at this level and below
  467           ; loop until no more accounts, or next account is at higher level
  468           (while (and (not (null? account-list))
  469                       (>= (gnc-account-get-current-depth (car account-list)) curr-depth))
  470                  (let* ((account (car account-list))
  471                         (comm    (xaccAccountGetCommodity account))
  472                         (bal     (xaccAccountGetBalanceAsOfDate account opt-date))
  473                         (depth   (flattened-acc-depth account))
  474                         (treedepth 1)
  475                         ; Next account only qualifies as 'deeper' if we're not flattening
  476                         (next-acc-deeper (and (not (null? (safe-cadr account-list)))
  477                                               (> (flattened-acc-depth (safe-cadr account-list)) depth)))
  478                         (newacc (newaccrec-clean)))
  479                    (accrec-set-account!      newacc account)
  480                    (accrec-set-code!         newacc (xaccAccountGetCode account))
  481                    (accrec-set-placeholder?! newacc (xaccAccountGetPlaceholder account))
  482                    (accrec-set-namelink!     newacc (account-link account))
  483                    (accrec-set-commodity!    newacc comm) ;(xaccAccountGetCommodity account))
  484                    (accrec-set-balance-num!  newacc
  485                                              (if neg?
  486                                                (gnc-numeric-neg bal)
  487                                                bal))
  488                    (accrec-set-depth!        newacc depth) ;(gnc-account-get-current-depth account))
  489                    (accrec-set-non-zero?!    newacc (not (gnc-numeric-zero-p bal)))
  490 
  491                    (if (>= depth opt-depth-limit)
  492                      (accrec-set-summary?! newacc #t))
  493                    (set! xlist (assoc-set! xlist comm #t)) ; even if not opt-show-foreign?
  494 
  495                    (accrec-set-subtotal-cc! newacc (gnc:make-commodity-collector))
  496                    (add-to-cc total-cc comm bal neg?)
  497                    (add-to-cc (accrec-subtotal-cc newacc) comm bal neg?)
  498 
  499                    (if next-acc-deeper
  500                      ; recurse to deal with deeper level accounts,
  501                      ; then store the resulting list
  502                      (let* ((result-v (process-acc-list-r
  503                                         (safe-cdr account-list) (1+ curr-depth) neg?))
  504                             (subtree (vector-ref result-v 0))
  505                             (subtotal-cc (vector-ref result-v 2))
  506                             (subtreedepth (vector-ref result-v 3))
  507                             (subnonzero?  (vector-ref result-v 4)))
  508                        (set! account-list (vector-ref result-v 1))
  509                        (if (not (null? subtree)); (it could be null if all sub-accounts were excluded)
  510                          (begin
  511                            ; add the sub-total from the recursion to the current level's total
  512                            (total-cc 'merge subtotal-cc neg?)
  513                            ((accrec-subtotal-cc newacc) 'merge subtotal-cc neg?)
  514                            (if (< curr-depth opt-depth-limit)
  515                              ; fix the subtree to the current tree
  516                              ; but only if not beyond the limit
  517                              (accrec-set-sublist! newacc subtree))
  518                            ; add the subtree's depth to this level's
  519                            (set! treedepth (1+ subtreedepth))
  520                            (if subnonzero?
  521                              (accrec-set-non-zero?! newacc #t)))))
  522                      (begin  ; else -- same level -- just pop the account off the list
  523                        (set! account-list (cdr account-list)))) ; end if next-acc-deeper
  524 
  525                    (if (> treedepth maxdepth)
  526                      (set! maxdepth treedepth))
  527                    ;(display " =D=maxdepth=")(ddump maxdepth)
  528                    (if (not (excluded-acc? newacc))
  529                      (set! tree (append tree (list newacc))))
  530                    (if (accrec-non-zero? newacc)
  531                      (set! any-non-zero? #t))
  532                    (accrec-set-treedepth!    newacc treedepth)
  533                    )); end of while
  534           ; next a/c (if any) is at higher level, so return what's
  535           ; left of the account list, and the accumulated total
  536           ;       0    1            2        3        4
  537           (vector tree account-list total-cc maxdepth any-non-zero?)
  538           )); end of p-a-l-r
  539       (let* ((result-v (process-acc-list-r account-list 1 neg?))
  540              (accrec0  (newaccrec-clean)))  ; accrec for depth 0
  541         ; Set up top-level 'depth-0' accrec with summary information
  542         (accrec-set-depth!       accrec0 0)
  543         (accrec-set-sublist!     accrec0 (vector-ref result-v 0))
  544         (accrec-set-subtotal-cc! accrec0 (vector-ref result-v 2))
  545         (accrec-set-treedepth!   accrec0 (min (vector-ref result-v 3) opt-depth-limit))
  546         ; Return the depth-0 accrec, with all other accounts linked to it
  547         accrec0))
  548 
  549     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  550     ;;; gnc-specific routines
  551     ;;; (if these are already defined elsewhere, I couldn't find them
  552     ;;;  -- please let me know.  CD)
  553 
  554     (define (gnc-monetary-neg? monetary)
  555       ; return true if the monetary value is negative
  556       (gnc-numeric-negative-p (gnc:gnc-monetary-amount monetary)))
  557 
  558     (define (neg-format mny-string neg?)
  559       ;; Given a monetary string, e.g. £123.00, applying formatting
  560       ;; for sign depending on option
  561       ;; And applies the CSS style for negatives too.  Is that right?
  562       (if neg?
  563         (if (equal? opt-neg-format 'negbrackets)
  564           (negstyle (nbsp (string-append "(" mny-string ")")))
  565           (negstyle (nbsp mny-string)))
  566         (nbsp mny-string)))
  567 
  568     (define (monetary-rounded mon)
  569       (let ((c (gnc:gnc-monetary-commodity mon))
  570             (a (gnc:gnc-monetary-amount mon)))
  571         (gnc:make-gnc-monetary
  572          c (gnc-numeric-convert a (gnc-commodity-get-fraction c) GNC-RND-ROUND))))
  573 
  574     (define (format-monetary mny)
  575       ;; Format the given gnc:monetary value according to opt-neg-format
  576       ;; If mny's currency isn't the same as that of the report,
  577       ;; convert it -- show both values if specified by option
  578       (let ((neg? (gnc-monetary-neg? mny))
  579             (comm (gnc:gnc-monetary-commodity mny))
  580             (answer ""))
  581         (if (and neg? (equal? opt-neg-format 'negbrackets))
  582           ; strip sign from amount -- (neg-format) will replace with brackets
  583           (set! mny (gnc:monetary-neg mny)))
  584         (if (not (gnc-commodity-equiv comm opt-report-commodity))
  585           (begin
  586             (if opt-show-foreign?
  587               (set! answer (string-append (foreignstyle (neg-format (gnc:monetary->string (monetary-rounded mny)) neg?)) "&nbsp;")))
  588             (set! mny (exchange-fn mny opt-report-commodity))))
  589         ; main currency - converted if necessary
  590         (set! answer (string-append answer (neg-format (gnc:monetary->string (monetary-rounded mny)) neg?)))
  591         answer))
  592 
  593     (define (format-comm-coll cc)
  594       ;; Format a commodity collector for display in the report.
  595       ;; Returns one commodity per line.
  596       (string-concatenate
  597         (map-in-order
  598           (lambda (mny)
  599             (string-append (format-monetary mny) "<br>"))
  600           (cc 'format gnc:make-gnc-monetary #f))))
  601 
  602     (define (format-comm-coll-total cc)
  603       ;; Format the total value of a commodity collector
  604       (format-monetary (gnc:sum-collector-commodity cc opt-report-commodity exchange-fn)))
  605 
  606     (define (fmtmoney2 mny)
  607       ;; format a monetary amount in the given currency/commodity
  608       ;; !! this takes a gnc-monetary
  609       (nbsp (gnc:monetary->string (monetary-rounded mny))))
  610 
  611     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  612 
  613     ;; Adjust options for convenience
  614     (if (equal? opt-depth-limit 'all)
  615       (set! opt-depth-limit 999)) ; for easier comparisons
  616     (if opt-flatten?
  617       (set! opt-flatten-depth opt-depth-limit))
  618 
  619     ;; Run eguile to process the template
  620     (set! html (eguile-file-to-string opt-template-file (the-environment)))
  621     (gnc:debug "balsheet-eg.scm - generated html:") (gnc:debug html)
  622     (gnc:report-finished)
  623     html))
  624 
  625 (gnc:define-report
  626   'version 1
  627   'name reportname
  628   'report-guid "2e3751edeb7544e8a20fd19e9d08bb65"
  629   'menu-name (N_ "Balance Sheet using eguile-gnc")
  630   'menu-tip (N_ "Display a balance sheet (using eguile template)")
  631   'menu-path (list gnc:menuname-asset-liability)
  632   'options-generator balsheet-options-generator
  633   'renderer balsheet-renderer)
  634