spacepaste

Paste details

reply | raw

  1.  
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; balsheet-pnl.scm: multi-column report. includes
  4. ;; balance-sheet and p&l reports.
  5. ;;
  6. ;; By Christopher Lam, 2018
  7. ;;
  8. ;; Improved from balance-sheet.scm
  9. ;;
  10. ;; This program is free software; you can redistribute it and/or
  11. ;; modify it under the terms of the GNU General Public License as
  12. ;; published by the Free Software Foundation; either version 2 of
  13. ;; the License, or (at your option) any later version.
  14. ;;
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;;
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with this program; if not, contact:
  22. ;;
  23. ;; Free Software Foundation Voice: +1-617-542-5942
  24. ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
  25. ;; Boston, MA 02110-1301, USA gnu@gnu.org
  26. ;;
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29. (define-module (gnucash report standard-reports balsheet-pnl))
  30. (use-modules (gnucash utilities))
  31. (use-modules (gnucash gnc-module))
  32. (use-modules (gnucash gettext))
  33. (use-modules (srfi srfi-1))
  35. (gnc:module-load "gnucash/report/report-system" 0)
  37. (define FOOTER-TEXT
  38. "WARNING: Please be aware these figures are not guaranteed to be correct.
  39. Foreign currency conversions are not confirmed correct. Bug reports
  40. are very welcome at https://bugs.gnucash.org/ or please email the team
  41. at gnucash-devel@gnucash.org. No calculations for capital gains, or
  42. unrealized gains are made. Use the amounts at your own risk.")
  44. ;; define all option's names and help text so that they are properly
  46. (define optname-company-name (N_ "Company name"))
  47. (define opthelp-company-name (N_ "Name of company/individual."))
  49. (define optname-startdate (N_ "Start Date"))
  50. (define optname-enddate (N_ "End Date"))
  52. (define optname-period (N_ "Period duration"))
  53. (define opthelp-period (N_ "Duration between time periods"))
  55. (define optname-dual-columns (N_ "Enable dual columns"))
  56. (define opthelp-dual-columns (N_ "Selecting this option will enable double-column \
  57. reporting."))
  59. (define optname-disable-amount-indent (N_ "Disable amount indenting"))
  60. (define opthelp-disable-amount-indent (N_ "Selecting this option will disable amount indenting, and condense amounts into a single column."))
  62. (define optname-options-summary (N_ "Add options summary"))
  63. (define opthelp-options-summary (N_ "Add summary of options."))
  65. (define optname-account-full-name (N_ "Account full name instead of indenting"))
  66. (define opthelp-account-full-name (N_ "Selecting this option enables full account name instead, and disables indenting account names."))
  68. (define optname-accounts (N_ "Accounts"))
  69. (define opthelp-accounts (N_ "Report on these accounts, if display depth allows."))
  71. (define optname-depth-limit (N_ "Levels of Subaccounts"))
  72. (define opthelp-depth-limit (N_ "Maximum number of levels in the account tree displayed."))
  74. (define optname-parent-balance-mode (N_ "Parent account amounts include children"))
  75. (define opthelp-parent-balance-mode (N_ "If this option is enabled, subtotals are \
  76. displayed within parent amounts, and if parent has own amount, it is displayed on \
  77. the next row as a child account. If this option is disabled, subtotals are displayed \
  78. below parent and children groups."))
  80. (define optname-show-zb-accts (N_ "Include accounts with zero total balances"))
  81. (define opthelp-show-zb-accts (N_ "Include accounts with zero total (recursive) balances in this report."))
  83. (define optname-omit-zb-bals (N_ "Omit zero balance figures"))
  84. (define opthelp-omit-zb-bals (N_ "Show blank space in place of any zero balances which would be shown."))
  86. (define optname-account-links (N_ "Display accounts as hyperlinks"))
  87. (define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window."))
  89. (define optname-amount-links (N_ "Display amounts as hyperlinks"))
  90. (define opthelp-amount-links (N_ "Shows each amounts in the table as a hyperlink to a register or report."))
  92. ;; closing entries filter - for P&L report
  93. (define pagename-entries "Entries")
  94. (define optname-closing-pattern (N_ "Closing Entries pattern"))
  95. (define opthelp-closing-pattern (N_ "Any text in the Description column which identifies closing entries."))
  96. (define optname-closing-casing (N_ "Closing Entries pattern is case-sensitive"))
  97. (define opthelp-closing-casing (N_ "Causes the Closing Entries Pattern match to be case-sensitive."))
  98. (define optname-closing-regexp (N_ "Closing Entries Pattern is regular expression"))
  99. (define opthelp-closing-regexp (N_ "Causes the Closing Entries Pattern to be treated as a regular expression."))
  101. ;; section labels
  102. (define optname-label-sections (N_ "Label sections"))
  103. (define opthelp-label-sections (N_ "Whether or not to include a label for sections."))
  104. (define optname-total-sections (N_ "Include totals"))
  105. (define opthelp-total-sections (N_ "Whether or not to include a line indicating total amounts."))
  107. ;; commodities
  108. (define pagename-commodities (N_ "Commodities"))
  109. (define optname-include-chart (N_ "Enable chart"))
  110. (define opthelp-include-chart (N_ "Enable link to barchart report"))
  112. (define optname-common-currency (N_ "Convert to common currency"))
  113. (define opthelp-common-currency (N_ "Convert all amounts to a single currency."))
  115. (define optname-report-commodity (N_ "Report's currency"))
  117. (define optname-price-source (N_ "Price Source"))
  118. (define opthelp-price-source (N_ "How to determine exchange rates."))
  120. (define optname-show-foreign (N_ "Show Foreign Currencies"))
  121. (define opthelp-show-foreign (N_ "Display any foreign currency amount in an account."))
  123. (define optname-include-overall-period (N_ "If more than 1 period column, include overall period?"))
  124. (define opthelp-include-overall-period (N_ "If several profit & loss period columns are shown, \
  125. also show overall period profit & loss."))
  127. (define optname-show-rates (N_ "Show Exchange Rates"))
  128. (define opthelp-show-rates (N_ "Show the exchange rates used."))
  130. (define trep-uuid "2fe3b9833af044abb929a88d5a59620f")
  131. (define networth-barchart-uuid "cbba1696c8c24744848062c7f1cf4a72")
  132. (define pnl-barchart-uuid "80769921e87943adade887b9835a7685")
  134. (define periodlist
  135. (list
  136. (cons #f (list
  137. (cons 'delta #f)
  138. (cons 'text (_ "disabled"))
  139. (cons 'tip (_ "disable multicolumn"))))
  141. (cons 'year (list
  142. (cons 'delta YearDelta)
  143. (cons 'text (_ "year"))
  144. (cons 'tip (_ "every year"))))
  146. (cons 'halfyear (list
  147. (cons 'delta HalfYearDelta)
  148. (cons 'text (_ "half-year"))
  149. (cons 'tip (_ "every half year"))))
  151. (cons 'quarter (list
  152. (cons 'delta QuarterDelta)
  153. (cons 'text (_ "quarter"))
  154. (cons 'tip (_ "every three months"))))
  156. (cons 'month (list
  157. (cons 'delta MonthDelta)
  158. (cons 'text (_ "month"))
  159. (cons 'tip (_ "every month"))))
  161. (cons 'twoweek (list
  162. (cons 'delta TwoWeekDelta)
  163. (cons 'text (_ "two weeks"))
  164. (cons 'tip (_ "every fortnight"))))
  166. (cons 'week (list
  167. (cons 'delta WeekDelta)
  168. (cons 'text (_ "week"))
  169. (cons 'tip (_ "every 7 days"))))))
  171. (define pricesource-list-common
  172. (list
  173. (cons 'pricedb-latest (list
  174. (cons 'text (_ "Most recent"))
  175. (cons 'tip (_ "The most recent recorded price."))))
  177. (cons 'weighted-average (list
  178. (cons 'text (_ "Weighted Average"))
  179. (cons 'tip (_ "The weighted average of all currency transactions of the past."))))
  180. (cons 'average-cost (list
  181. (cons 'text (_ "Average Cost"))
  182. (cons 'tip (_ "The volume-weighted average cost of purchases."))))))
  184. (define pricesource-list-balsheet
  185. (reverse
  186. (cons
  187. (cons 'pricedb-nearest (list
  188. (cons 'text (_ "Nearest in time"))
  189. (cons 'tip (_ "The price recorded nearest in time to the column date."))))
  190. pricesource-list-common)))
  192. (define pricesource-list-pnl
  193. (reverse
  194. (cons*
  195. (cons 'startperiod (list
  196. (cons 'text (_ "Nearest to start of period"))
  197. (cons 'tip (_ "Prices closest to the start of the reporting period \
  198. are used."))))
  200. (cons 'midperiod (list
  201. (cons 'text (_ "Nearest to mid of period"))
  202. (cons 'tip (_ "Prices in the middle of the reporting period \
  203. are used."))))
  205. (cons 'endperiod (list
  206. (cons 'text (_ "Nearest to end of period"))
  207. (cons 'tip (_ "Prices in the end of the reporting period \
  208. are used."))))
  209. pricesource-list-common))
  211. (define (keylist->vectorlist keylist)
  212. (map
  213. (lambda (item)
  214. (vector
  215. (car item)
  216. (keylist-get-info keylist (car item) 'text)
  217. (keylist-get-info keylist (car item) 'tip)))
  218. keylist))
  220. (define (keylist-get-info keylist key info)
  221. (cdr (assq info (cdr (assq key keylist)))))
  223. (define* (gnc:account-get-balances-at-dates account dates-list #:key ignore-closing?)
  224. (define (amount->monetary bal)
  225. (gnc:make-gnc-monetary (xaccAccountGetCommodity account) bal))
  226. (let loop ((splits (xaccAccountGetSplitList account))
  227. (dates-list dates-list)
  228. (currentbal 0)
  229. (lastbal 0)
  230. (balancelist '()))
  231. (cond
  233. ;; end of dates. job done!
  234. ((null? dates-list)
  235. (map amount->monetary (reverse balancelist)))
  237. ;; end of splits, but still has dates. pad with last-bal
  238. ;; until end of dates.
  239. ((null? splits)
  240. (loop '()
  241. (cdr dates-list)
  242. currentbal
  243. lastbal
  244. (cons lastbal balancelist)))
  246. (else
  247. (let* ((this (car splits))
  248. (rest (cdr splits))
  249. (currentbal (if (and ignore-closing?
  250. (xaccTransGetIsClosingTxn (xaccSplitGetParent this)))
  251. currentbal
  252. (+ (xaccSplitGetAmount this) currentbal)))
  253. (next (and (pair? rest) (car rest))))
  255. (cond
  256. ;; the next split is still before date
  257. ((and next (< (xaccTransGetDate (xaccSplitGetParent next)) (car dates-list)))
  258. (loop rest dates-list currentbal lastbal balancelist))
  260. ;; this split after date, add previous bal to balancelist
  261. ((< (car dates-list) (xaccTransGetDate (xaccSplitGetParent this)))
  262. (loop splits
  263. (cdr dates-list)
  264. lastbal
  265. lastbal
  266. (cons lastbal balancelist)))
  268. ;; this split before date, next split after date, or end.
  269. (else
  270. (loop rest
  271. (cdr dates-list)
  272. currentbal
  273. currentbal
  274. (cons currentbal balancelist)))))))))
  276. ;; options generator
  277. (define (multicol-report-options-generator report-type)
  278. (let* ((options (gnc:new-options))
  279. (book (gnc-get-current-book))
  280. (add-option
  281. (lambda (new-option)
  282. (gnc:register-option options new-option))))
  284. (add-option
  285. (gnc:make-string-option
  286. gnc:pagename-general optname-company-name
  287. "b" opthelp-company-name (or (gnc:company-info book gnc:*company-name*) "")))
  289. ;; date at which to report balance
  290. (gnc:options-add-date-interval!
  291. options gnc:pagename-general optname-startdate optname-enddate "c")
  293. (add-option
  294. (gnc:make-multichoice-callback-option
  295. gnc:pagename-general optname-period
  296. "c2" opthelp-period
  297. #f
  298. (keylist->vectorlist periodlist)
  299. #f
  300. (lambda (x)
  301. (gnc-option-db-set-option-selectable-by-name
  302. options
  303. gnc:pagename-general optname-disable-amount-indent
  304. (not x))
  305. (gnc-option-db-set-option-selectable-by-name
  306. options
  307. gnc:pagename-general optname-dual-columns
  308. (not x))
  309. (gnc-option-db-set-option-selectable-by-name
  310. options
  311. gnc:pagename-general
  312. (case report-type
  313. ((balsheet) optname-startdate)
  314. ((pnl) optname-include-overall-period))
  315. x))))
  317. (add-option
  318. (gnc:make-simple-boolean-option
  319. gnc:pagename-general optname-disable-amount-indent
  320. "c3" opthelp-disable-amount-indent #f))
  322. (add-option
  323. (gnc:make-simple-boolean-option
  324. gnc:pagename-general optname-include-chart
  325. "d" opthelp-include-chart #f))
  327. (add-option
  328. (gnc:make-simple-boolean-option
  329. gnc:pagename-general optname-dual-columns
  330. "c4" opthelp-dual-columns #t))
  332. (add-option
  333. (gnc:make-multichoice-option
  334. gnc:pagename-general optname-options-summary
  335. "d" opthelp-options-summary
  336. 'never
  337. (list (vector 'always
  338. (_ "Always")
  339. (_ "Always display summary."))
  340. (vector 'never
  341. (_ "Never")
  342. (_ "Disable report summary.")))))
  344. ;; accounts to work on
  345. (add-option
  346. (gnc:make-account-list-option
  347. gnc:pagename-accounts optname-accounts
  348. "a"
  349. opthelp-accounts
  350. (lambda ()
  351. (gnc:filter-accountlist-type
  352. (list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT
  353. ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY
  354. ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY
  355. ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE
  356. ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE
  357. ACCT-TYPE-TRADING)
  358. (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
  359. #f #t))
  361. (gnc:options-add-account-levels!
  362. options gnc:pagename-accounts optname-depth-limit
  363. "b" opthelp-depth-limit 'all)
  365. ;; all about currencies
  366. (add-option
  367. (gnc:make-complex-boolean-option
  368. pagename-commodities optname-common-currency
  369. "b" opthelp-common-currency #f #f
  370. (lambda (x)
  371. (for-each
  372. (lambda (optname)
  373. (gnc-option-db-set-option-selectable-by-name
  374. options pagename-commodities optname x))
  375. (list optname-report-commodity
  376. optname-show-rates
  377. optname-show-foreign
  378. optname-price-source)))))
  380. (gnc:options-add-currency!
  381. options pagename-commodities
  382. optname-report-commodity "c")
  384. (add-option
  385. (gnc:make-multichoice-option
  386. pagename-commodities optname-price-source
  387. "d" opthelp-price-source
  388. (case report-type
  389. ((pnl) 'midperiod)
  390. ((balsheet) 'pricedb-nearest))
  391. (keylist->vectorlist
  392. (case report-type
  393. ((pnl) pricesource-list-pnl)
  394. ((balsheet) pricesource-list-balsheet)))))
  396. (add-option
  397. (gnc:make-simple-boolean-option
  398. pagename-commodities optname-show-foreign
  399. "e" opthelp-show-foreign #t))
  401. (add-option
  402. (gnc:make-simple-boolean-option
  403. pagename-commodities optname-show-rates
  404. "f" opthelp-show-rates #t))
  406. ;; what to show for zero-balance accounts
  407. (add-option
  408. (gnc:make-simple-boolean-option
  409. gnc:pagename-display optname-show-zb-accts
  410. "a" opthelp-show-zb-accts #t))
  412. (add-option
  413. (gnc:make-simple-boolean-option
  414. gnc:pagename-display optname-omit-zb-bals
  415. "b" opthelp-omit-zb-bals #f))
  417. (add-option
  418. (gnc:make-simple-boolean-option
  419. gnc:pagename-display optname-parent-balance-mode
  420. "c" opthelp-parent-balance-mode #t))
  422. ;; some detailed formatting options
  423. (add-option
  424. (gnc:make-simple-boolean-option
  425. gnc:pagename-display optname-account-links
  426. "e" opthelp-account-links #t))
  428. (add-option
  429. (gnc:make-simple-boolean-option
  430. gnc:pagename-display optname-amount-links
  431. "e5" opthelp-amount-links #t))
  433. (add-option
  434. (gnc:make-simple-boolean-option
  435. gnc:pagename-display optname-account-full-name
  436. "f" opthelp-account-full-name #f))
  438. (add-option
  439. (gnc:make-simple-boolean-option
  440. gnc:pagename-display optname-label-sections "g" opthelp-label-sections #t))
  442. (add-option
  443. (gnc:make-simple-boolean-option
  444. gnc:pagename-display optname-total-sections "h" opthelp-total-sections #t))
  446. (when (eq? report-type 'pnl)
  447. ;; include overall period column?
  448. (add-option
  449. (gnc:make-simple-boolean-option
  450. gnc:pagename-general optname-include-overall-period
  451. "e" opthelp-include-overall-period #f))
  453. ;; closing entry match criteria
  454. (add-option
  455. (gnc:make-string-option
  456. pagename-entries optname-closing-pattern
  457. "a" opthelp-closing-pattern (_ "Closing Entries")))
  459. (add-option
  460. (gnc:make-simple-boolean-option
  461. pagename-entries optname-closing-casing
  462. "b" opthelp-closing-casing #f))
  464. (add-option
  465. (gnc:make-simple-boolean-option
  466. pagename-entries optname-closing-regexp
  467. "c" opthelp-closing-regexp #f)))
  469. ;; Set the accounts page as default option tab
  470. (gnc:options-set-default-section options gnc:pagename-accounts)
  472. options))
  474. (define* (add-multicolumn-acct-table
  475. table title accountlist maxindent get-cell-monetary-fn cols-data #:key
  476. (omit-zb-bals? #f)
  477. (show-zb-accts? #t)
  478. (disable-account-indent? #f)
  479. (disable-amount-indent? #f)
  480. (show-orig-cur? #t)
  481. (show-title? #t)
  482. (show-accounts? #t)
  483. (show-total? #t)
  484. (depth-limit #f)
  485. (negate-amounts? #f)
  486. (recursive-bals? #f)
  487. (account-anchor? #t)
  488. (get-col-header-fn #f)
  489. (convert-curr-fn #f)
  490. (get-cell-anchor-fn #f))
  492. ;; this function will add a 2D grid into the html-table
  493. ;; the data cells are generated from (get-cell-monetary-fn account col-datum)
  494. ;; the data cells may request an alternative (eg. original currency) monetary
  495. ;; horizontal labels are generated from calling (get-col-header-fn col-datum)
  496. ;; vertical labels are the account list. it can have multilevel subtotals.
  498. ;; the following are compulsory arguments:
  499. ;; table - an existing html-table object
  500. ;; title - string as the first row
  501. ;; accountlist - list of accounts
  502. ;; maxindent - maximum account depth
  503. ;; cols-data - list of data to be passed as parameter to the following helper functions
  504. ;; get-cell-monetary-fn - a lambda (account cols-data) which produces a gnc-monetary or #f (eg price conversion impossible)
  506. ;; the following are optional:
  507. ;; omit-zb-bals? - a boolean to omit "$0.00" amounts
  508. ;; show-zb-accts? - a boolean to omit whole account lines where all amounts are $0.00 (eg closed accts)
  509. ;; show-title? - a bool to show/hide individual sections: title row
  510. ;; show-accounts? - a bool to show/hide individual sections: accounts list and data columns
  511. ;; show-total? - a bool to show/hide individual sections: accounts total
  512. ;; disable-account-indent? - a boolean to disable narrow-cell indenting, and render account full-name instead
  513. ;; disable-amount-indent? - a bool to disable amount indenting (only for single data column reports)
  514. ;; negate-amounts? - a boolean to negate amounts. useful for e.g. income-type accounts.
  515. ;; depth-limit - (untested) accounts whose levels exceed this depth limit are not shown
  516. ;; recursive-bals? - a boolean to confirm recursive-balances enabled (parent-accounts show balances) or
  517. ;; disabled (multilevel subtotals after each parent+children)
  518. ;; account-anchor? - a boolean to enable/disable account link to account
  519. ;; amount-anchor? - a boolean to enable/disable amount link to report/register
  520. ;; get-col-header-fn - a lambda (accounts cols-data) to produce html-object - this is optional
  521. ;; convert-curr-fn - a lambda (monetary cols-data) which produces a gnc-monetary or #f - optional
  522. ;; show-orig-cur? - a boolean to enable/disable original currency after convert-curr-fn
  523. ;; get-cell-anchor-fn - a lambda (account cols-data) which produces a url string - optional
  525. (define num-columns (length cols-data))
  527. (define amount-indenting? (and (not disable-amount-indent?) (= num-columns 1)))
  529. (define (make-list-thunk n thunk)
  530. (let loop ((result '()) (n n))
  531. (if (zero? n) result
  532. (loop (cons (thunk) result) (1- n)))))
  534. (define (make-narrow-cell)
  535. (let ((narrow (gnc:make-html-table-cell/markup "text-cell" #f)))
  536. (gnc:html-table-cell-set-style! narrow "text-cell" 'attribute '("style" "width:1px"))
  537. narrow))
  539. (define (add-indented-row indent label label-markup amount-indent rest)
  540. (when (or (not depth-limit) (<= indent depth-limit))
  541. (gnc:html-table-append-row!
  542. table
  543. (append (if disable-account-indent? '() (make-list-thunk indent make-narrow-cell))
  544. (list (if label-markup
  545. (gnc:make-html-table-cell/size/markup 1 (if disable-account-indent? 1 (- maxindent indent)) label-markup label)
  546. (gnc:make-html-table-cell/size 1 (if disable-account-indent? 1 (- maxindent indent)) label)))
  547. (gnc:html-make-empty-cells (if amount-indenting? (1- amount-indent) 0))
  548. rest
  549. (gnc:html-make-empty-cells
  550. (if amount-indenting? (- maxindent amount-indent) 0))))))
  552. (define (monetary+ . monetaries)
  553. ;; usage: (monetary+ monetary...)
  554. ;; inputs: list of gnc-monetary (e.g. USD 10, USD 25, GBP 5, GBP 8)
  555. ;; outputs: list of gnc-monetary (e.g. USD 35, GBP 13), or '()
  556. (let ((coll (gnc:make-commodity-collector)))
  557. (for-each
  558. (lambda (monetary)
  559. (if monetary
  560. (coll 'add
  561. (gnc:gnc-monetary-commodity monetary)
  562. (let ((amount (gnc:gnc-monetary-amount monetary)))
  563. (if negate-amounts? (- amount) amount)))))
  564. monetaries)
  565. (coll 'format gnc:make-gnc-monetary #f)))
  567. (define (list-of-monetary->html-text monetaries col-datum anchor)
  568. ;; inputs:
  569. ;; monetaries: list of gnc-monetary (or #f, or html-text object)
  570. ;; col-datum: col-datum to help convert monetary currency
  571. ;; anchor: url string for monetaries (or #f) (all have same anchor)
  572. ;;
  573. ;; outputs: html-text object
  574. (let ((text (gnc:make-html-text)))
  575. (for-each
  576. (lambda (monetary)
  577. (let ((converted (and show-orig-cur?
  578. convert-curr-fn
  579. (convert-curr-fn monetary col-datum))))
  580. (if (not (and omit-zb-bals?
  581. (gnc:gnc-monetary? monetary)
  582. (zero? (gnc:gnc-monetary-amount monetary))))
  583. (gnc:html-text-append! text
  584. (if converted
  585. (gnc:html-markup-i
  586. (gnc:html-markup "small" monetary " "))
  587. "")
  588. (if anchor
  589. (gnc:html-markup-anchor
  590. anchor (or converted monetary))
  591. (or converted monetary))
  592. (gnc:html-markup-br)))))
  593. monetaries)
  594. text))
  596. (define (render-account account total?)
  597. ;; input: account-name
  598. ;; outputs: string or html-markup-anchor object
  599. (let* ((acct-name ((if disable-account-indent?
  600. gnc-account-get-full-name
  601. xaccAccountGetName) account))
  602. (acct-label (if total?
  603. (string-append (_ "Total For ") acct-name)
  604. acct-name))
  605. (acct-url (and account-anchor?
  606. (not total?)
  607. (not (xaccAccountGetPlaceholder account))
  608. (gnc:account-anchor-text account))))
  609. (gnc:make-html-text
  610. (if acct-url
  611. (gnc:html-markup-anchor acct-url acct-label)
  612. acct-label))))
  614. (define (add-whole-line contents)
  615. (gnc:html-table-append-row!
  616. table (gnc:make-html-table-cell/size
  617. 1 (+ 1 (if disable-account-indent? 0 maxindent) num-columns)
  618. contents)))
  620. (define (account-and-descendants account)
  621. (cons account (filter (lambda (acc) (member acc accountlist))
  622. (gnc-account-get-descendants account))))
  624. (define (sum-accounts-at-col accounts datum convert?)
  625. ;; outputs: list of gnc-monetary
  626. (apply monetary+
  627. (map (lambda (acc)
  628. (let ((monetary (get-cell-monetary-fn acc datum)))
  629. (or (and convert? convert-curr-fn
  630. (convert-curr-fn monetary datum))
  631. monetary)))
  632. accounts)))
  634. (define (is-not-zero? accts)
  635. ;; this function tests whether accounts (with descendants) of all
  636. ;; columns are zero.
  637. (not (every zero? (concatenate
  638. (map
  639. (lambda (col-datum)
  640. (map gnc:gnc-monetary-amount
  641. (sum-accounts-at-col accts col-datum #f)))
  642. cols-data)))))
  644. (define* (add-recursive-subtotal lvl lvl-acct #:key account-style-normal?)
  645. (if (or show-zb-accts?
  646. (is-not-zero? (account-and-descendants lvl-acct)))
  647. (add-indented-row lvl
  648. (render-account lvl-acct (not account-style-normal?))
  649. (if account-style-normal?
  650. "text-cell"
  651. "total-label-cell")
  652. (- maxindent lvl)
  653. (map
  654. (lambda (col-datum)
  655. (gnc:make-html-table-cell/markup
  656. "total-number-cell"
  657. (list-of-monetary->html-text
  658. (sum-accounts-at-col (account-and-descendants lvl-acct)
  659. col-datum
  660. #t)
  661. col-datum
  662. #f)))
  663. cols-data))))
  665. (define* (add-account-row lvl-curr curr #:key
  666. (override-show-zb-accts? #f)
  667. (account-indent 0))
  668. (if (or show-zb-accts?
  669. override-show-zb-accts?
  670. (is-not-zero? (list curr)))
  671. (add-indented-row lvl-curr
  672. (render-account curr #f)
  673. "text-cell"
  674. (- maxindent lvl-curr account-indent)
  675. (map
  676. (lambda (col-datum)
  677. (gnc:make-html-table-cell/markup
  678. "number-cell"
  679. (list-of-monetary->html-text
  680. (sum-accounts-at-col
  681. (list curr)
  682. col-datum
  683. (not show-orig-cur?))
  684. col-datum
  685. (and get-cell-anchor-fn
  686. (get-cell-anchor-fn curr col-datum)))))
  687. cols-data))))
  689. ;; header ASSET/LIABILITY etc
  690. (if show-title?
  691. (add-indented-row 0
  692. title
  693. "total-label-cell"
  694. maxindent
  695. (if get-col-header-fn
  696. (map
  697. (lambda (col-datum)
  698. (get-col-header-fn accountlist col-datum))
  699. cols-data)
  700. (gnc:html-make-empty-cells num-columns))))
  702. (let loop ((accounts (if show-accounts? accountlist '())))
  703. (if (pair? accounts)
  704. (let* ((curr (car accounts))
  705. (rest (cdr accounts))
  706. (next (and (pair? rest) (car rest)))
  707. (lvl-curr (gnc-account-get-current-depth curr))
  708. (lvl-next (if next (gnc-account-get-current-depth next) 0))
  709. (curr-descendants-list (filter
  710. (lambda (acc) (member acc accountlist))
  711. (gnc-account-get-descendants curr)))
  712. (recursive-parent-acct? (and recursive-bals?
  713. (pair? curr-descendants-list)))
  714. (multilevel-parent-acct? (and (not recursive-bals?)
  715. (pair? curr-descendants-list))))
  717. (if recursive-parent-acct?
  718. (begin
  719. (add-recursive-subtotal lvl-curr curr #:account-style-normal? #t)
  720. (if (is-not-zero? (list curr))
  721. (add-account-row (1+ lvl-curr) curr #:override-show-zb-accts? #t)))
  722. (add-account-row lvl-curr curr
  723. #:account-indent (if multilevel-parent-acct? 1 0)
  724. #:override-show-zb-accts? multilevel-parent-acct?))
  726. (if (and (not recursive-bals?)
  727. (> lvl-curr lvl-next))
  728. (let multilevel-loop ((lvl (1- lvl-curr))
  729. (lvl-acct (gnc-account-get-parent curr)))
  730. (unless (or (zero? lvl)
  731. (not (member lvl-acct accountlist))
  732. (< lvl lvl-next))
  733. (add-recursive-subtotal lvl lvl-acct)
  734. (multilevel-loop (1- lvl)
  735. (gnc-account-get-parent lvl-acct)))))
  736. (loop rest))))
  738. (if show-total?
  739. (add-indented-row 0
  740. (string-append (_ "Total For ") title)
  741. "total-label-cell"
  742. maxindent
  743. (map
  744. (lambda (col-datum)
  745. (let ((total-cell (gnc:make-html-table-cell/markup
  746. "total-number-cell"
  747. (list-of-monetary->html-text
  748. (sum-accounts-at-col accountlist
  749. col-datum
  750. #t)
  751. col-datum
  752. #f))))
  753. (gnc:html-table-cell-set-style!
  754. total-cell "total-number-cell"
  755. 'attribute '("style" "border-top-style:solid; border-top-width: 1px; border-bottom-style:double"))
  756. total-cell))
  757. cols-data)))
  758. (add-whole-line #f))
  760. (define (monetary-less . monetaries)
  761. ;; syntax: (monetary-less mon0 mon1 mon2 ...)
  762. ;; equiv: (- mon0 mon1 mon2 ...)
  763. (let ((res (gnc:make-commodity-collector)))
  764. (res 'add (gnc:gnc-monetary-commodity (car monetaries)) (gnc:gnc-monetary-amount (car monetaries)))
  765. (for-each
  766. (lambda (mon)
  767. (res 'add (gnc:gnc-monetary-commodity mon) (- (gnc:gnc-monetary-amount mon))))
  768. (cdr monetaries))
  769. (car (res 'format gnc:make-gnc-monetary #f))))
  771. ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  772. ;; multicol-report-renderer
  773. ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  775. (define (multicol-report-renderer report-obj report-type)
  776. (define (get-option pagename optname)
  777. (gnc:option-value
  778. (gnc:lookup-option
  779. (gnc:report-options report-obj) pagename optname)))
  781. (gnc:report-starting (get-option gnc:pagename-general gnc:optname-reportname))
  783. ;; get all options values
  784. (let* ((report-title (get-option gnc:pagename-general gnc:optname-reportname))
  785. (company-name (get-option gnc:pagename-general optname-company-name))
  786. (startdate (gnc:date-option-absolute-time
  787. (get-option gnc:pagename-general
  788. optname-startdate)))
  789. (enddate (gnc:date-option-absolute-time
  790. (get-option gnc:pagename-general
  791. optname-enddate)))
  792. (disable-account-indent? (get-option gnc:pagename-display
  793. optname-account-full-name))
  794. (incr (let ((period (get-option gnc:pagename-general optname-period)))
  795. (and period
  796. (keylist-get-info periodlist period 'delta))))
  797. (disable-amount-indent? (and (not incr)
  798. (get-option gnc:pagename-general
  799. optname-disable-amount-indent)))
  800. (enable-dual-columns? (and (not incr)
  801. (get-option gnc:pagename-general
  802. optname-dual-columns)))
  803. (accounts (get-option gnc:pagename-accounts
  804. optname-accounts))
  805. (depth-limit (let ((limit (get-option gnc:pagename-accounts
  806. optname-depth-limit)))
  807. (and (not (eq? limit 'all)) limit)))
  808. (show-zb-accts? (get-option gnc:pagename-display
  809. optname-show-zb-accts))
  810. (omit-zb-bals? (get-option gnc:pagename-display
  811. optname-omit-zb-bals))
  812. (recursive-bals? (get-option gnc:pagename-display
  813. optname-parent-balance-mode))
  814. (label-sections? (get-option gnc:pagename-display
  815. optname-label-sections))
  816. (total-sections? (get-option gnc:pagename-display
  817. optname-total-sections))
  818. (use-links? (get-option gnc:pagename-display
  819. optname-account-links))
  820. (use-amount-links? (get-option gnc:pagename-display
  821. optname-amount-links))
  822. (include-chart? (get-option gnc:pagename-general optname-include-chart))
  823. (common-currency (and (get-option pagename-commodities optname-common-currency)
  824. (get-option pagename-commodities optname-report-commodity)))
  825. (has-price? (lambda (commodity)
  826. ;; the following tests whether an amount in commodity can be converted to
  827. ;; common-currency. if conversion successful, it will be a non-zero value.
  828. ;; note if we use API gnc-pricedb-has-prices, we're only querying the pricedb.
  829. ;; if we use gnc-pricedb-convert-balance-latest-price, we can potentially
  830. ;; use an intermediate currency.
  831. (not (zero? (gnc-pricedb-convert-balance-latest-price
  832. (gnc-pricedb-get-db (gnc-get-current-book))
  833. (gnc-commodity-get-fraction commodity)
  834. commodity
  835. common-currency)))))
  836. (price-source (get-option pagename-commodities optname-price-source))
  837. (report-dates (map (if (eq? report-type 'balsheet)
  838. gnc:time64-end-day-time
  839. gnc:time64-start-day-time)
  840. (if incr
  841. (gnc:make-date-list startdate enddate incr)
  842. (if (eq? report-type 'balsheet)
  843. (list enddate)
  844. (list startdate enddate)))))
  845. (accounts-balances (map
  846. (lambda (acc)
  847. (cons acc
  848. (gnc:account-get-balances-at-dates acc report-dates)))
  849. accounts))
  850. (convert-curr-fn (lambda (monetary col-idx)
  851. (and common-currency
  852. (not (gnc-commodity-equal (gnc:gnc-monetary-commodity monetary) common-currency))
  853. (has-price? (gnc:gnc-monetary-commodity monetary))
  854. (let* ((date (case price-source
  855. ((startperiod) startdate)
  856. ((midperiod) (floor (/ (+ startdate enddate) 2)))
  857. ((endperiod weighted-average average-cost) enddate)
  858. ((pricedb-latest) (current-time))
  859. (else
  860. (list-ref report-dates
  861. (case report-type
  862. ((balsheet) col-idx)
  863. ((pnl) (1+ col-idx)))))))
  864. (exchange-fn (gnc:case-exchange-fn
  865. (if (memq price-source '(startperiod midperiod endperiod))
  866. 'pricedb-nearest
  867. price-source)
  868. common-currency date)))
  869. (exchange-fn monetary common-currency)))))
  870. ;; the following function generates an gnc:html-text object
  871. ;; to dump exchange rate for a particular column. From the
  872. ;; accountlist given, obtain commodities, and convert 1 unit
  873. ;; currency into report-currency. If cannot convert due to
  874. ;; missing price, say so.
  875. (get-exchange-rates-fn (lambda (accounts date)
  876. (let ((commodities (delete
  877. common-currency
  878. (delete-duplicates
  879. (map xaccAccountGetCommodity accounts)
  880. gnc-commodity-equal)
  881. gnc-commodity-equal))
  882. (cell (gnc:make-html-text)))
  883. (for-each
  884. (lambda (commodity)
  885. (let ((orig-monetary (gnc:make-gnc-monetary commodity 1)))
  886. (if (has-price? commodity)
  887. (let ((conv-monetary (convert-curr-fn
  888. orig-monetary
  889. (case report-type
  890. ((balsheet) date)
  891. ((pnl) (cons startdate enddate))))))
  892. (gnc:html-text-append!
  893. cell
  894. (format #f "~a ~a"
  895. (gnc:monetary->string orig-monetary)
  896. (gnc:monetary->string conv-monetary))))
  897. (gnc:html-text-append!
  898. cell
  899. (format #f (string-append "~a ~a" (_ "missing"))
  900. (gnc:monetary->string orig-monetary)
  901. (gnc-commodity-get-nice-symbol common-currency)))))
  902. (gnc:html-text-append! cell (gnc:html-markup-br)))
  903. commodities)
  904. (gnc:make-html-table-cell/markup "number-cell" cell))))
  906. ;; decompose the account list
  907. (show-foreign? (get-option pagename-commodities optname-show-foreign))
  908. (show-rates? (get-option pagename-commodities optname-show-rates))
  909. (split-up-accounts (gnc:decompose-accountlist accounts))
  910. (asset-accounts
  911. (assoc-ref split-up-accounts ACCT-TYPE-ASSET))
  912. (liability-accounts
  913. (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY))
  914. (income-accounts
  915. (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
  916. (expense-accounts
  917. (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
  918. (equity-accounts
  919. (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
  920. (trading-accounts
  921. (assoc-ref split-up-accounts ACCT-TYPE-TRADING))
  922. (doc (gnc:make-html-document))
  923. (multicol-table-left (gnc:make-html-table))
  924. (multicol-table-right (if enable-dual-columns?
  925. (gnc:make-html-table)
  926. multicol-table-left))
  927. (maxindent (gnc-account-get-tree-depth (gnc-get-current-root-account))))
  929. (gnc:html-document-set-title!
  930. doc (string-append company-name " " report-title " "
  931. (if (and (eq? report-type 'balsheet) (not incr))
  932. ""
  933. (string-append (qof-print-date startdate) " - "))
  934. (qof-print-date enddate)))
  936. (if (eq? (get-option gnc:pagename-general optname-options-summary) 'always)
  937. (gnc:html-document-add-object!
  938. doc (gnc:html-render-options-changed (gnc:report-options report-obj))))
  940. (if (null? accounts)
  942. (gnc:html-document-add-object!
  943. doc
  944. (gnc:html-make-no-account-warning
  945. report-title (gnc:report-id report-obj)))
  947. (case report-type
  948. ((balsheet)
  949. (let* ((get-cell-monetary-fn (lambda (account col-idx)
  950. (let ((account-balance-list (assoc account accounts-balances)))
  951. (and account-balance-list
  952. (list-ref account-balance-list (1+ col-idx))))))
  953. (get-cell-anchor-fn (lambda (account col-idx)
  954. (let* ((splits (xaccAccountGetSplitList account))
  955. (split-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
  956. (date (list-ref report-dates col-idx))
  957. (valid-split? (lambda (s) (< (split-date s) date)))
  958. (valid-splits (filter valid-split? splits))
  959. (split (and (pair? valid-splits)
  960. (last valid-splits))))
  961. (and split
  962. (gnc:split-anchor-text split)))))
  963. (chart (and include-chart?
  964. (gnc:make-report-anchor
  965. networth-barchart-uuid report-obj
  966. (list (list "General" "Start Date" (cons 'absolute startdate))
  967. (list "General" "End Date" (cons 'absolute enddate))
  968. (list "General" "Report's currency" (or common-currency (gnc-default-report-currency)))
  969. (list "General" "Price Source" price-source)
  970. (list "Accounts" "Accounts" (append asset-accounts liability-accounts))))))
  971. (get-col-header-fn (lambda (accounts col-idx)
  972. (let* ((date (list-ref report-dates col-idx))
  973. (header (qof-print-date date))
  974. (cell (gnc:make-html-table-cell/markup
  975. "total-label-cell" header)))
  976. (gnc:html-table-cell-set-style!
  977. cell "total-label-cell"
  978. 'attribute '("style" "text-align:right"))
  979. cell)))
  980. (add-to-table (lambda* (table title accounts #:key
  981. (get-col-header-fn #f)
  982. (show-accounts? #t)
  983. (show-total? #t)
  984. (force-total? #f)
  985. (negate-amounts? #f))
  986. (add-multicolumn-acct-table
  987. table title accounts
  988. maxindent get-cell-monetary-fn (iota (length report-dates))
  989. #:omit-zb-bals? omit-zb-bals?
  990. #:show-zb-accts? show-zb-accts?
  991. #:disable-account-indent? disable-account-indent?
  992. #:negate-amounts? negate-amounts?
  993. #:disable-amount-indent? disable-amount-indent?
  994. #:depth-limit (if get-col-header-fn 0 depth-limit)
  995. #:show-orig-cur? show-foreign?
  996. #:show-title? label-sections?
  997. #:show-accounts? show-accounts?
  998. #:show-total? (or (and total-sections? show-total?) force-total?)
  999. #:recursive-bals? recursive-bals?
  1000. #:account-anchor? use-links?
  1001. #:convert-curr-fn (and common-currency convert-curr-fn)
  1002. #:get-col-header-fn get-col-header-fn
  1003. #:get-cell-anchor-fn (and use-amount-links? get-cell-anchor-fn)
  1004. ))))
  1006. (when incr
  1007. (add-to-table multicol-table-left (_ "Date") '()
  1008. #:get-col-header-fn get-col-header-fn
  1009. #:show-accounts? #f
  1010. #:show-total? #f)
  1011. (if enable-dual-columns?
  1012. (add-to-table multicol-table-right (_ "Date") '()
  1013. #:get-col-header-fn get-col-header-fn
  1014. #:show-accounts? #f
  1015. #:show-total? #f)))
  1017. (unless (null? asset-accounts)
  1018. (add-to-table multicol-table-left (_ "Asset") asset-accounts))
  1020. (unless (null? liability-accounts)
  1021. (add-to-table multicol-table-right (_ "Liability") liability-accounts
  1022. #:negate-amounts? #t))
  1024. (unless (null? equity-accounts)
  1025. (add-to-table multicol-table-right (_ "Equity")
  1026. equity-accounts))
  1028. (unless (null? trading-accounts)
  1029. (add-to-table multicol-table-right (_ "Trading")
  1030. trading-accounts))
  1032. (unless (or (null? asset-accounts)
  1033. (null? liability-accounts))
  1034. (add-to-table multicol-table-right (_ "Net Worth")
  1035. (append asset-accounts liability-accounts trading-accounts)
  1036. #:show-accounts? #f
  1037. #:force-total? #t))
  1039. (if (and common-currency show-rates?)
  1040. (add-to-table multicol-table-right (_ "Exchange Rates")
  1041. (append asset-accounts liability-accounts)
  1042. #:get-col-header-fn get-exchange-rates-fn
  1043. #:show-accounts? #f
  1044. #:show-total? #f))
  1046. (if include-chart?
  1047. (gnc:html-document-add-object!
  1048. doc
  1049. (gnc:make-html-text
  1050. (gnc:html-markup-anchor chart "Barchart"))))))
  1052. ((pnl)
  1053. (let* ((closing-str (get-option pagename-entries optname-closing-pattern))
  1054. (closing-cased (get-option pagename-entries optname-closing-casing))
  1055. (closing-regexp (get-option pagename-entries optname-closing-regexp))
  1056. (include-overall-period? (get-option gnc:pagename-general optname-include-overall-period))
  1057. (col-idx->datepair (lambda (idx)
  1058. (if (eq? idx 'overall-period)
  1059. (cons (car report-dates) (last report-dates))
  1060. (cons (list-ref report-dates idx)
  1061. (list-ref report-dates (1+ idx))))))
  1062. (col-idx->monetarypair (lambda (balancelist idx)
  1063. (if (eq? idx 'overall-period)
  1064. (cons (car balancelist) (last balancelist))
  1065. (cons (list-ref balancelist idx)
  1066. (list-ref balancelist (1+ idx))))))
  1067. (closing-entries (let ((query (qof-query-create-for-splits)))
  1068. (qof-query-set-book query (gnc-get-current-book))
  1069. (xaccQueryAddAccountMatch query (append income-accounts expense-accounts)
  1070. QOF-GUID-MATCH-ANY QOF-QUERY-AND)
  1071. (if (and closing-str (not (string-null? closing-str)))
  1072. (xaccQueryAddDescriptionMatch query closing-str closing-cased closing-regexp
  1073. QOF-COMPARE-CONTAINS QOF-QUERY-AND))
  1074. (xaccQueryAddClosingTransMatch query #t QOF-QUERY-OR)
  1075. (let ((splits (qof-query-run query)))
  1076. (qof-query-destroy query)
  1077. splits)))
  1078. ;; this function will query the above closing-entries for splits within the date range,
  1079. ;; and produce the total amount for these closing entries
  1080. (closing-adjustment (lambda (account col-idx)
  1081. (define datepair (col-idx->datepair col-idx))
  1082. (define (include-split? split)
  1083. (and (equal? (xaccSplitGetAccount split) account)
  1084. (<= (car datepair)
  1085. (xaccTransGetDate (xaccSplitGetParent split))
  1086. (cdr datepair))))
  1087. (let ((account-closing-splits (filter include-split? closing-entries)))
  1088. (gnc:make-gnc-monetary
  1089. (xaccAccountGetCommodity account)
  1090. (apply + (map xaccSplitGetAmount account-closing-splits))))))
  1091. (get-cell-monetary-fn (lambda (account col-idx)
  1092. (let ((account-balance-list (assoc account accounts-balances)))
  1093. (and account-balance-list
  1094. (let ((monetarypair (col-idx->monetarypair (cdr account-balance-list) col-idx)))
  1095. (monetary-less
  1096. (cdr monetarypair)
  1097. (car monetarypair)
  1098. (closing-adjustment account col-idx)))))))
  1099. (get-cell-anchor-fn (lambda (account col-idx)
  1100. (define datepair (col-idx->datepair col-idx))
  1101. (gnc:make-report-anchor
  1102. trep-uuid report-obj
  1103. (list (list "General" "Start Date" (cons 'absolute (car datepair)))
  1104. (list "General" "End Date" (cons 'absolute (cdr datepair)))
  1105. (list "Accounts" "Accounts" (list account))))))
  1106. (chart (and include-chart?
  1107. (gnc:make-report-anchor
  1108. pnl-barchart-uuid report-obj
  1109. (list (list "General" "Start Date" (cons 'absolute startdate))
  1110. (list "General" "End Date" (cons 'absolute enddate))
  1111. (list "General" "Report's currency" (or common-currency (gnc-default-report-currency)))
  1112. (list "General" "Price Source" (case price-source
  1113. ((pricedb-latest) 'pricedb-latest)
  1114. (else 'pricedb-nearest)))
  1115. (list "Accounts" "Accounts" (append income-accounts expense-accounts))))))
  1116. (get-col-header-fn (lambda (accounts col-idx)
  1117. (let* ((datepair (col-idx->datepair col-idx))
  1118. (header (gnc:make-html-text
  1119. (qof-print-date (car datepair))
  1120. (gnc:html-markup-br)
  1121. (_ " to ")
  1122. (qof-print-date (cdr datepair))))
  1123. (cell (gnc:make-html-table-cell/markup "total-label-cell" header)))
  1124. (gnc:html-table-cell-set-style! cell "total-label-cell" 'attribute '("style" "text-align:right"))
  1125. cell)))
  1126. (add-to-table (lambda* (table title accounts #:key
  1127. (get-col-header-fn #f)
  1128. (show-accounts? #t)
  1129. (show-total? #t)
  1130. (force-total? #f)
  1131. (negate-amounts? #f))
  1132. (add-multicolumn-acct-table
  1133. table title accounts
  1134. maxindent get-cell-monetary-fn
  1135. (append
  1136. (iota (1- (length report-dates)))
  1137. (if (and include-overall-period?
  1138. (> (length report-dates) 2))
  1139. '(overall-period)
  1140. '()))
  1141. #:omit-zb-bals? omit-zb-bals?
  1142. #:show-zb-accts? show-zb-accts?
  1143. #:disable-account-indent? disable-account-indent?
  1144. #:negate-amounts? negate-amounts?
  1145. #:disable-amount-indent? disable-amount-indent?
  1146. #:depth-limit (if get-col-header-fn 0 depth-limit)
  1147. #:show-orig-cur? show-foreign?
  1148. #:show-title? label-sections?
  1149. #:show-accounts? show-accounts?
  1150. #:show-total? (or (and total-sections? show-total?) force-total?)
  1151. #:recursive-bals? recursive-bals?
  1152. #:account-anchor? use-links?
  1153. #:convert-curr-fn (and common-currency convert-curr-fn)
  1154. #:get-col-header-fn get-col-header-fn
  1155. #:get-cell-anchor-fn (and use-amount-links? get-cell-anchor-fn)
  1156. ))))
  1158. (when incr
  1159. (add-to-table multicol-table-left (_ "Period") '()
  1160. #:get-col-header-fn get-col-header-fn
  1161. #:show-accounts? #f
  1162. #:show-total? #f)
  1163. (if enable-dual-columns?
  1164. (add-to-table multicol-table-right (_ "Period") '()
  1165. #:get-col-header-fn get-col-header-fn
  1166. #:show-accounts? #f
  1167. #:show-total? #f)))
  1169. (unless (null? income-accounts)
  1170. (add-to-table multicol-table-left (_ "Income") income-accounts
  1171. #:negate-amounts? #t))
  1173. (unless (null? expense-accounts)
  1174. (add-to-table multicol-table-right (_ "Expense") expense-accounts))
  1176. (unless (or (null? income-accounts)
  1177. (null? expense-accounts))
  1178. (add-to-table multicol-table-left (_ "Net Income")
  1179. (append income-accounts expense-accounts)
  1180. #:show-accounts? #f
  1181. #:negate-amounts? #t
  1182. #:force-total? #t))
  1184. (if (and common-currency show-rates?)
  1185. (add-to-table multicol-table-left (_ "Exchange Rates")
  1186. (append income-accounts expense-accounts)
  1187. #:get-col-header-fn get-exchange-rates-fn
  1188. #:show-accounts? #f
  1189. #:show-total? #f))
  1191. (if include-chart?
  1192. (gnc:html-document-add-object!
  1193. doc
  1194. (gnc:make-html-text
  1195. (gnc:html-markup-anchor chart "Barchart"))))))))
  1197. (let ((multicol-table (if enable-dual-columns?
  1198. (gnc:make-html-table)
  1199. multicol-table-left)))
  1200. (when enable-dual-columns?
  1201. (gnc:html-table-append-row! multicol-table
  1202. (list multicol-table-left multicol-table-right)))
  1203. (gnc:html-document-add-object!
  1204. doc multicol-table))
  1206. (gnc:html-document-add-object!
  1207. doc (gnc:make-html-text FOOTER-TEXT))
  1209. (gnc:report-finished)
  1210. ;; (gnc:html-document-set-style-text!
  1211. ;; doc " table, td{ border-width: 1px; border-style:solid; border-color: lightgray; border-collapse: collapse}")
  1212. doc))
  1214. (define balsheet-reportname (_ "Balance Sheet (Multicolumn)"))
  1215. (define pnl-reportname (_ "Income Statement (Multicolumn)"))
  1217. (gnc:define-report
  1218. 'version 1
  1219. 'name balsheet-reportname
  1220. 'report-guid "065d5d5a77ba11e8b31e83ada73c5eea"
  1221. 'menu-path (list gnc:menuname-asset-liability)
  1222. 'options-generator (lambda () (multicol-report-options-generator 'balsheet))
  1223. 'renderer (lambda (rpt) (multicol-report-renderer rpt 'balsheet)))
  1225. (gnc:define-report
  1226. 'version 1
  1227. 'name pnl-reportname
  1228. 'report-guid "0e94fd0277ba11e8825d43e27232c9d4"
  1229. 'menu-path (list gnc:menuname-income-expense)
  1230. 'options-generator (lambda () (multicol-report-options-generator 'pnl))
  1231. 'renderer (lambda (rpt) (multicol-report-renderer rpt 'pnl)))
  1233. ;; END
  1234.  
Powered by spacepaste. Paste removal.