;;; example report in wisp, converted from GNU Cash; only the first 186 lines ;;; for info on wisp, see https://www.draketo.de/english/wisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; new-aging.scm : accounts payable/receivable aging report ;; ;; By Christopher Lam, rewrite and debug ;; By Derek Atkins <warlord@MIT.EDU> taken from the original... ;; By Robert Merkel (rgmerk@mira.net) ;; Copyright (c) 2002, 2003 Derek Atkins <warlord@MIT.EDU> ;; ;; 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 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; define-module : gnucash reports standard new-aging use-modules : srfi srfi-1 use-modules : srfi srfi-11 ;let-values use-modules : ice-9 match use-modules : gnucash utilities use-modules : gnucash engine use-modules : gnucash core-utils use-modules : gnucash app-utils use-modules : gnucash report define optname-to-date (N_ "To") define optname-sort-by (N_ "Sort By") define optname-sort-order (N_ "Sort Order") define optname-report-currency (N_ "Report's currency") define optname-price-source (N_ "Price Source") define optname-show-zeros (N_ "Show zero balance items") define optname-date-driver (N_ "Due or Post Date") ;; Display tab options define optname-addr-source (N_ "Address Source") define addr-options-list list list (N_ "Address Name") "b" N_ "Display Address Name. This, and other fields, may be useful if \ copying this report to a spreadsheet for use in a mail merge." list (N_ "Address 1") "c" (N_ "Display Address 1.") list (N_ "Address 2") "d" (N_ "Display Address 2.") list (N_ "Address 3") "e" (N_ "Display Address 3.") list (N_ "Address 4") "f" (N_ "Display Address 4.") list (N_ "Address Phone") "g" (N_ "Display Phone.") list (N_ "Address Fax") "h" (N_ "Display Fax.") list (N_ "Address Email") "i" (N_ "Display Email.") list (N_ "Active") "j" (N_ "Display Active status.") define no-APAR-account : G_ "No valid A/Payable or A/Receivable \ account found. Please ensure valid AP/AR account exists." define empty-APAR-accounts : G_ "A/Payable or A/Receivable accounts \ exist but have no suitable transactions." define num-buckets 6 define (setup-query query accounts date) qof-query-set-book query (gnc-get-current-book) gnc:query-set-match-non-voids-only! query (gnc-get-current-book) xaccQueryAddAccountMatch query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND xaccQueryAddDateMatchTT query #f 0 #t date QOF-QUERY-AND qof-query-set-sort-order query list SPLIT-TRANS TRANS-DATE-POSTED . '() '() qof-query-set-sort-increasing query #t #t #t define (aging-options-generator options) let* : add-option (lambda (new-option) (gnc:register-option options new-option)) gnc:options-add-report-date! options gnc:pagename-general optname-to-date "a" ;; Use a default report date of 'today' gnc:option-set-default-value gnc:lookup-option options gnc:pagename-general optname-to-date cons 'relative 'today add-option gnc:make-multichoice-option . gnc:pagename-general optname-sort-by "i" (N_ "Sort companies by.") 'name list vector 'name N_ "Name" N_ "Name of the company." vector 'total N_ "Total Owed" N_ "Total amount owed to/from Company." vector 'oldest-bracket N_ "Bracket Total Owed" N_ "Amount owed in oldest bracket - if same go to next oldest." add-option gnc:make-multichoice-option . gnc:pagename-general optname-sort-order "ia" (N_ "Sort order.") 'increasing list vector 'increasing (N_ "Increasing") (N_ "Alphabetical order") vector 'decreasing (N_ "Decreasing") (N_ "Reverse alphabetical order") add-option gnc:make-simple-boolean-option . gnc:pagename-general optname-show-zeros "j" N_ "Show all vendors/customers even if they have a zero balance." . #f add-option gnc:make-multichoice-option . gnc:pagename-general optname-date-driver "k" (N_ "Leading date.") 'duedate list ;; Should be using standard label for due date? vector 'duedate N_ "Due Date" N_ "Due date is leading." vector 'postdate N_ "Post Date" N_ "Post date is leading." gnc:options-set-default-section options "General" for-each lambda (opt) add-option gnc:make-simple-boolean-option . gnc:pagename-display (car opt) (cadr opt) (caddr opt) #f . addr-options-list . options define (options->address options receivable? owner) define (op-value name) gnc:option-value gnc:lookup-option options gnc:pagename-display name let* : address-list-names (map car addr-options-list) address-list-options (map op-value address-list-names) addr-source : if receivable? (op-value optname-addr-source) 'billing result-list cond owner let : addr if : eq? addr-source 'shipping gncCustomerGetShipAddr : gncOwnerGetCustomer owner gncOwnerGetAddr owner list : gncAddressGetName addr gncAddressGetAddr1 addr gncAddressGetAddr2 addr gncAddressGetAddr3 addr gncAddressGetAddr4 addr gncAddressGetPhone addr gncAddressGetFax addr gncAddressGetEmail addr if (gncOwnerGetActive owner) (G_ "Y") (G_ "N") else address-list-names fold-right (lambda (opt elt prev) (if opt (cons elt prev) prev)) . '() address-list-options result-list define (split-is-not-business? split) let : : type : xaccTransGetTxnType : xaccSplitGetParent split not or : eqv? type TXN-TYPE-INVOICE eqv? type TXN-TYPE-PAYMENT define (split-has-owner? split owner) gncOwnerEqual (gnc:split->owner split) owner define (split-owner-is-invalid? split) not (gncOwnerIsValid (gnc:split->owner split)) define (split-from-acct? split acct) equal? acct (xaccSplitGetAccount split) define (list-split lst fn cmp) let-values : (list-yes list-no) : partition (lambda (elt) (fn elt cmp)) lst cons list-yes list-no ;;;; first 186 lines end here. The original now starts with the aging renderer.