;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html-acct-table.scm : generate a multi-columnar list of accounts
;; including utilities to convert to <html-table> form
;; 
;; By David Montenegro 2004.06.23 <sunrise2000@comcast.net>
;; 
;; Borrowed largely from html-table.scm by Bill Gribble <grib@gnumatic.com>
;; and html-utilities.scm by Christian Stimming <stimming@tu-harburg.de>
;; 
;; This program is free software; you can redistribute it and/or    
;; modify it under the terms of the GNU General Public License as   
;; published by the Free Software Foundation; either version 2 of   
;; the License, or (at your option) any later version.              
;;                                                                  
;; This program is distributed in the hope that it will be useful,  
;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
;; GNU General Public License for more details.                     
;;                                                                  
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation           Voice:  +1-617-542-5942
;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652
;; Boston, MA  02110-1301,  USA       gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 
;;
;; DESCRIPTION
;; 
;; The html-acct-table object is a utility object, not an html object.
;; It is used to collect and then render a table whose leftmost column(s)
;; are a list or chart of accounts.
;; 
;; You start by creating the object and initializing it with a list of
;; accounts and a few assorted parameters.  It generates a table, which
;; can be read using accessor functions, containing information which
;; makes it easy(ier) to create a great variety of html-table forms.
;; 
;;               add-accounts            add-account-balances
;;  account-list ------------> html-acct-table ----------> html-table
;;
;;    Figure Key:
;;
;;       account-list: a list of accounts as would be returned from
;;       looking up the value of a report option added with
;;       gnc:options-add-account-selection!
;;
;;       add-accounts: any method that adds the account list to the
;;       html-acct-table.  For example, this could be accomplished
;;       with gnc:make-html-acct-table/env/acct or
;;       gnc:html-acct-table-add-accounts!
;;
;;       html-acct-table: the utility object described in this file
;;
;;       add-account-balances: any function that maps the internal
;;       data of the html-acct-table object into a html-table.  For
;;       example, one such function is
;;       gnc:html-table-add-account-balances.
;;
;;       html-table: an <html-table> scheme object representing an
;;       HTML table block.  See html-table.scm.
;;
;; This utility object was written because of some shortcomings
;; inherent in how the gnc:html-build-acct-table function was
;; designed.  Ultimately, the intent is to replace
;; gnc:html-build-acct-table with an html-acct-table with the
;; appropriate thunks.  But, because this is new, I'm leaving the
;; original gnc:html-build-acct-table in place, just to be safe.
;;
;;
;; ARGUMENTS
;; 
;; For boolean arguments, #t and #f have their usual meanings.  If a
;; boolean argument is not set, a default value may be assumed.  For
;; non-boolean arguments, values may be specified.  When #f is
;; specified as the value of a non-boolean argument, it generally
;; means to omit whatever function the argument controls.  When #t is
;; specified for such an argument, it generally means to use that
;; functionality, but just accept whatever default functionality that
;; option may have.
;; 
;; The list of accounts which are to be placed in the
;; gnc:html-acct-table object can be controlled with the
;; gnc:make-html-acct-table/accts, gnc:make-html-acct-table/env/accts,
;; and gnc:html-table-add-accts!  functions.  But you should only use
;; one of these methods to add accounts.
;; 
;; The gnc:html-acct-table parameters should be set BEFORE adding the
;; account list.  They can be set with gnc:make-html-acct-table/env
;; or gnc:make-html-acct-table/accts/env and fetched with
;; gnc:html-acct-table-env; accept the following parameters:
;; 
;;     display-tree-depth: integer 'unlimited ['all] #f
;; 
;;         the number of levels of accounts to display
;;         'unlimited, 'all, and #f impose no depth limit.
;;         the default is 'all.  [CAS: ISTM, the default is actually #f,
;;         and this case bombs at (< logi-depth depth-limit) anytime the
;;         limit behavior is not 'flatten.  BUG?   Also, setting this
;;         parameter to a large integer value has the strange side-effect
;;         of pushing the balances column far right, even when the account
;;         tree is relatively shallow.]
;; 
;;     depth-limit-behavior: ['summarize] 'flatten 'truncate
;; 
;;         when the display tree reaches its depth limit, this option
;;         tells gnc:html-acct-table what to do.  'summarize tells it
;;         to omit accounts below the depth limit and summarize their
;;         contents as belonging to their parent account at the depth
;;         limit. 'flatten tells it to display every selected
;;         subaccount, all the way down the tree, but to position
;;         them, in the chart, at the depth limit. the default value
;;         is 'summarize
;; 
;;     initial-indent: integer
;; 
;;         the number of table cells to indent the first level of
;;         accounts displayed. this is merely a convenience.  the
;;         default initial-indent is 0.
;; 
;;     account-less-p: binary_predicate #t #f
;; 
;;         used for sorting accounts, below each parent account, into
;;         the order in which they will be displayed.  the function
;;         must take two Account arguments and represent a total
;;         ordering on Account-space.  #t means to use the default
;;         sorting function.  #f means to perform no sorting.  the
;;         default sorting function is gnc:account-code-less-p.
;; 
;;     start-date: time64
;; 
;;         the starting date of the reporting period over which to
;;         report balances for this account.  if start-date is #f,
;;         will be no limit on how early a counted transaction may
;;         occur.
;; 
;;     end-date: time64
;; 
;;         the ending date of the reporting period over which to
;;         report balances for this account.  if end-date is #f, there
;;         will be no limit on how late a counted transaction may
;;         occur. note: i do not know if GnuCash, right now, supports
;;         transactions in the future. so be prepared for the
;;         possibility that this may match transactions which haven't
;;         occurred, yet. [CAS: I don't think end-date of #f works.
;;         It bombs.]
;; 
;;     report-commodity: commodity
;; 
;;         the commodity into which to convert any balances containing
;;         foreign currencies.  the balance will be converted using
;;         the exchange function exchange-fn. the default is the
;;         currency returned by (gnc-default-report-currency).  [CAS:
;;         what if I don't want the report to have a
;;         "report-commodity"?  Say e.g. I want to show each account
;;         balance in its native commodity?  I can see the benefit of
;;         individual reports that have a report-commodity using
;;         gnc-default-report-currency to set the default value for a
;;         report-commodity option.  But, with the default sucked in
;;         here, in what is supposed to be a more general api, means
;;         reports can't specify NO report-commodity. ]
;;
;; CAS: Hypothetical design modification: Instead of specifying a
;; single report commodity and exchange-fn for the whole acct-table,
;; what if we were allowed to specify a *price-source* and an
;; *optional* report-commodity.  Then, if the no report commodity is
;; specified, then we can generate the exchange-fn on a per-account
;; basis, using gnc:case-exchange-fn and the account's native
;; commodity and the given price-source.  Otherwise (i.e. if there IS
;; a report-commodity specified), we can use *that* commodity for each
;; account's exchange-fn.
;;
;;     exchange-fn: commodity_exchange_function
;; 
;;         the commodity exchange function (you know, that weighted
;;         average, most recent, nearest in time fun stuff) used to
;;         convert balances which are not exclusively in the report
;;         commodity into the report commodity.  [CAS: Right now,
;;         exchange-fn is not optional.  If your accounts have
;;         different commodities and you don't specify a valid
;;         exchange function then simply adding the accounts to the
;;         html-acct-table object will crash, even if you never want
;;         to display any values at all.  This is bad.  UPDATE: As a
;;         short-term fix, I've made this parameter optional.  If no
;;         exchange-fn is given, you can at least add the accounts to
;;         the html-acct-table object without crashing.  Just don't
;;         count on meaningful report-comm-{account|recursive}-bal
;;         values (they'll also be #f).]
;;
;;     column-header: html-table-header-cell #f #t
;; 
;;          the table column header cell (TH tag) with which to head
;;          the columns containing the account tree.  if supplied, the
;;          header cell may contain style information.  if #f, no
;;          column header cell will be used.  if #t, a default header
;;          cell (reading "Account") will be used.  the colspan of any
;;          header cell will be automatically set appropriately. this
;;          is for convenience only; gnc:html-acct-table does not use
;;          this data.
;; 
;;     account-label-mode: 'name 'anchor
;; 
;;          tells whether to render account labels as hyperlinks or
;;          text.  stylesheets, really, should be able to remove
;;          link markup.
;; 
;;     parent-account-subtotal-mode: #t #f 'canonically-tabbed
;; 
;;          indicates whether or not to add a line, recursively
;;          subtotalling an account and its descendents, for any
;;          account with children (non-leaf account).  if #t or
;;          #canonically-tabbed, a subtotal row will be created for
;;          each non-leaf account.  if #f, no non-leaf account
;;          subtotal rows will be created.  if 'canonically-tabbed,
;;          account total entry labels will be placed at the position
;;          specified by accounting texts (indented one column from
;;          the accounts being totalled, two columns from where
;;          gnc:html-acct-table would otherwise place them). the
;;          default is #f.
;; 
;;     zero-balance-mode: 'show-leaf-acct 'omit-leaf-acct
;; 
;;          indicates what to do with accounts with zero balance. if
;;          'omit-leaf-acct, no account row will be generated for any
;;          account having a balance of zero. otherwise, a row will be
;;          generated for the account.
;; 
;;     balance-mode: 'pre-adjusting 'pre-closing 'post-closing
;;
;;          indicates whether or not to ignore adjusting/closing
;;          entries when computing account balances. 'pre-closing
;;          ignores only closing entries. 'pre-adjusting also ignores
;;          adjusting entries. 'post-closing counts all entries.
;; 
;;     adjusting-pattern: alist of 'str 'cased 'regexp
;; 
;;          a pattern alist, as accepted by
;;          gnc:account-get-trans-type-balance-interval, matching
;;          adjusting transactions to be ignored when balance-mode is
;;          'pre-adjusting.
;; 
;;     closing-pattern: alist of 'str 'cased 'regexp
;; 
;;          a pattern alist, as accepted by
;;          gnc:account-get-trans-type-balance-interval, matching
;;          closing transactions to be ignored when balance-mode is
;;          'pre-closing.
;;
;;     report-budget: budget
;;
;;	    (optional) a budget used to ignore accounts with zero 
;;	    budget or balance (if zb-balance-mode is set to omit).
;; 
;;     account-type: unimplemented
;;     account-class: unimplemented
;;     row-thunk: unimplemented (for gnc:html-acct-table-render)
;;     row-list: unimplemented (list of all the rows ever added)
;; 
;; The html-acct-table object lets you generate, store, and access the
;; following parameters:
;; 
;;     account: Account
;; 
;;         the account in the current row
;; 
;;     account-parent: Account #f
;; 
;;         the parent account of the current account, if one exists.
;;         #f if the current account has no parent.
;; 
;;     account-guid: guid
;; 
;;         the guid of the account in the current row, as returned by
;;         gncAccountGetGUID.
;; 
;;     account-desc: string?
;; 
;;         the account description of the account in the current row,
;;         as returned by xaccAccountGetDescription.
;; 
;;     account-notes: string?
;; 
;;         the account notes of the account in the current row, as
;;         returned by xaccAccountGetNotes.
;; 
;;     account-path: string
;; 
;;         the full name of the account in the current row. i.e., if
;;         the name of the account is "Assets:Current Assets:Cash",
;;         the value will be "Assets:Current Assets:Cash".
;; 
;;     account-name: string
;; 
;;         the "basename" of the account in the current row. i.e., if
;;         the name of the account is "Assets:Current Assets:Cash",
;;         the value will be "Cash".
;; 
;;     account-code: string
;; 
;;         the account of the account in the current row, as returned
;;         by xaccAccountGetCode.
;; 
;;     account-anchor: text(maybe?)
;; 
;;         a link to the account in the current row
;; 
;;     account-label: string
;; 
;;         the text used to label the account in the current row.  if
;;         account-label-mode is 'name, this consists of account-name
;;         prepended, if row-type is 'subtotal-row, by "Total ".  if
;;         account-label-mode is 'anchor, this consists of
;;         account-anchor prepended, if row-type is 'subtotal-row, by
;;         "Total ".
;; 
;;     account-depth: integer
;; 
;;         the depth at which the account in the current row resides
;;         in the account tree. note that this may differ from
;;         display-depth when depth-limit-behavior is 'flatten.
;;         unlike in gnc:html-build-acct-table, the first level of
;;         accounts is level 0.
;; 
;;     logical-depth: integer
;; 
;;         the depth at which the account in the current row resides
;;         in the effective account tree.  this is the depth the
;;         account tree when ignoring unselected parent accounts.
;;         note that this may differ from account-depth when a
;;         selected account has an unselected ancestor.
;; 
;;     display-depth: integer
;; 
;;         the depth at which the account in the current row resides
;;         in the display tree. note that this may differ from
;;         account-depth when depth-limit-behavior is 'flatten.
;;         unlike in gnc:html-build-acct-table, the first level of
;;         accounts is level 0. this means that display-depth is also
;;         the number of empty cells which should precede the account
;;         name in the gnc:html-table being generated.
;; 
;;     indented-depth: integer
;; 
;;         the depth at which the account in the current row resides
;;         in the indented display tree. also account-depth plus
;;         indent.  CAS: I think *display-depth* plus indent would
;;         make more sense.  Then it's like an absolute column index.
;; 
;;     logical-cols: integer
;; 
;;         the number of columns in which account labels were placed.
;; 
;;     label-cols: integer
;; 
;;         the number of columns in the group of account columns to
;;         which a row was assigned.  also one more than the maximum
;;         column depth at which rows were positioned in the
;;         table. this value may be different from logical-cols when
;;         parent-account-subtotal-mode is 'canonically-tabbed.
;; 
;;     account-cols: integer
;; 
;;         the number of columns in the group of account columns.  if
;;         display-tree-depth is #f, this is the value of label-cols
;;         plus any indent.  if display-tree-depth is set, this is the
;;         value of display-tree-depth, plus indent plus zero, if
;;         parent-account-subotal-mode is not 'canonically-tabbed, or,
;;         if parent-account-subtotal-mode is 'canonically-tabbed,
;;         plus one.  don't you just love english?
;; 
;;     account-colspan: integer
;; 
;;         the number of table columns which the account label of the
;;         account in the current row should span in the
;;         gnc:html-table being generated.
;; 
;;     account-children: list of Accounts
;; 
;;         a list of all children of the account in the current row.
;; 
;;     account-bal: commodity-collector
;; 
;;         the balance of the account in the current row, exclusive of
;;         any balances in any subaccounts.  this is for convenience.
;; 
;;     recursive-bal: commodity-collector
;; 
;;         the balance of the account in the current row, recursively
;;         including all balances in any *selected* subaccounts.  this
;;         is for convenience.
;; 
;; CAS: I think these next two are wrong because they are really of
;; type gnc:monetary, not commodity-collectors.
;;
;;     report-comm-account-bal: commodity-collector
;; 
;;         the balance of the account in the current row, exclusive of
;;         any balances in any subaccounts, converted to
;;         report-commodity using exchange-fn.  this is for
;;         convenience.
;; 
;;     report-comm-recursive-bal: commodity-collector
;; 
;;         the balance of the account in the current row, recursively
;;         including all balances in any *selected* subaccounts,
;;         converted to report-commodity using exchange-fn.  this is
;;         for convenience.
;; 
;;     account-commodity: commodity
;; 
;;         returns the default commodity of the account in the current
;;         row, as returned by xaccAccountGetCommodity. 
;; 
;;     account-type: account_type
;; 
;;         returns the type of the account in the current row
;; 
;;     account-type-string: string
;; 
;;         returns the type of the account in the current row as a
;;         string
;; 
;;     row-type: 'account-row 'subtotal-row 
;; 
;;         indicates the nature of the current row.  'account-row
;;         indicates that the current row represents an account
;;         balance.  'subtotal-row indicates that it represents a
;;         subtotal.
;; 
;; 
;; DIFFERENCES FROM PARAMETERS USED BY gnc:html-build-acct-table
;; 
;; The show-subaccounts? option of gnc:html-build-acct-table, which
;; used to select an accounts recursively like the "-R" option to ls,
;; has been removed.  I find it both confusing, as a user, and
;; obfuscating, as a programmer.  Any accounts which are to be
;; included in the report may be selected in the Accounts options
;; widget.  While, when selecting whole subtrees of accounts, this may
;; be tedious, this really is a GUI problem.  The ideal solution would
;; be to give the Account selection widget a "recursively select"
;; option which selects (i.e., highlights) both the account selected and
;; all its subaccounts.  Note that, as a worst-case workaround, the
;; user could always use the spacebar and arrow keys to select entire
;; subtrees rather rapidly.  It order to make this shortcoming as
;; benign as possible, reports are advised to make the default account
;; selection that which is closest to what the report user is likely
;; to select.  It is my hope that a recursive account selection widget
;; will soon be implemented.
;; 
;; The group-types? option of gnc:html-build-acct-table, which
;; would display accounts by account type and supply header and
;; total lines for each type (see source), has been removed.
;; It is easy enough to duplicate this functionality, report-side,
;; using the new gnc:html-acct-table object.
;;
;; The start-percent and delta-percent options of
;; gnc:html-build-acct-table, which told the function to
;; gnc:report-percent-done start-percent to
;; (start-percent+start-delta) percent of the progress bar, has been
;; removed.  Most of the report building is done while reading the
;; gnc:html-acct-table object, anyway, so this is not a great loss.
;; This functionality should, however, be included as the amount of
;; work required to build an gnc:html-acct-table object is
;; non-trivial.  Being non-critical as it is, this is left as a future
;; project.  Since much of the code for this has already been written
;; (in gnc:html-build-acct-table), when the time comes, this
;; functionality should not be difficult to add.
;; 
;; 
;; INTERNALS
;; 
;; Internally, html-acct-table uses an html-table object to store
;; data.  Since the html-acct-table object is arguably a more general
;; class than html-table, one might think that the html-table object
;; should be written to use an html-acct-table for data storage,
;; manipulation, and access.  The html-table class, as it happens, was
;; written first, so the decision was made to use it rather than
;; redesign the horse around the carriage.
;; 
;; It may also be possible to have made html-acct-table a markup/style
;; sheet pair.  To do this, the html-acct-table (which would
;; essentially be a markup object) would have to store thunks and call
;; them when rendering its contents to its parent html-doc.  This
;; means that report code would be called during stylization, rather
;; than while building the report.  Making html-acct-table a utility
;; object means that one can use it in a report generator in a
;; programmatic manner, keeping clear the separation between report
;; generation and stylization.
;; 
;; The first cell in each row of the html-table consist of an a-list
;; of row-parameters.  These parameters are described in PARAMETERS
;; above.  Any remaining cells in the row represent data set by the
;; user.  This class simply maps its contents to the html-table.
;; 

(use-modules (srfi srfi-2))
(use-modules (srfi srfi-9))

;; this is to work around a bug in the HTML export sytmem
;; which causes COLSPAN= attributes not to be exported (!!)
(define gnc:colspans-are-working-right
  ;; should be deprecated
  #f)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  <html-acct-table> class
;;  utility class for generating account tables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-record-type <html-acct-table>
  (gnc:_make-html-acct-table_ matrix env)
  gnc:html-acct-table?
  (matrix gnc:_html-acct-table-matrix_ gnc:_html-acct-table-set-matrix!_)
  (env gnc:_html-acct-table-env_ gnc:_html-acct-table-set-env!_))

(define (gnc:make-html-acct-table)
  (gnc:_make-html-acct-table_ (gnc:make-html-table) #f))

(define (gnc:make-html-acct-table/env env)
  (let ((acct-table (gnc:make-html-acct-table)))
    (gnc:html-acct-table-set-env! acct-table env)
    acct-table))

(define (gnc:make-html-acct-table/env/accts env accts)
  (let ((acct-table (gnc:make-html-acct-table)))
    ;; the env must be set *before* the accounts...  because the env
    ;; parameter end-date is required by
    ;; gnc:html-acct-table-add-accounts!.
    (gnc:_html-acct-table-set-env!_ acct-table env)
    (gnc:html-acct-table-add-accounts! acct-table accts)
    acct-table))

;; some useful predicates to export
(define (gnc:account-code-less-p a b)
  (string<? (xaccAccountGetCode a)
	    (xaccAccountGetCode b)))
(define (gnc:account-name-less-p a b)
  (string<? (xaccAccountGetName a)
	    (xaccAccountGetName b)))
(define (gnc:account-path-less-p a b)
  (string<? (gnc-account-get-full-name a)
	    (gnc-account-get-full-name b)))


(define (gnc:html-acct-table-add-accounts! acct-table accounts)
  ;; 
  ;; This is where most of the html-acct-table functionality ends up....
  ;; 
  ;; This function traverses the (current) account tree, adding
  ;; information about the selected accounts to acct-table.
  ;; 
  
  ;; helper for fetching values from the key/val environment alist
  (define (get-val alist key)
    (let ((lst (assoc-ref alist key)))
      (and lst (car lst))))

  ;; helper to plop <env> in the next available env cell
  (define (add-row env)
    (let* ((html-table (gnc:_html-acct-table-matrix_ acct-table))
           (row (gnc:html-table-num-rows html-table)))
      (gnc:html-table-set-cell! html-table row 0 env)
      row))

  ;; Add more stuff to an existing row
  (define (append-to-row row env)
    (gnc:html-acct-table-set-row-env! acct-table row
      (append (gnc:html-acct-table-get-row-env acct-table row) env)))

  (let* ((env (gnc:_html-acct-table-env_ acct-table))
	 ;; establish all input parameters and their defaults 
	 (depth-limit (let ((lim (get-val env 'display-tree-depth)))
                        (and (number? lim) lim)))
	 (limit-behavior (or (get-val env 'depth-limit-behavior) 'summarize))
	 (indent (or (get-val env 'initial-indent) 0))
	 (less-p (let ((pred (get-val env 'account-less-p)))
		   (if (eq? pred #t) gnc:account-code-less-p pred)))
	 (start-date (get-val env 'start-date))
	 (end-date (or (get-val env 'end-date)
		       (gnc:get-today)))
	 (report-commodity (or (get-val env 'report-commodity)
			       (gnc-default-report-currency)))
         ;; BUG: other code expects a real function here, maybe
         ;; someone was thinking price-source?
	 (exchange-fn (get-val env 'exchange-fn))
         (get-balance-fn (get-val env 'get-balance-fn))
	 (column-header (let ((cell (get-val env 'column-header)))
			  (if (eq? cell #t)
			      (gnc:make-html-table-cell "Account name")
			      cell)))
	 (subtotal-mode (get-val env 'parent-account-subtotal-mode))
	 (zero-mode (let ((mode (get-val env 'zero-balance-mode)))
		      (if (boolean? mode) 'show-leaf-acct mode)))
	 (label-mode (or (get-val env 'account-label-mode) 'anchor))
	 (balance-mode (or (get-val env 'balance-mode) 'post-closing))
	 (closing-pattern (or (get-val env 'closing-pattern)
			      (list
			       (list 'str (_ "Closing Entries"))
			       (list 'cased #f)
			       (list 'regexp #f)
			       (list 'closing #t))))
	 (adjusting-pattern (or (get-val env 'adjusting-pattern)
				(list
				 (list 'str (_ "Adjusting Entries"))
				 (list 'cased #f)
				 (list 'regexp #f))))
	 (report-budget (or (get-val env 'report-budget) #f))
	 ;; local variables
	 (toplvl-accts
	  (gnc-account-get-children-sorted (gnc-get-current-root-account)))
	 (acct-depth-reached 0)
	 (logi-depth-reached (if depth-limit (- depth-limit 1) 0))
	 (disp-depth-reached 0)
	 )

    ;; the following function was adapted from html-utilities.scm

    ;; helper to calculate the balances for all required accounts
    (define (calculate-balances accts start-date end-date get-balance-fn)
      (define ret-hash (make-hash-table))
      (define (calculate-balances-helper)
        (for-each
         (lambda (acct)
           (hash-set! ret-hash (gncAccountGetGUID acct)
                      (get-balance-fn acct start-date end-date)))
         accts))

      (define (calculate-balances-simple)
        (define (merge-splits splits subtract?)
          (for-each
           (lambda (split)
             (let* ((acct (xaccSplitGetAccount split))
                    (guid (gncAccountGetGUID acct))
                    (acct-comm (xaccAccountGetCommodity acct))
                    (shares (xaccSplitGetAmount split))
                    (hash (hash-ref ret-hash guid)))
               (unless hash
                 (set! hash (gnc:make-commodity-collector))
                 (hash-set! ret-hash guid hash))
               (hash 'add acct-comm (if subtract? (- shares) shares))))
           splits))

        (merge-splits (gnc:account-get-trans-type-splits-interval
                       accts #f start-date end-date)
                      #f)

        (case balance-mode
          ((post-closing) #f)

          ;; remove closing entries
          ((pre-closing)
           (merge-splits (gnc:account-get-trans-type-splits-interval
                          accts closing-pattern start-date end-date) #t))

          ;; remove closing and adjusting entries
          ((pre-adjusting)
           (merge-splits (gnc:account-get-trans-type-splits-interval
                          accts closing-pattern start-date end-date) #t)
           (merge-splits (gnc:account-get-trans-type-splits-interval
                          accts adjusting-pattern start-date end-date) #t))

          (else
           (display "you fail it\n"))))

      (if get-balance-fn
          (calculate-balances-helper)
          (calculate-balances-simple))
      ret-hash)

    (define (traverse-accounts! accts acct-depth logi-depth new-balances)

      (define (use-acct? acct)
        (and (or (eq? limit-behavior 'flatten)
                 (< logi-depth depth-limit))
             (member acct accounts)))

      ;; helper function to return a cached balance from a list of
      ;; ( acct . balance ) cells
      (define (get-balance acct-balances acct)
        (let ((this-collector (gnc:make-commodity-collector))
              (acct-coll (hash-ref acct-balances (gncAccountGetGUID acct)
                                   (gnc:make-commodity-collector))))
          (this-collector 'merge acct-coll #f)
          this-collector))

      ;; helper function that returns a cached balance from a list of
      ;; ( acct . balance) cells for the given account *and* its
      ;; sub-accounts.
      (define (get-balance-sub acct-balances account)
        (let ((this-collector (gnc:make-commodity-collector)))
          (for-each
           (lambda (acct)
             (this-collector 'merge (get-balance acct-balances acct) #f))
           (gnc:accounts-and-all-descendants (list account)))
          this-collector))

      (let lp ((accounts (if less-p (sort accts less-p) accts))
               (row-added? #f)
               (disp-depth (if (integer? depth-limit)
                               (min (1- depth-limit) logi-depth)
                               logi-depth)))

        (cond

         ((null? accounts) row-added?)

         (else
          (let* ((acct (car accounts))
                 (subaccts (gnc-account-get-children-sorted acct))

                 ;; These next two are commodity-collectors.
                 (account-bal (get-balance new-balances acct))
                 (recursive-bal (get-balance-sub new-balances acct))

                 ;; These next two are of type <gnc:monetary>
                 (report-comm-account-bal
                  (gnc:sum-collector-commodity
                   account-bal report-commodity exchange-fn))
                 (report-comm-recursive-bal
                  (gnc:sum-collector-commodity
                   recursive-bal report-commodity exchange-fn))

                 (grp-env
                  (cons*
                   (list 'initial-indent indent)
                   (list 'account acct)
                   (list 'account-name (xaccAccountGetName acct))
                   (list 'account-code (xaccAccountGetCode acct))
                   (list 'account-type (xaccAccountGetType acct))
                   (list 'account-type-string (xaccAccountGetTypeStr
                                               (xaccAccountGetType acct)))
                   (list 'account-guid (gncAccountGetGUID acct))
                   (list 'account-description (xaccAccountGetDescription acct))
                   (list 'account-notes (xaccAccountGetNotes acct))
                   (list 'account-path (gnc-account-get-full-name acct))
                   (list 'account-parent (gnc-account-get-parent acct))
                   (list 'account-children subaccts)
                   (list 'account-depth acct-depth)
                   (list 'logical-depth logi-depth)
                   (list 'account-commodity (xaccAccountGetCommodity acct))
                   (list 'account-anchor (gnc:html-account-anchor acct))
                   (list 'account-bal account-bal)
                   (list 'recursive-bal recursive-bal)
                   (list 'report-comm-account-bal report-comm-account-bal)
                   (list 'report-comm-recursive-bal report-comm-recursive-bal)
                   (list 'report-commodity report-commodity)
                   (list 'exchange-fn exchange-fn)
                   env))
                 (label (case label-mode
                          ((anchor) (gnc:html-account-anchor acct))
                          ((name) (gnc:make-html-text (xaccAccountGetName acct)))))
                 (row #f)
                 (children-displayed? #f))

            (set! acct-depth-reached (max acct-depth-reached acct-depth))
            (set! logi-depth-reached (max logi-depth-reached logi-depth))
            (set! disp-depth-reached (max disp-depth-reached disp-depth))

            (unless (or (not (use-acct? acct))
                        ;; ok, so we'll consider parent accounts with zero
                        ;; recursive-bal to be zero balance leaf accounts
                        (and (gnc-commodity-collector-allzero? recursive-bal)
                             (eq? zero-mode 'omit-leaf-acct)
                             (or (not report-budget)
                                 (zero? (gnc:budget-account-get-rolledup-net
                                         report-budget acct #f #f)))))
              (set! row
                (add-row
                 (cons* (list 'account-label label)
                        (list 'row-type 'account-row)
                        (list 'display-depth disp-depth)
                        (list 'indented-depth (+ disp-depth indent))
                        grp-env))))

            ;; Recurse:
            ;; Dive into an account even if it isn't selected!
            ;; why? because some subaccts may be selected.
            (set! children-displayed?
              (traverse-accounts! subaccts
                                  (1+ acct-depth)
                                  (if (use-acct? acct)
                                      (1+ logi-depth)
                                      logi-depth)
                                  new-balances))

            ;; record whether any children were displayed
            (when row
              (append-to-row
               row (list (list 'children-displayed? children-displayed?))))

            ;; after the return from recursion: subtotals
            (unless (or (not (use-acct? acct))
                        (not subtotal-mode)
                        (not children-displayed?)
                        (and (gnc-commodity-collector-allzero? recursive-bal)
                             (eq? zero-mode 'omit-leaf-acct)))
              (let ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
                (apply gnc:html-text-append! lbl-txt (gnc:html-text-body label))
                (if (eq? subtotal-mode 'canonically-tabbed)
                    (set! disp-depth (+ disp-depth 1))
                    (set! disp-depth-reached (max disp-depth-reached disp-depth)))
                (add-row
                 (cons* (list 'account-label lbl-txt)
                        (list 'row-type 'subtotal-row)
                        (list 'display-depth disp-depth)
                        (list 'indented-depth (+ disp-depth indent))
                        grp-env))))

            (lp (cdr accounts)
                (or row-added? children-displayed? row)
                disp-depth))))))

    ;; do it
    (traverse-accounts!
     toplvl-accts 0 0
     (calculate-balances accounts start-date end-date get-balance-fn))

    ;; now set the account-colspan entries
    (let lp ((row 0)
             (rows (gnc:html-acct-table-num-rows acct-table)))
      (when (< row rows)
        (let* ((orig-env (gnc:html-acct-table-get-row-env acct-table row))
               (display-depth (get-val orig-env 'display-depth))
               (depth-limit (get-val orig-env 'display-tree-depth))
               (indent (get-val orig-env 'initial-indent))
               (indented-depth (get-val orig-env 'indented-depth))
               (subtotal-mode (get-val orig-env 'parent-account-subtotal-mode))
               (label-cols (+ disp-depth-reached 1))
               ;; these parameters *should* always, by now, be set...
               (new-env
                (cons*
                 (list 'account-colspan (- label-cols display-depth))
                 (list 'label-cols label-cols)
                 (list 'account-cols (+ indent (max label-cols (or depth-limit 0))))
                 (list 'logical-cols (min (+ logi-depth-reached)
                                          (or depth-limit +inf.0)))
                 orig-env)))
          (gnc:html-acct-table-set-row-env! acct-table row new-env)
          (lp (1+ row) rows))))))

(define (gnc:html-acct-table-num-rows acct-table)
  (gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table)))

(define (gnc:html-acct-table-num-cols acct-table)
  (issue-deprecation-warning "gnc:html-acct-table-num-cols is unused.")
  (- (gnc:html-table-num-columns (gnc:_html-acct-table-matrix_ acct-table)) 1))

(define (gnc:html-acct-table-get-cell acct-table row col)
  ;; we'll only ever store one object in an html-table-cell
  ;; returns the first object stored in that cell
  (and-let* ((cell (gnc:html-table-get-cell
                    (gnc:_html-acct-table-matrix_ acct-table) row (1+ col))))
    (car (gnc:html-table-cell-data cell))))

(define (gnc:html-acct-table-set-cell! acct-table row col obj)
  (gnc:html-table-set-cell!
   (gnc:_html-acct-table-matrix_ acct-table)
   row (+ col 1)
   obj))

(define (gnc:html-acct-table-get-row-env acct-table row)
  (gnc:html-acct-table-get-cell acct-table row -1)
  )

(define (gnc:html-acct-table-set-row-env! acct-table row env)
  (gnc:html-acct-table-set-cell! acct-table row -1 env))

(define (gnc:html-acct-table-append-row! acct-table newrow)
  (issue-deprecation-warning "gnc:html-acct-table-append-row! is unused.")
  (gnc:html-table-append-row!
   (gnc:_html-acct-table-matrix_ acct-table)
   (map
    (lambda (x) (gnc:make-html-table-cell (list x)))
    newrow)))

(define (gnc:html-acct-table-prepend-row! acct-table newrow)
  (issue-deprecation-warning "gnc:html-acct-table-prepend-row! is unused.")
  (gnc:html-table-prepend-row!
   (gnc:_html-acct-table-matrix_ acct-table)
   (map
    (lambda (x) (gnc:make-html-table-cell (list x)))
    newrow)))

(define (gnc:html-acct-table-append-col! acct-table newcol)
  (issue-deprecation-warning "gnc:html-acct-table-append-col! is unused.")
  (gnc:html-table-append-col!
   (gnc:_html-acct-table-matrix_ acct-table)
   (map
    (lambda (x) (gnc:make-html-table-cell (list x)))
    newcol)))

(define (gnc:html-acct-table-prepend-col! acct-table newrow)
  (issue-deprecation-warning "gnc:html-acct-table-prepend-col! is unused.")
  (gnc:html-table-prepend-col!
   (gnc:_html-acct-table-matrix_ acct-table)
   (map
    (lambda (x) (gnc:make-html-table-cell (list x)))
    newcol)))

(define (gnc:html-acct-table-remove-last-row! acct-table)
  (issue-deprecation-warning "gnc:html-acct-table-remove-last-row! is unused.")
  (gnc:html-table-remove-last-row! (gnc:_html-acct-table-matrix_ acct-table)))

(define (gnc:html-acct-table-render acct-table doc)
  ;; this will be used if we ever decide to let the utility object
  ;; render a document by calling thunks registered in the row-envs...
  ;; but, for now, this (optional) feature is left unimplemented...
  (issue-deprecation-warning "gnc:html-acct-table-render is unused.")
  #f
  )

;; 
;; Here are some standard functions to help process gnc:html-acct-tables.
;; 

(define (gnc:html-make-nbsps n)
  (let lp ((n n) (res '()))
    (if (positive? n)
        (lp (1- n) (cons "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" res))
        (string-join res ""))))

;; Stylesheets define the following cell styles which these functions
;; use: "text-cell" "total-label-cell" "number-cell"
;; "total-number-cell".  Row styles include "normal-row",
;; "alternate-row", "primary-subheading", "secondary-subheading", and
;; "grand-total".
;; There really should also be a "first-number-cell"
;; and "last-number-cell" to put currency symbols and underlines,
;; respectively, on the numbers.

;; Note: arguably, this procedure belongs in html-table.scm instead of here.
(define (gnc:html-table-add-labeled-amount-line!
         ;; function to add a label and/or amount (which we'll call a "line")
         ;; to the end of a gnc:html-table. all depths are zero-indexed.
	 html-table
         table-width       ;; if #f defaults to (amount-depth + amount-colspan)
         row-markup        ;; optional
         total-rule?       ;; Place an <hr> in the cell previous to label?
	 label             ;; the actual label text
         label-depth       ;; defaults to zero
         label-colspan     ;; defaults to one
         label-markup      ;; optional
	 amount            ;; a <gnc:monetary> or #f
         amount-depth      ;; defaults to (label-depth + label-colspan)
         amount-colspan    ;; defaults to one
         amount-markup)    ;; optional
  (let* ((lbl-depth (or label-depth 0))
	 (lbl-colspan 1)
	 (amt-depth (or amount-depth (+ lbl-depth lbl-colspan)))
	 (amt-colspan 1)
	 (tbl-width (or table-width (+ amt-depth amt-colspan)))
	 (row
	  (append
	   (list
	    (if label-markup                      ;; the actual label
		(gnc:make-html-table-cell/size/markup
		 1 1 label-markup (gnc:make-html-text (gnc:html-make-nbsps lbl-depth)) label)
		(gnc:make-html-table-cell/size
		 1 1 (gnc:make-html-text (gnc:html-make-nbsps lbl-depth)) label))
	    )
	   (gnc:html-make-empty-cells             ;; padding after label
            (+ (- amt-depth (floor (/ tbl-width 2)))
               (if total-rule? -1 0)
               )
            )
	   (if total-rule?                        ;; include <hr>?
	       (list (gnc:make-html-table-cell
		      (gnc:make-html-text (gnc:html-markup-hr))))
	       (list)
	       )
	   (list
	    (if amount-markup                     ;; the amount
		(gnc:make-html-table-cell/size/markup
		 1 amt-colspan amount-markup amount)
		(gnc:make-html-table-cell/size
		 1 amt-colspan amount))
	    )
	   (gnc:html-make-empty-cells             ;; padding out to full width
	    (- tbl-width (+ amt-depth amt-colspan)))
	   )
          ) ;; end of row
	 )
    (if row-markup
	(gnc:html-table-append-row/markup! html-table row-markup row)
	(gnc:html-table-append-row! html-table row))))

(define (gnc-commodity-table amount report-commodity exchange-fn)
  ;; this creates a small two-column table listing each commodity
  ;; balance and its respective report balance.  note that this
  ;; shows report-commodity amounts twice: first as a commodity
  ;; and second in the report commodity.  though this may arguably
  ;; be a bit redundant, i believe that it makes the report more
  ;; readable.
  (let* ((table (gnc:make-html-table))
         (spacer (gnc:make-html-table-cell))
         (list-of-balances (amount 'format gnc:make-gnc-monetary #f)))
    (gnc:html-table-cell-set-style! spacer "td"
                                    'attribute (list "style" "min-width: 1em"))
    (for-each
     (lambda (bal)
       (gnc:html-table-append-row!
	table (list (gnc:make-html-table-cell/markup "number-cell" bal)
                    spacer
	            (gnc:make-html-table-cell/markup
                     "number-cell" (exchange-fn bal report-commodity)))))
     list-of-balances)
    (gnc:html-table-set-style! table "table"
                               'attribute (list "style" "width:100%; max-width:20em")
                               'attribute (list "cellpadding" "0"))
    table))

;; 
;; This function adds all the lines from a gnc:html-acct-table to a
;; gnc:html-table in "labeled amount" form.  IOW, it uses
;; gnc:html-table-add-labeled-amount-line!
;; 
;; The returned gnc:html-table is similar to what
;; gnc:html-build-acct-table used to (and still should) produce.
;; 
;; this function accepts the following additional parameters:
;; parent-account-balance-mode: 'immediate-bal 'recursive-bal ['omit-bal/#f]
;; zero-balance-display-mode: ['show-balance] 'omit-balance
;; multicommodity-mode: [#f] 'table/#t
;; rule-mode: #t [#f]  (not meant to affect subtotal rules)
;; 
(define (gnc:html-table-add-account-balances
         html-table  ;; can be #f to create a new table
         acct-table
         params)
  (let* ((num-rows (gnc:html-acct-table-num-rows acct-table))
	 (rownum 0)
	 (html-table (or html-table (gnc:make-html-table)))
	 (get-val (lambda (alist key)
		    (let ((lst (assoc-ref alist key)))
		      (if lst (car lst) lst))))
	 )
    
    (while (< rownum num-rows)
	   (let* ((env (append
			(gnc:html-acct-table-get-row-env acct-table rownum)
			params))
		  (acct (get-val env 'account))
		  (children (get-val env 'account-children))
		  (label (get-val env 'account-label))
		  (acct-name (get-val env 'account-name)) ;; for diagnostics...
		  (report-commodity  (get-val env 'report-commodity))
		  (exchange-fn (get-val env 'exchange-fn))
		  (account-cols (get-val env 'account-cols))
		  (logical-cols (get-val env 'logical-cols))
		  (label-cols (get-val env 'label-cols))
		  (logical-depth (get-val env 'logical-depth))
		  (display-depth (get-val env 'display-depth))
		  (display-tree-depth (get-val env 'display-tree-depth))
		  (subtotal-mode (get-val env 'subtotal-mode))
		  (row-type (get-val env 'row-type))
		  (rule-mode (and (equal? row-type 'subtotal-row)
				  (get-val env 'rule-mode)))
		  (row-markup (and (equal? row-type 'subtotal-row)
				   "primary-subheading"))
		  (multicommodity-mode (get-val env 'multicommodity-mode))
		  (limit-behavior
		   (or (get-val env 'depth-limit-behavior)
		       'summarize))
		  (parent-acct-bal-mode
		   (or (get-val env 'parent-account-balance-mode)
		       'omit-bal))

                  (bal-method
                   ;; figure out how to calculate our balance:
                   ;; 'immediate-bal|'recursive-bal ('omit-bal handled below)
                   (cond ((eq? row-type 'subtotal-row) 'recursive-bal)
                         ((eq? (1+ display-depth) display-tree-depth)
                          (cond ((eq? limit-behavior 'summarize) 'recursive-bal)
                                ((null? children) 'immediate-bal)
                                (else parent-acct-bal-mode)))
                         ((not (null? children)) parent-acct-bal-mode)
                         (else 'immediate-bal)))

                  (zero-mode (let ((mode (get-val env 'zero-balance-display-mode)))
                               (if (boolean? mode)
                                   'show-balance
                                   mode)))

                  (amt (and-let* ((bal-syms '((immediate-bal . account-bal)
                                              (recursive-bal . recursive-bal)
                                              (omit-bal . #f)))
                                  (bal-sym (assq-ref bal-syms bal-method))
                                  (comm-amt (get-val env bal-sym)))
                         (cond
                          ((and (eq? zero-mode 'omit-balance)
                                (gnc-commodity-collector-allzero? comm-amt)) #f)
                          ((gnc-reverse-balance acct)
                           (gnc:commodity-collector-get-negated comm-amt))
                          (else comm-amt))))

                  (amount
                   (cond
                    ((not amt) #f)
                    ((and (not (gnc:uniform-commodity? amt report-commodity))
                          (eq? multicommodity-mode 'table)
                          (eq? row-type 'account-row))
                     (gnc-commodity-table amt report-commodity exchange-fn))
                    (else
                     (gnc:sum-collector-commodity amt report-commodity exchange-fn))))

                  (indented-depth (get-val env 'indented-depth))
		  (account-colspan (get-val env 'account-colspan))
		  )

             ;; for each row do:

	     (gnc:html-table-add-labeled-amount-line!
	      html-table
	      (+ account-cols logical-cols) ;; table-width
	      row-markup                    ;; row-markup
              rule-mode
	      label
              indented-depth
              account-colspan               ;; label-colspan
              "anchor-cell"                 ;; label-markup
	      amount
	      (+ account-cols (- 0 1)
		 (- logical-cols display-depth)
		 (if (equal? subtotal-mode 'canonically-tabbed) 1 0)
		 )                          ;; amount-depth
	      1                             ;; amount-colspan
              "number-cell"                 ;; amount-markup
              )

	     (set! rownum (+ rownum 1)) ;; increment rownum
	     )
	   ) ;; end of while
    html-table
    )
  )


(define (gnc:second-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?)
  ;; THIS NEW FUNCTION DOES NOT IMPLEMENT SOME FEATURES OF THE OLD ONE
  ;; of these options: start-percent/delta-percent, the balance column
  ;; header, show-total?/get-total-fn/total-name, and group-types? are
  ;; presently unimplemented.  many of these functions are better left
  ;; to the renderer, anyway.  but if you *really* need them, you may
  ;; still use gnc:first-html-build-acct-table.
  (issue-deprecation-warning
   "gnc:second-html-build-acct-table is unused. use gnc:html-build-acct-table.")
  (let* ((env (list
	       (list 'start-date start-date)
	       (list 'end-date end-date)
	       (list 'display-tree-depth tree-depth)
	       ;;(list 'progress-start-percent start-percent)
	       ;;(list 'progress-length-percent delta-percent)
	       (list 'column-header show-col-headers?)
	       (list 'parent-account-subtotal-mode show-parent-total?)
	       (list 'report-commodity report-commodity)
	       (list 'exchange-fn exchange-fn)
	       (list 'zero-balance-display-mode
		     (if show-zero-entries?
			 'show-balance
			 'omit-balance))
	       ))
	 (html-table (gnc:make-html-table))
	 (acct-table (gnc:make-html-acct-table/env/accts env accounts))
	 (params (list
		  (list 'parent-account-balance-mode
			(if show-parent-balance? 'immediate-bal))
		  ))
	 )
    (gnc:html-table-add-account-balances html-table acct-table params)
    html-table
    ))

;; END

