IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Bug 637004 Optionally allow customer and vendor address info to display

Browse Source 
Use an internal option to hold receivable/payable flag,
  remove trailing spaces.
This commit is contained in:
goodvibes2 2016-06-20 19:45:28 +10:00 committed by Geert Janssens
parent 3e37be8144
commit 5ed887715b
3 changed files with 74 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
src/report/business-reports/aging.scm
View File

@ -167,7 +167,7 @@
(gnc-numeric-sub-fixed amount current-bucket-amt) (gnc-numeric-sub-fixed amount current-bucket-amt)
buckets buckets
(+ current-bucket-index 1))))))) (+ current-bucket-index 1)))))))
(let ((overpayment (company-get-overpayment company))) (let ((overpayment (company-get-overpayment company)))
;; if there's already an overpayment, make it bigger ;; if there's already an overpayment, make it bigger
(gnc:debug "processing payment of " amount) (gnc:debug "processing payment of " amount)
@ -175,11 +175,11 @@
(if (gnc-numeric-positive-p overpayment) (if (gnc-numeric-positive-p overpayment)
(company-set-overpayment company (gnc-numeric-add-fixed overpayment amount)) (company-set-overpayment company (gnc-numeric-add-fixed overpayment amount))
(let ((result (process-payment-driver amount (company-get-buckets company) 0))) (let ((result (process-payment-driver amount (company-get-buckets company) 0)))
(gnc:debug "payment-driver processed. new overpayment: " result) (gnc:debug "payment-driver processed. new overpayment: " result)
(company-set-overpayment company result))))) (company-set-overpayment company result)))))
;; determine date function to use ;; determine date function to use
(define (get-selected-date-from-txn transaction date-type) (define (get-selected-date-from-txn transaction date-type)
(if (eq? date-type 'postdate) (if (eq? date-type 'postdate)
@ -233,7 +233,7 @@ more than one currency. This report is not designed to cope with this possibilit
(hash-set! hash guid company-info) (hash-set! hash guid company-info)
(cons #t guid))) (cons #t guid)))
(gncOwnerFree temp-owner)) (gncOwnerFree temp-owner))
;; if it's a new company ;; if it's a new company
(begin (begin
(gnc:debug "value" value) (gnc:debug "value" value)
@ -245,7 +245,7 @@ more than one currency. This report is not designed to cope with this possibilit
(cons #t guid)))) (cons #t guid))))
; else (no owner) ; else (no owner)
(gncOwnerFree temp-owner)))) (gncOwnerFree temp-owner))))
;; figure out if this split is part of a closed lot ;; figure out if this split is part of a closed lot
;; also save the split value... ;; also save the split value...
(let* ((lot (xaccSplitGetLot split)) (let* ((lot (xaccSplitGetLot split))
@ -272,7 +272,7 @@ more than one currency. This report is not designed to cope with this possibilit
;; compare by the total in the buckets ;; compare by the total in the buckets
(define (compare-total litem-a litem-b) (define (compare-total litem-a litem-b)
(let* ((company-a (cdr litem-a)) (let* ((company-a (cdr litem-a))
(bucket-a (company-get-buckets company-a)) (bucket-a (company-get-buckets company-a))
(company-b (cdr litem-b)) (company-b (cdr litem-b))
@ -299,19 +299,19 @@ more than one currency. This report is not designed to cope with this possibilit
(if (= diff 0) (if (= diff 0)
(driver (cdr buckets-a) (cdr buckets-b)) (driver (cdr buckets-a) (cdr buckets-b))
diff)))) diff))))
(let* ((company-a (cdr litem-a)) (let* ((company-a (cdr litem-a))
(bucket-a (vector->list (company-get-buckets company-a))) (bucket-a (vector->list (company-get-buckets company-a)))
(company-b (cdr litem-b)) (company-b (cdr litem-b))
(bucket-b (vector->list (company-get-buckets company-b))) (bucket-b (vector->list (company-get-buckets company-b)))
(difference (driver bucket-a bucket-b))) (difference (driver bucket-a bucket-b)))
;; if same totals, compare by name ;; if same totals, compare by name
(if (= difference 0) (if (= difference 0)
(gnc:safe-strcmp (car litem-a) (car litem-b)) (gnc:safe-strcmp (car litem-a) (car litem-b))
difference))) difference)))
;; set up the query to get the splits in the chosen account ;; set up the query to get the splits in the chosen account
;; XXX: FIXME: begindate is a hack -- we currently only go back a year ;; XXX: FIXME: begindate is a hack -- we currently only go back a year
(define (setup-query query account date) (define (setup-query query account date)
@ -329,13 +329,14 @@ more than one currency. This report is not designed to cope with this possibilit
(list SPLIT-TRANS TRANS-DATE-POSTED) (list SPLIT-TRANS TRANS-DATE-POSTED)
'() '()) '() '())
(qof-query-set-sort-increasing query #t #t #t))) (qof-query-set-sort-increasing query #t #t #t)))
(define (aging-options-generator options receivable)
(define (aging-options-generator options)
(let* ((add-option (let* ((add-option
(lambda (new-option) (lambda (new-option)
(gnc:register-option options new-option)))) (gnc:register-option options new-option))))
(gnc:options-add-report-date! (gnc:options-add-report-date!
options gnc:pagename-general options gnc:pagename-general
optname-to-date "a") optname-to-date "a")
@ -344,7 +345,7 @@ more than one currency. This report is not designed to cope with this possibilit
gnc:pagename-general gnc:pagename-general
optname-to-date) optname-to-date)
(cons 'relative 'today)) (cons 'relative 'today))
;; all about currencies ;; all about currencies
(gnc:options-add-currency! (gnc:options-add-currency!
options gnc:pagename-general options gnc:pagename-general
@ -404,23 +405,12 @@ totals to report currency.")
(list (list
(vector 'duedate (N_ "Due Date") (N_ "Due date is leading.")) ;; Should be using standard label for due date? (vector 'duedate (N_ "Due Date") (N_ "Due date is leading.")) ;; Should be using standard label for due date?
(vector 'postdate (N_ "Post Date") (N_ "Post date is leading."))))) ;; Should be using standard label for post date? (vector 'postdate (N_ "Post Date") (N_ "Post date is leading."))))) ;; Should be using standard label for post date?
;; display tab options ;; display tab options
(gnc:debug "aging-options-generator: receivable=" receivable) ;; option optname-addr-source is added in receivables.scm
;; as cannot access the value of an option in aging-options-generator
(if receivable
(add-option
(gnc:make-multichoice-option
gnc:pagename-display
optname-addr-source
"a"
(N_ "Address source.")
'billing
(list
(vector 'billing (N_ "Billing") (N_ "Address fields from billing address."))
(vector 'shipping (N_ "Shipping") (N_ "Address fields from shipping address."))))))
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display gnc:pagename-display
@ -445,7 +435,7 @@ copying this report to a spreadsheet for use in a mail merge.")
"d" "d"
(N_ "Display Address 2.") (N_ "Display Address 2.")
#f)) #f))
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display gnc:pagename-display
@ -453,7 +443,7 @@ copying this report to a spreadsheet for use in a mail merge.")
"e" "e"
(N_ "Display Address 3.") (N_ "Display Address 3.")
#f)) #f))
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display gnc:pagename-display
@ -461,7 +451,7 @@ copying this report to a spreadsheet for use in a mail merge.")
"f" "f"
(N_ "Display Address 4.") (N_ "Display Address 4.")
#f)) #f))
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display gnc:pagename-display
@ -469,7 +459,7 @@ copying this report to a spreadsheet for use in a mail merge.")
"g" "g"
(N_ "Display Phone.") (N_ "Display Phone.")
#f)) #f))
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display gnc:pagename-display
@ -477,7 +467,7 @@ copying this report to a spreadsheet for use in a mail merge.")
"h" "h"
(N_ "Display Fax.") (N_ "Display Fax.")
#f)) #f))
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display gnc:pagename-display
@ -485,7 +475,7 @@ copying this report to a spreadsheet for use in a mail merge.")
"i" "i"
(N_ "Display Email.") (N_ "Display Email.")
#f)) #f))
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display gnc:pagename-display
@ -493,8 +483,8 @@ copying this report to a spreadsheet for use in a mail merge.")
"j" "j"
(N_ "Display Active status.") (N_ "Display Active status.")
#f)) #f))
(gnc:options-set-default-section options "General") (gnc:options-set-default-section options "General")
options)) options))
(define (make-interval-list to-date) (define (make-interval-list to-date)
@ -510,8 +500,10 @@ copying this report to a spreadsheet for use in a mail merge.")
(define oldintervalreversed (reverse (make-interval-list to-date))) (define oldintervalreversed (reverse (make-interval-list to-date)))
(reverse (cons dayforcurrent oldintervalreversed))) (reverse (cons dayforcurrent oldintervalreversed)))
(define (aging-renderer report-obj reportname account reverse? receivable) (define (aging-renderer report-obj reportname account reverse?)
(define receivable #t) ;; receivable=#t payable=#f
(define (get-name a) (define (get-name a)
(let* ((owner (company-get-owner-obj (cdr a)))) (let* ((owner (company-get-owner-obj (cdr a))))
(gncOwnerGetName owner))) (gncOwnerGetName owner)))
@ -534,8 +526,7 @@ copying this report to a spreadsheet for use in a mail merge.")
(< (compare-buckets a b) 0)) (< (compare-buckets a b) 0))
(lambda (a b) (lambda (a b)
(> (compare-buckets a b) 0)))))) (> (compare-buckets a b) 0))))))
(define (get-sort-pred sort-criterion sort-order) (define (get-sort-pred sort-criterion sort-order)
(let ((choice (assq-ref sort-preds sort-criterion))) (let ((choice (assq-ref sort-preds sort-criterion)))
@ -550,15 +541,12 @@ copying this report to a spreadsheet for use in a mail merge.")
(gnc:warn "internal sorting option errorin aging.scm") (gnc:warn "internal sorting option errorin aging.scm")
(lambda (a b) (lambda (a b)
(string<? (car a) (car b))))))) (string<? (car a) (car b)))))))
(define (get-op section name) (define (get-op section name)
(gnc:lookup-option (gnc:report-options report-obj) section name)) (gnc:lookup-option (gnc:report-options report-obj) section name))
(define (op-value section name) (define (op-value section name)
(begin (gnc:option-value (get-op section name)))
;; (gnc:debug "op-value: name=" name)
(gnc:option-value (get-op section name)))
)
;; XXX: This is a hack - will be fixed when we move to a ;; XXX: This is a hack - will be fixed when we move to a
@ -660,13 +648,11 @@ copying this report to a spreadsheet for use in a mail merge.")
;; note customers have a shipping address but not vendors ;; note customers have a shipping address but not vendors
(define (get-addr owner disp-addr-source) (define (get-addr owner disp-addr-source)
(begin
;; (gnc:debug "get-addr: disp-addr-source=" disp-addr-source)
(if (and receivable (eq? disp-addr-source 'shipping)) (if (and receivable (eq? disp-addr-source 'shipping))
(gncCustomerGetShipAddr (gncOwnerGetCustomer owner)) ;; shipping (gncCustomerGetShipAddr (gncOwnerGetCustomer owner)) ;; shipping
(gncOwnerGetAddr owner))) ;; billing (gncOwnerGetAddr owner))) ;; billing
)
(set! receivable (eq? (op-value "__hidden" "receivable-or-payable") 'R))
(gnc:report-starting reportname) (gnc:report-starting reportname)
(let* ((companys (make-hash-table 23)) (let* ((companys (make-hash-table 23))
(report-title (op-value gnc:pagename-general gnc:optname-reportname)) (report-title (op-value gnc:pagename-general gnc:optname-reportname))
@ -706,7 +692,7 @@ copying this report to a spreadsheet for use in a mail merge.")
(document (gnc:make-html-document))) (document (gnc:make-html-document)))
; (gnc:debug "Account: " account) ; (gnc:debug "Account: " account)
;; add optional column headings ;; add optional column headings
(if disp-addr-name (if disp-addr-name
(set! heading-list (append heading-list (list (_ "Address Name"))))) (set! heading-list (append heading-list (list (_ "Address Name")))))
(if disp-addr1 (if disp-addr1

14
src/report/business-reports/payables.scm
View File

@ -37,7 +37,6 @@
(define acc-page gnc:pagename-general) (define acc-page gnc:pagename-general)
(define this-acc (N_ "Payable Account")) (define this-acc (N_ "Payable Account"))
(define receivable #f) ;; receivable = #t, payable = #f
(define (options-generator) (define (options-generator)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
@ -51,7 +50,16 @@
"w" (N_ "The payable account you wish to examine.") "w" (N_ "The payable account you wish to examine.")
#f #f (list ACCT-TYPE-PAYABLE))) #f #f (list ACCT-TYPE-PAYABLE)))
(aging-options-generator options receivable))) ;; As aging.scm functions are used by both receivables.scm and payables.scm
;; add option "receivable" on hidden page "__hidden" with default value 'P
;; so aging.scm functions can tell if they are reporting on
;; accounts receivable or payable, as customers have a shipping address
;; but vendors do not. The Address Source option therefore only applies
;; to customers.
(add-option
(gnc:make-internal-option "__hidden" "receivable-or-payable" 'P))
(aging-options-generator options)))
(define (payables-renderer report-obj) (define (payables-renderer report-obj)
(define (opt-val section name) (define (opt-val section name)
@ -60,7 +68,7 @@
(let ((payables-account (opt-val acc-page this-acc))) (let ((payables-account (opt-val acc-page this-acc)))
(gnc:debug "payables-account" payables-account) (gnc:debug "payables-account" payables-account)
(aging-renderer report-obj this-acc payables-account #f receivable))) (aging-renderer report-obj this-acc payables-account #f)))
(define payables-aging-guid "e57770f2dbca46619d6dac4ac5469b50") (define payables-aging-guid "e57770f2dbca46619d6dac4ac5469b50")

26
src/report/business-reports/receivables.scm
View File

@ -37,7 +37,7 @@
(define acc-page gnc:pagename-general) (define acc-page gnc:pagename-general)
(define this-acc (N_ "Receivables Account")) (define this-acc (N_ "Receivables Account"))
(define receivable #t) ;; receivable = #t, payable = #f (define optname-addr-source (N_ "Address Source")) ;; Billing or Shipping addresses
(define (options-generator) (define (options-generator)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
@ -51,7 +51,27 @@
"w" (N_ "The receivables account you wish to examine.") "w" (N_ "The receivables account you wish to examine.")
#f #f (list ACCT-TYPE-RECEIVABLE))) #f #f (list ACCT-TYPE-RECEIVABLE)))
(aging-options-generator options receivable))) ;; As aging.scm functions are used by both receivables.scm and payables.scm
;; add option "receivable" on hidden page "__hidden" with default value 'R
;; so aging.scm functions can tell if they are reporting on
;; accounts receivable or payable, as customers have a shipping address
;; but vendors do not. The Address Source option therefore only applies
;; to customers.
(add-option
(gnc:make-internal-option "__hidden" "receivable-or-payable" 'R))
(add-option
(gnc:make-multichoice-option
gnc:pagename-display
optname-addr-source
"a"
(N_ "Address source.")
'billing
(list
(vector 'billing (N_ "Billing") (N_ "Address fields from billing address."))
(vector 'shipping (N_ "Shipping") (N_ "Address fields from shipping address.")))))
(aging-options-generator options)))
(define (receivables-renderer report-obj) (define (receivables-renderer report-obj)
(define (op-value section name) (define (op-value section name)
@ -61,7 +81,7 @@
(let* ((receivables-account (op-value acc-page this-acc))) (let* ((receivables-account (op-value acc-page this-acc)))
(gnc:debug "receivables-account" receivables-account) (gnc:debug "receivables-account" receivables-account)
(aging-renderer report-obj this-acc receivables-account #t receivable))) (aging-renderer report-obj this-acc receivables-account #t)))
(define receivables-aging-guid "9cf76bed17f14401b8e3e22d0079cb98") (define receivables-aging-guid "9cf76bed17f14401b8e3e22d0079cb98")