mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge Chris Lam's consolidated invoice report into maint.
This commit is contained in:
John Ralls
commit
b05082a09d
@ -3,8 +3,6 @@ add_subdirectory (test)
|
|||||||
set (business_reports_SCHEME
|
set (business_reports_SCHEME
|
||||||
aging.scm
|
aging.scm
|
||||||
customer-summary.scm
|
customer-summary.scm
|
||||||
easy-invoice.scm
|
|
||||||
fancy-invoice.scm
|
|
||||||
taxinvoice.scm
|
taxinvoice.scm
|
||||||
receipt.scm
|
receipt.scm
|
||||||
invoice.scm
|
invoice.scm
|
||||||
|
|||||||
@ -110,9 +110,7 @@
|
|||||||
0
|
0
|
||||||
))
|
))
|
||||||
|
|
||||||
(use-modules (gnucash report fancy-invoice))
|
|
||||||
(use-modules (gnucash report invoice))
|
(use-modules (gnucash report invoice))
|
||||||
(use-modules (gnucash report easy-invoice))
|
|
||||||
(use-modules (gnucash report taxinvoice))
|
(use-modules (gnucash report taxinvoice))
|
||||||
(use-modules (gnucash report receipt))
|
(use-modules (gnucash report receipt))
|
||||||
(use-modules (gnucash report owner-report))
|
(use-modules (gnucash report owner-report))
|
||||||
|
|||||||
@ -1,811 +0,0 @@
|
|||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; -*-scheme-*-
|
|
||||||
;; easy-invoice.scm -- an easily configured Invoice Report,
|
|
||||||
;; used to print a GncInvoice
|
|
||||||
;;
|
|
||||||
;; Created by: James Strandboge <jstrand1@rochester.rr.com>
|
|
||||||
;;
|
|
||||||
;; Based on invoice.scm by Derek Atkins <warlord@MIT.EDU>
|
|
||||||
;;
|
|
||||||
;; stylesheet-header.scm : stylesheet with nicer layout
|
|
||||||
;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
|
|
||||||
;;
|
|
||||||
;; 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 report easy-invoice))
|
|
||||||
|
|
||||||
(use-modules (srfi srfi-1))
|
|
||||||
(use-modules (gnucash gnc-module))
|
|
||||||
(use-modules (gnucash gettext))
|
|
||||||
(use-modules (gnucash utilities))
|
|
||||||
|
|
||||||
(gnc:module-load "gnucash/report/report-system" 0)
|
|
||||||
(use-modules (gnucash report standard-reports))
|
|
||||||
(use-modules (gnucash report business-reports))
|
|
||||||
|
|
||||||
(define (date-col columns-used)
|
|
||||||
(vector-ref columns-used 0))
|
|
||||||
(define (description-col columns-used)
|
|
||||||
(vector-ref columns-used 1))
|
|
||||||
(define (action-col columns-used)
|
|
||||||
(vector-ref columns-used 2))
|
|
||||||
(define (quantity-col columns-used)
|
|
||||||
(vector-ref columns-used 3))
|
|
||||||
(define (price-col columns-used)
|
|
||||||
(vector-ref columns-used 4))
|
|
||||||
(define (discount-col columns-used)
|
|
||||||
(vector-ref columns-used 5))
|
|
||||||
(define (tax-col columns-used)
|
|
||||||
(vector-ref columns-used 6))
|
|
||||||
(define (taxvalue-col columns-used)
|
|
||||||
(vector-ref columns-used 7))
|
|
||||||
(define (value-col columns-used)
|
|
||||||
(vector-ref columns-used 8))
|
|
||||||
|
|
||||||
(define columns-used-size 9)
|
|
||||||
|
|
||||||
(define (num-columns-required columns-used)
|
|
||||||
(do ((i 0 (+ i 1))
|
|
||||||
(col-req 0 col-req))
|
|
||||||
((>= i columns-used-size) col-req)
|
|
||||||
(if (vector-ref columns-used i)
|
|
||||||
(set! col-req (+ col-req 1)))))
|
|
||||||
|
|
||||||
(define (build-column-used options)
|
|
||||||
(define (opt-val section name)
|
|
||||||
(gnc:option-value
|
|
||||||
(gnc:lookup-option options section name)))
|
|
||||||
(define (make-set-col col-vector)
|
|
||||||
(let ((col 0))
|
|
||||||
(lambda (used? index)
|
|
||||||
(if used?
|
|
||||||
(begin
|
|
||||||
(vector-set! col-vector index col)
|
|
||||||
(set! col (+ col 1)))
|
|
||||||
(vector-set! col-vector index #f)))))
|
|
||||||
|
|
||||||
(let* ((col-vector (make-vector columns-used-size #f))
|
|
||||||
(set-col (make-set-col col-vector)))
|
|
||||||
(set-col (opt-val "Display Columns" "Date") 0)
|
|
||||||
(set-col (opt-val "Display Columns" "Description") 1)
|
|
||||||
(set-col (opt-val "Display Columns" "Charge Type") 2)
|
|
||||||
(set-col (opt-val "Display Columns" "Quantity") 3)
|
|
||||||
(set-col (opt-val "Display Columns" "Price") 4)
|
|
||||||
(set-col (opt-val "Display Columns" "Discount") 5)
|
|
||||||
(set-col (opt-val "Display Columns" "Taxable") 6)
|
|
||||||
(set-col (opt-val "Display Columns" "Tax Amount") 7)
|
|
||||||
(set-col (opt-val "Display Columns" "Total") 8)
|
|
||||||
col-vector))
|
|
||||||
|
|
||||||
(define (make-heading-list column-vector)
|
|
||||||
|
|
||||||
(let ((heading-list '()))
|
|
||||||
(if (date-col column-vector)
|
|
||||||
(addto! heading-list (_ "Date")))
|
|
||||||
(if (description-col column-vector)
|
|
||||||
(addto! heading-list (_ "Description")))
|
|
||||||
(if (action-col column-vector)
|
|
||||||
(addto! heading-list (_ "Charge Type")))
|
|
||||||
(if (quantity-col column-vector)
|
|
||||||
(addto! heading-list (_ "Quantity")))
|
|
||||||
(if (price-col column-vector)
|
|
||||||
(addto! heading-list (_ "Unit Price")))
|
|
||||||
(if (discount-col column-vector)
|
|
||||||
(addto! heading-list (_ "Discount")))
|
|
||||||
(if (tax-col column-vector)
|
|
||||||
(addto! heading-list (_ "Taxable")))
|
|
||||||
(if (taxvalue-col column-vector)
|
|
||||||
(addto! heading-list (_ "Tax Amount")))
|
|
||||||
(if (value-col column-vector)
|
|
||||||
(addto! heading-list (_ "Total")))
|
|
||||||
(reverse heading-list)))
|
|
||||||
|
|
||||||
(define (monetary-or-percent numeric currency entry-type)
|
|
||||||
(if (gnc:entry-type-percent-p entry-type)
|
|
||||||
(string-append (gnc:default-html-gnc-numeric-renderer numeric #f) " " (_ "%"))
|
|
||||||
(gnc:make-gnc-monetary currency numeric)))
|
|
||||||
|
|
||||||
(define (add-entry-row table currency entry column-vector row-style cust-doc? credit-note?)
|
|
||||||
(let* ((row-contents '())
|
|
||||||
(entry-value (gnc:make-gnc-monetary
|
|
||||||
currency
|
|
||||||
(gncEntryGetDocValue entry #t cust-doc? credit-note?)))
|
|
||||||
(entry-tax-value (gnc:make-gnc-monetary
|
|
||||||
currency
|
|
||||||
(gncEntryGetDocTaxValue entry #t cust-doc? credit-note?))))
|
|
||||||
|
|
||||||
(if (date-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(qof-print-date (gncEntryGetDate entry))))
|
|
||||||
|
|
||||||
(if (description-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gncEntryGetDescription entry)))
|
|
||||||
|
|
||||||
(if (action-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gncEntryGetAction entry)))
|
|
||||||
|
|
||||||
(if (quantity-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
(gncEntryGetDocQuantity entry credit-note?))))
|
|
||||||
|
|
||||||
(if (price-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
(gnc:make-gnc-monetary
|
|
||||||
currency (if cust-doc? (gncEntryGetInvPrice entry)
|
|
||||||
(gncEntryGetBillPrice entry))))))
|
|
||||||
|
|
||||||
(if (discount-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(if cust-doc?
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
(monetary-or-percent (gncEntryGetInvDiscount entry)
|
|
||||||
currency
|
|
||||||
(gncEntryGetInvDiscountType entry)))
|
|
||||||
"")))
|
|
||||||
|
|
||||||
(if (tax-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(if (if cust-doc?
|
|
||||||
(and (gncEntryGetInvTaxable entry)
|
|
||||||
(gncEntryGetInvTaxTable entry))
|
|
||||||
(and (gncEntryGetBillTaxable entry)
|
|
||||||
(gncEntryGetBillTaxTable entry)))
|
|
||||||
;; Translators: This "T" is displayed in the taxable column, if this entry contains tax
|
|
||||||
(_ "T") "")))
|
|
||||||
|
|
||||||
(if (taxvalue-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
entry-tax-value)))
|
|
||||||
|
|
||||||
(if (value-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
entry-value)))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row/markup! table row-style
|
|
||||||
(reverse row-contents))
|
|
||||||
|
|
||||||
(cons entry-value entry-tax-value)))
|
|
||||||
|
|
||||||
(define (options-generator)
|
|
||||||
|
|
||||||
(define gnc:*report-options* (gnc:new-options))
|
|
||||||
|
|
||||||
(define (gnc:register-inv-option new-option)
|
|
||||||
(gnc:register-option gnc:*report-options* new-option))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-invoice-option gnc:pagename-general gnc:optname-invoice-number "x" ""
|
|
||||||
(lambda () '()) #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-string-option
|
|
||||||
gnc:pagename-general (N_ "Custom Title")
|
|
||||||
"z" (N_ "A custom string to replace Invoice, Bill or Expense Voucher.")
|
|
||||||
""))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Date")
|
|
||||||
"b" (N_ "Display the date?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Description")
|
|
||||||
"d" (N_ "Display the description?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Charge Type")
|
|
||||||
"g" (N_ "Display the charge type?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Quantity")
|
|
||||||
"ha" (N_ "Display the quantity of items?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Price")
|
|
||||||
"hb" (N_ "Display the price per item?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Discount")
|
|
||||||
"k" (N_ "Display the entry's discount?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Taxable")
|
|
||||||
"l" (N_ "Display the entry's taxable status?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Tax Amount")
|
|
||||||
"m" (N_ "Display each entry's total total tax?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Total")
|
|
||||||
"n" (N_ "Display the entry's value?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "My Company")
|
|
||||||
"oa" (N_ "Display my company name and address?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "My Company ID")
|
|
||||||
"ob" (N_ "Display my company ID?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Due Date")
|
|
||||||
"oc" (N_ "Display due date?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Individual Taxes")
|
|
||||||
"od" (N_ "Display all the individual taxes?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Totals")
|
|
||||||
"pa" (N_ "Display the totals?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Subtotal")
|
|
||||||
"pb" (N_ "Display the subtotals?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "References")
|
|
||||||
"s" (N_ "Display the invoice references?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Billing Terms")
|
|
||||||
"t" (N_ "Display the invoice billing terms?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Billing ID")
|
|
||||||
"ta" (N_ "Display the billing id?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Invoice Notes")
|
|
||||||
"tb" (N_ "Display the invoice notes?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Payments")
|
|
||||||
"tc" (N_ "Display the payments applied to this invoice?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-number-range-option
|
|
||||||
(N_ "Display") (N_ "Invoice Width")
|
|
||||||
"u" (N_ "The minimum width of the invoice.") 600
|
|
||||||
100 1600 0 10))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-text-option
|
|
||||||
(N_ "Text") (N_ "Extra Notes")
|
|
||||||
"v" (N_ "Extra notes to put on the invoice (simple HTML is accepted).")
|
|
||||||
(_ "Thank you for your patronage!")))
|
|
||||||
|
|
||||||
(gnc:options-set-default-section gnc:*report-options* "General")
|
|
||||||
|
|
||||||
gnc:*report-options*)
|
|
||||||
|
|
||||||
|
|
||||||
(define (make-entry-table invoice options add-order cust-doc? credit-note?)
|
|
||||||
(define (opt-val section name)
|
|
||||||
(gnc:option-value
|
|
||||||
(gnc:lookup-option options section name)))
|
|
||||||
|
|
||||||
(let ((show-payments (opt-val "Display" "Payments"))
|
|
||||||
(display-all-taxes (opt-val "Display" "Individual Taxes"))
|
|
||||||
(lot (gncInvoiceGetPostedLot invoice))
|
|
||||||
(txn (gncInvoiceGetPostedTxn invoice))
|
|
||||||
(currency (gncInvoiceGetCurrency invoice))
|
|
||||||
(reverse-payments? (not (gncInvoiceAmountPositive invoice))))
|
|
||||||
|
|
||||||
(define (colspan monetary used-columns)
|
|
||||||
(cond
|
|
||||||
((value-col used-columns) (value-col used-columns))
|
|
||||||
((taxvalue-col used-columns) (taxvalue-col used-columns))
|
|
||||||
(else (price-col used-columns))))
|
|
||||||
|
|
||||||
(define (display-subtotal monetary used-columns)
|
|
||||||
(if (value-col used-columns)
|
|
||||||
monetary
|
|
||||||
(let ((amt (gnc:gnc-monetary-amount monetary)))
|
|
||||||
(if amt
|
|
||||||
(if (gnc-numeric-negative-p amt)
|
|
||||||
(gnc:monetary-neg monetary)
|
|
||||||
monetary)
|
|
||||||
monetary))))
|
|
||||||
|
|
||||||
(define (add-subtotal-row table used-columns
|
|
||||||
subtotal subtotal-style subtotal-label)
|
|
||||||
(let ((subtotal-mon (gnc:make-gnc-monetary currency subtotal)))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row/markup!
|
|
||||||
table
|
|
||||||
subtotal-style
|
|
||||||
(append (cons (gnc:make-html-table-cell/markup
|
|
||||||
"total-label-cell" subtotal-label)
|
|
||||||
'())
|
|
||||||
(list (gnc:make-html-table-cell/size/markup
|
|
||||||
1 (colspan subtotal-mon used-columns)
|
|
||||||
"total-number-cell"
|
|
||||||
(display-subtotal subtotal-mon used-columns)))))))
|
|
||||||
|
|
||||||
(define (add-payment-row table used-columns split total-collector reverse-payments?)
|
|
||||||
(let* ((t (xaccSplitGetParent split))
|
|
||||||
(currency (xaccTransGetCurrency t))
|
|
||||||
;; Depending on the document type, the payments may need to be sign-reversed
|
|
||||||
(amt (gnc:make-gnc-monetary currency
|
|
||||||
(if reverse-payments?
|
|
||||||
(gnc-numeric-neg(xaccSplitGetValue split))
|
|
||||||
(xaccSplitGetValue split))))
|
|
||||||
(payment-style "grand-total")
|
|
||||||
(row '()))
|
|
||||||
|
|
||||||
(total-collector 'add
|
|
||||||
(gnc:gnc-monetary-commodity amt)
|
|
||||||
(gnc:gnc-monetary-amount amt))
|
|
||||||
|
|
||||||
(if (date-col used-columns)
|
|
||||||
(addto! row
|
|
||||||
(qof-print-date (xaccTransGetDate t))))
|
|
||||||
|
|
||||||
(if (description-col used-columns)
|
|
||||||
(addto! row (_ "Payment, thank you")))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row/markup!
|
|
||||||
table
|
|
||||||
payment-style
|
|
||||||
(append (reverse row)
|
|
||||||
(list (gnc:make-html-table-cell/size/markup
|
|
||||||
1 (colspan currency used-columns)
|
|
||||||
"total-number-cell"
|
|
||||||
(display-subtotal amt used-columns)))))))
|
|
||||||
|
|
||||||
(define (do-rows-with-subtotals entries
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
odd-row?)
|
|
||||||
(if (null? entries)
|
|
||||||
(let ((total-collector (gnc:make-commodity-collector)))
|
|
||||||
|
|
||||||
; jamie
|
|
||||||
(if (opt-val "Display" "Subtotal")
|
|
||||||
(add-subtotal-row table used-columns (gncInvoiceGetTotalSubtotal invoice)
|
|
||||||
"grand-total" (_ "Net Price")))
|
|
||||||
|
|
||||||
(if display-all-taxes
|
|
||||||
(let ((acct-val-list (gncInvoiceGetTotalTaxList invoice)))
|
|
||||||
(for-each
|
|
||||||
(lambda (parm)
|
|
||||||
(let* ((value (cdr parm))
|
|
||||||
(acct (car parm))
|
|
||||||
(name (xaccAccountGetName acct)))
|
|
||||||
(add-subtotal-row table used-columns value
|
|
||||||
"grand-total" name)))
|
|
||||||
acct-val-list))
|
|
||||||
|
|
||||||
; nope, just show the total tax.
|
|
||||||
(add-subtotal-row table used-columns (gncInvoiceGetTotalTax invoice)
|
|
||||||
"grand-total" (_ "Tax")))
|
|
||||||
|
|
||||||
(add-subtotal-row table used-columns (gncInvoiceGetTotal invoice)
|
|
||||||
"grand-total" (_ "Total Price"))
|
|
||||||
|
|
||||||
(total-collector 'add currency (gncInvoiceGetTotal invoice))
|
|
||||||
(if (and show-payments (not (null? lot)))
|
|
||||||
(let ((splits (sort-list!
|
|
||||||
(gnc-lot-get-split-list lot)
|
|
||||||
(lambda (s1 s2)
|
|
||||||
(let ((t1 (xaccSplitGetParent s1))
|
|
||||||
(t2 (xaccSplitGetParent s2)))
|
|
||||||
(< (xaccTransOrder t1 t2) 0))))))
|
|
||||||
(for-each
|
|
||||||
(lambda (split)
|
|
||||||
(if (not (equal? (xaccSplitGetParent split) txn))
|
|
||||||
(add-payment-row table used-columns
|
|
||||||
split total-collector
|
|
||||||
reverse-payments?)))
|
|
||||||
splits)))
|
|
||||||
|
|
||||||
(add-subtotal-row table used-columns (cadr (total-collector 'getpair currency #f))
|
|
||||||
"grand-total" (_ "Amount Due")))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; End of BEGIN -- now here's the code to handle all the entries!
|
|
||||||
;;
|
|
||||||
(let* ((current (car entries))
|
|
||||||
(current-row-style (if odd-row? "normal-row" "alternate-row"))
|
|
||||||
(rest (cdr entries))
|
|
||||||
(next (if (null? rest) #f
|
|
||||||
(car rest)))
|
|
||||||
(entry-values (add-entry-row table
|
|
||||||
currency
|
|
||||||
current
|
|
||||||
used-columns
|
|
||||||
current-row-style
|
|
||||||
cust-doc? credit-note?)))
|
|
||||||
|
|
||||||
(let ((order (gncEntryGetOrder current)))
|
|
||||||
(if (not (null? order)) (add-order order)))
|
|
||||||
|
|
||||||
(do-rows-with-subtotals rest
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
(not odd-row?)))))
|
|
||||||
|
|
||||||
(let* ((table (gnc:make-html-table))
|
|
||||||
(used-columns (build-column-used options))
|
|
||||||
(width (num-columns-required used-columns))
|
|
||||||
(entries (gncInvoiceGetEntries invoice)))
|
|
||||||
|
|
||||||
(gnc:html-table-set-col-headers!
|
|
||||||
table
|
|
||||||
(make-heading-list used-columns))
|
|
||||||
|
|
||||||
(do-rows-with-subtotals entries
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
#t)
|
|
||||||
table)))
|
|
||||||
|
|
||||||
(define (string-expand string character replace-string)
|
|
||||||
(define (car-line chars)
|
|
||||||
(take-while (lambda (c) (not (eqv? c character))) chars))
|
|
||||||
(define (cdr-line chars)
|
|
||||||
(let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars)))
|
|
||||||
(if (null? rest)
|
|
||||||
'()
|
|
||||||
(cdr rest))))
|
|
||||||
(define (line-helper chars)
|
|
||||||
(if (null? chars)
|
|
||||||
""
|
|
||||||
(let ((first (car-line chars))
|
|
||||||
(rest (cdr-line chars)))
|
|
||||||
(string-append (list->string first)
|
|
||||||
(if (null? rest) "" replace-string)
|
|
||||||
(line-helper rest)))))
|
|
||||||
(line-helper (string->list string)))
|
|
||||||
|
|
||||||
(define (make-client-table owner orders)
|
|
||||||
(let ((table (gnc:make-html-table)))
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "border" 0)
|
|
||||||
'attribute (list "cellspacing" 0)
|
|
||||||
'attribute (list "cellpadding" 0))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
(string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list "<br/>"))
|
|
||||||
(for-each
|
|
||||||
(lambda (order)
|
|
||||||
(let* ((reference (gncOrderGetReference order)))
|
|
||||||
(if (and reference (> (string-length reference) 0))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
;; This string is supposed to be an abbrev. for "Reference"?
|
|
||||||
(string-append (_ "REF") ": " reference))))))
|
|
||||||
orders)
|
|
||||||
(gnc:html-table-set-last-row-style!
|
|
||||||
table "td"
|
|
||||||
'attribute (list "valign" "top"))
|
|
||||||
table))
|
|
||||||
|
|
||||||
(define (make-date-row! table label date date-format)
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
(string-append label ": ")
|
|
||||||
(string-expand (strftime date-format
|
|
||||||
(localtime date))
|
|
||||||
#\space " "))))
|
|
||||||
|
|
||||||
(define (make-date-table)
|
|
||||||
(let ((table (gnc:make-html-table)))
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "border" 0)
|
|
||||||
'attribute (list "cellpadding" 0))
|
|
||||||
(gnc:html-table-set-last-row-style!
|
|
||||||
table "td"
|
|
||||||
'attribute (list "valign" "top"))
|
|
||||||
table))
|
|
||||||
|
|
||||||
(define (make-myname-table book)
|
|
||||||
(let* ((table (gnc:make-html-table))
|
|
||||||
(name (gnc:company-info book gnc:*company-name*))
|
|
||||||
(addy (gnc:company-info book gnc:*company-addy*)))
|
|
||||||
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "border" 0)
|
|
||||||
'attribute (list "width" "100%")
|
|
||||||
'attribute (list "align" "right")
|
|
||||||
'attribute (list "valign" "top")
|
|
||||||
'attribute (list "cellspacing" 0)
|
|
||||||
'attribute (list "cellpadding" 0))
|
|
||||||
(gnc:html-table-append-row! table
|
|
||||||
(list (if name (string-append "<div align='right'>" name "</div>") "")))
|
|
||||||
|
|
||||||
; this is pretty strange. If addy is set, then make caddy <div>addy</div>,
|
|
||||||
; then when adding the row to the table, we actually add several rows by expanding
|
|
||||||
; caddy (the <div> is already set for the first in list and </dev> for last because
|
|
||||||
; of addy)
|
|
||||||
(if (and addy (> (string-length addy) 0))
|
|
||||||
(let ((caddy (string-append "<div align='right'>" addy "</div>")))
|
|
||||||
(gnc:html-table-append-row! table (list (string-expand caddy
|
|
||||||
#\newline "</td></tr><tr><td><div align='right'>")))))
|
|
||||||
table))
|
|
||||||
|
|
||||||
(define (add-html! document htmlstring)
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(N_ htmlstring))))
|
|
||||||
|
|
||||||
(define (make-break! document)
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(gnc:html-markup-br))))
|
|
||||||
|
|
||||||
(define (reg-renderer report-obj)
|
|
||||||
(define (opt-val section name)
|
|
||||||
(gnc:option-value
|
|
||||||
(gnc:lookup-option (gnc:report-options report-obj) section name)))
|
|
||||||
|
|
||||||
(define (title-string title custom-title)
|
|
||||||
(if (not (equal? "" custom-title))
|
|
||||||
(string-expand custom-title
|
|
||||||
#\space " ")
|
|
||||||
title))
|
|
||||||
|
|
||||||
(let* ((document (gnc:make-html-document))
|
|
||||||
(table '())
|
|
||||||
(orders '())
|
|
||||||
(invoice (opt-val gnc:pagename-general gnc:optname-invoice-number))
|
|
||||||
(owner '())
|
|
||||||
(references? (opt-val "Display" "References"))
|
|
||||||
(default-title (_ "Invoice"))
|
|
||||||
(custom-title (opt-val gnc:pagename-general "Custom Title"))
|
|
||||||
(title "")
|
|
||||||
(cust-doc? #f)
|
|
||||||
(credit-note? #f))
|
|
||||||
|
|
||||||
(define (add-order o)
|
|
||||||
(if (and references? (not (member o orders)))
|
|
||||||
(addto! orders o)))
|
|
||||||
|
|
||||||
(if (not (null? invoice))
|
|
||||||
(begin
|
|
||||||
(set! owner (gncInvoiceGetOwner invoice))
|
|
||||||
(let ((type (gncInvoiceGetType invoice)))
|
|
||||||
(cond
|
|
||||||
((eqv? type GNC-INVOICE-CUST-INVOICE)
|
|
||||||
(set! cust-doc? #t))
|
|
||||||
((eqv? type GNC-INVOICE-VEND-INVOICE)
|
|
||||||
(set! default-title (_ "Bill")))
|
|
||||||
((eqv? type GNC-INVOICE-EMPL-INVOICE)
|
|
||||||
(set! default-title (_ "Expense Voucher")))
|
|
||||||
((eqv? type GNC-INVOICE-CUST-CREDIT-NOTE)
|
|
||||||
(begin
|
|
||||||
(set! cust-doc? #t)
|
|
||||||
(set! credit-note? #t)
|
|
||||||
(set! default-title (_ "Credit Note"))))
|
|
||||||
((eqv? type GNC-INVOICE-VEND-CREDIT-NOTE)
|
|
||||||
(begin
|
|
||||||
(set! credit-note? #t)
|
|
||||||
(set! default-title (_ "Credit Note"))))
|
|
||||||
((eqv? type GNC-INVOICE-EMPL-CREDIT-NOTE)
|
|
||||||
(begin
|
|
||||||
(set! credit-note? #t)
|
|
||||||
(set! default-title (_ "Credit Note"))))))
|
|
||||||
(set! title (format #f (_"~a #~a") (title-string default-title custom-title)
|
|
||||||
(gncInvoiceGetID invoice)))))
|
|
||||||
|
|
||||||
; (gnc:html-document-set-title! document title)
|
|
||||||
|
|
||||||
; framing table
|
|
||||||
(add-html! document "<center><table width='")
|
|
||||||
(add-html! document (opt-val "Display" "Invoice Width"))
|
|
||||||
(add-html! document "' cellpadding='0' cellspacing='0'>")
|
|
||||||
|
|
||||||
(add-html! document "<tr><td align='left'>")
|
|
||||||
|
|
||||||
(if (not (null? invoice))
|
|
||||||
(let* ((book (gncInvoiceGetBook invoice))
|
|
||||||
(date-format (gnc:options-fancy-date book)))
|
|
||||||
|
|
||||||
; invoice number and ID String table
|
|
||||||
(add-html! document "<table width='100%'><tr>")
|
|
||||||
(add-html! document "<td align='left'>")
|
|
||||||
(add-html! document "<b><u>")
|
|
||||||
(add-html! document title)
|
|
||||||
;; (add-html! document (format #f (_ "Invoice #~a")
|
|
||||||
;; (gncInvoiceGetID invoice)))
|
|
||||||
(add-html! document "</u></b></td>")
|
|
||||||
(add-html! document "<td align='right'>")
|
|
||||||
|
|
||||||
(if (opt-val "Display" "My Company ID")
|
|
||||||
(let* ((taxid (gnc:company-info book gnc:*company-id*)))
|
|
||||||
(if (and taxid (> (string-length taxid) 0))
|
|
||||||
(begin
|
|
||||||
(add-html! document taxid)
|
|
||||||
(add-html! document " ")))
|
|
||||||
)
|
|
||||||
)
|
|
||||||
(add-html! document "</td>")
|
|
||||||
(add-html! document "</tr></table>")
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
; add the client and company name table
|
|
||||||
(let ((book (gncInvoiceGetBook invoice)))
|
|
||||||
(set! table (make-entry-table invoice
|
|
||||||
(gnc:report-options report-obj)
|
|
||||||
add-order cust-doc? credit-note?))
|
|
||||||
|
|
||||||
(add-html! document "<table width='100%'><tr>")
|
|
||||||
(add-html! document "<td align='left' valign='top'>")
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(make-client-table owner orders))
|
|
||||||
(add-html! document "</td>")
|
|
||||||
(if (opt-val "Display" "My Company")
|
|
||||||
(begin
|
|
||||||
(add-html! document "<td align='right' valign='top'>")
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(make-myname-table book))
|
|
||||||
(add-html! document "</td>")))
|
|
||||||
(add-html! document "</tr></table>")
|
|
||||||
)
|
|
||||||
|
|
||||||
;; add the date
|
|
||||||
(if (gncInvoiceIsPosted invoice)
|
|
||||||
(let ((date-table #f)
|
|
||||||
(post-date (gncInvoiceGetDatePosted invoice))
|
|
||||||
(due-date (gncInvoiceGetDateDue invoice)))
|
|
||||||
(set! date-table (make-date-table))
|
|
||||||
(make-date-row! date-table (_ "Date") post-date date-format)
|
|
||||||
(if (opt-val "Display" "Due Date")
|
|
||||||
(make-date-row! date-table (_ "Due") due-date date-format))
|
|
||||||
(gnc:html-document-add-object! document date-table))
|
|
||||||
(add-html! document
|
|
||||||
(string-append "<font color='red'>"
|
|
||||||
(_ "INVOICE NOT POSTED")
|
|
||||||
"</font>")))
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Billing ID")
|
|
||||||
(let ((billing-id (gncInvoiceGetBillingID invoice)))
|
|
||||||
(if (and billing-id (> (string-length billing-id) 0))
|
|
||||||
(begin
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-append
|
|
||||||
(_ "Billing ID") ": "
|
|
||||||
(string-expand billing-id #\newline "<br/>"))))
|
|
||||||
(make-break! document)))))
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Billing Terms")
|
|
||||||
(let* ((term (gncInvoiceGetTerms invoice))
|
|
||||||
(terms (gncBillTermGetDescription term)))
|
|
||||||
(if (and terms (> (string-length terms) 0))
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-append
|
|
||||||
(_ "Terms") ": "
|
|
||||||
(string-expand terms #\newline "<br/>")))))))
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
; add the main table
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "width" "100%")
|
|
||||||
'attribute (list "border" 1)
|
|
||||||
'attribute (list "cellspacing" 0)
|
|
||||||
'attribute (list "cellpadding" 4))
|
|
||||||
(gnc:html-document-add-object! document table)
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Invoice Notes")
|
|
||||||
(begin
|
|
||||||
(let ((notes (gncInvoiceGetNotes invoice)))
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-expand notes #\newline "<br/>"))))
|
|
||||||
(make-break! document)
|
|
||||||
(make-break! document)))
|
|
||||||
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-expand (opt-val "Text" "Extra Notes") #\newline "<br/>")
|
|
||||||
))
|
|
||||||
|
|
||||||
; close the framing table
|
|
||||||
(add-html! document "</td></tr></table></center>"))
|
|
||||||
|
|
||||||
; else (if invoice
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(_ "No valid invoice selected. Click on the Options button and select the invoice to use."))))
|
|
||||||
|
|
||||||
document))
|
|
||||||
|
|
||||||
(define easy-invoice-guid "67112f318bef4fc496bdc27d106bbda4")
|
|
||||||
|
|
||||||
(gnc:define-report
|
|
||||||
'version 1
|
|
||||||
'name (N_ "Easy Invoice")
|
|
||||||
'report-guid easy-invoice-guid
|
|
||||||
'menu-path (list gnc:menuname-business-reports)
|
|
||||||
'options-generator options-generator
|
|
||||||
'renderer reg-renderer
|
|
||||||
'in-menu? #t)
|
|
||||||
|
|
||||||
(define (gnc:easy-invoice-report-create-internal invoice)
|
|
||||||
(let* ((options (gnc:make-report-options easy-invoice-guid))
|
|
||||||
(invoice-op (gnc:lookup-option options gnc:pagename-general gnc:optname-invoice-number)))
|
|
||||||
|
|
||||||
(gnc:option-set-value invoice-op invoice)
|
|
||||||
(gnc:make-report easy-invoice-guid options)))
|
|
||||||
|
|
||||||
(export gnc:easy-invoice-report-create-internal)
|
|
||||||
@ -1,943 +0,0 @@
|
|||||||
;; -*-scheme-*-
|
|
||||||
;; fancy-invoice.scm -- a Fancy Invoice Report, used to print a GncInvoice
|
|
||||||
;;
|
|
||||||
;; Created by: Derek Atkins <warlord@MIT.EDU>
|
|
||||||
;; Copyright (c) 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
|
|
||||||
|
|
||||||
|
|
||||||
;; Fancy Invoice customized from "invoice.scm"
|
|
||||||
;; Customized by: Oliver Jones <gnucash at oliverstech dot com>
|
|
||||||
;;
|
|
||||||
;; WARNING: customizations are hard-coded, some translations might be
|
|
||||||
;; broken and it won't work for bills/expense vouchers
|
|
||||||
;;
|
|
||||||
;; Customizations are marked with "oli-custom".
|
|
||||||
;;
|
|
||||||
;; Hint: you may set your default options here until a way to save report
|
|
||||||
;; options will be implemented.
|
|
||||||
;;
|
|
||||||
;; You will need to upgrade to gtkhtml-1.1 for the latest features or
|
|
||||||
;; it won't look right. gtkhtml doesn't have support for table
|
|
||||||
;; colgroup, tbody, thead and rules tags yet. When it will, the
|
|
||||||
;; invoice will look even better.
|
|
||||||
;;
|
|
||||||
;; This is a quick and dirty hack. The proper way to do this (when I
|
|
||||||
;; or someone else will have time) is to have the user supply an HTML
|
|
||||||
;; template. The most common used templates will be distributed with
|
|
||||||
;; gnucash.
|
|
||||||
|
|
||||||
;; Modified to use settable options instead of the hard coded ones.
|
|
||||||
;; modified by Brian Dolbec <dol-sen at telus dot net> Feb. 6, 2006
|
|
||||||
|
|
||||||
(define-module (gnucash report fancy-invoice))
|
|
||||||
|
|
||||||
(use-modules (srfi srfi-1))
|
|
||||||
(use-modules (gnucash gnc-module))
|
|
||||||
(use-modules (gnucash gettext))
|
|
||||||
(use-modules (gnucash utilities))
|
|
||||||
|
|
||||||
(gnc:module-load "gnucash/report/report-system" 0)
|
|
||||||
(use-modules (gnucash report standard-reports))
|
|
||||||
(use-modules (gnucash report business-reports))
|
|
||||||
|
|
||||||
(define (date-col columns-used)
|
|
||||||
(vector-ref columns-used 0))
|
|
||||||
(define (description-col columns-used)
|
|
||||||
(vector-ref columns-used 1))
|
|
||||||
(define (action-col columns-used)
|
|
||||||
(vector-ref columns-used 2))
|
|
||||||
(define (quantity-col columns-used)
|
|
||||||
(vector-ref columns-used 3))
|
|
||||||
(define (price-col columns-used)
|
|
||||||
(vector-ref columns-used 4))
|
|
||||||
(define (discount-col columns-used)
|
|
||||||
(vector-ref columns-used 5))
|
|
||||||
(define (tax-col columns-used)
|
|
||||||
(vector-ref columns-used 6))
|
|
||||||
(define (taxvalue-col columns-used)
|
|
||||||
(vector-ref columns-used 7))
|
|
||||||
(define (value-col columns-used)
|
|
||||||
(vector-ref columns-used 8))
|
|
||||||
|
|
||||||
(define columns-used-size 9)
|
|
||||||
|
|
||||||
(define (num-columns-required columns-used)
|
|
||||||
(do ((i 0 (+ i 1))
|
|
||||||
(col-req 0 col-req))
|
|
||||||
((>= i columns-used-size) col-req)
|
|
||||||
(if (vector-ref columns-used i)
|
|
||||||
(set! col-req (+ col-req 1)))))
|
|
||||||
|
|
||||||
(define (build-column-used options)
|
|
||||||
(define (opt-val section name)
|
|
||||||
(gnc:option-value
|
|
||||||
(gnc:lookup-option options section name)))
|
|
||||||
(define (make-set-col col-vector)
|
|
||||||
(let ((col 0))
|
|
||||||
(lambda (used? index)
|
|
||||||
(if used?
|
|
||||||
(begin
|
|
||||||
(vector-set! col-vector index col)
|
|
||||||
(set! col (+ col 1)))
|
|
||||||
(vector-set! col-vector index #f)))))
|
|
||||||
|
|
||||||
(let* ((col-vector (make-vector columns-used-size #f))
|
|
||||||
(set-col (make-set-col col-vector)))
|
|
||||||
(set-col (opt-val "Display Columns" "Date") 0)
|
|
||||||
(set-col (opt-val "Display Columns" "Description") 1)
|
|
||||||
(set-col (opt-val "Display Columns" "Action") 2)
|
|
||||||
(set-col (opt-val "Display Columns" "Quantity") 3)
|
|
||||||
(set-col (opt-val "Display Columns" "Price") 4)
|
|
||||||
(set-col (opt-val "Display Columns" "Discount") 5)
|
|
||||||
(set-col (opt-val "Display Columns" "Taxable") 6)
|
|
||||||
(set-col (opt-val "Display Columns" "Tax Amount") 7)
|
|
||||||
(set-col (opt-val "Display Columns" "Total") 8)
|
|
||||||
col-vector))
|
|
||||||
|
|
||||||
(define (make-heading-list column-vector)
|
|
||||||
|
|
||||||
(let ((heading-list '()))
|
|
||||||
(if (date-col column-vector)
|
|
||||||
(addto! heading-list (_ "Date")))
|
|
||||||
(if (description-col column-vector)
|
|
||||||
(addto! heading-list (_ "Description")))
|
|
||||||
(if (action-col column-vector)
|
|
||||||
(addto! heading-list (_ "Charge Type")))
|
|
||||||
(if (quantity-col column-vector)
|
|
||||||
(addto! heading-list (_ "Quantity")))
|
|
||||||
(if (price-col column-vector)
|
|
||||||
(addto! heading-list (string-expand (_ "Unit Price") #\space " ")))
|
|
||||||
(if (discount-col column-vector)
|
|
||||||
(addto! heading-list (_ "Discount")))
|
|
||||||
(if (tax-col column-vector)
|
|
||||||
(addto! heading-list (_ "Taxable")))
|
|
||||||
(if (taxvalue-col column-vector)
|
|
||||||
(addto! heading-list (_ "Tax Amount")))
|
|
||||||
(if (value-col column-vector)
|
|
||||||
(addto! heading-list (_ "Total")))
|
|
||||||
(reverse heading-list)))
|
|
||||||
|
|
||||||
|
|
||||||
(define (monetary-or-percent numeric currency entry-type)
|
|
||||||
(if (gnc:entry-type-percent-p entry-type)
|
|
||||||
;; oli-custom - make a string instead of a table
|
|
||||||
(string-append (gnc:default-html-gnc-numeric-renderer numeric #f) " " (_ "%"))
|
|
||||||
(gnc:make-gnc-monetary currency numeric)))
|
|
||||||
|
|
||||||
(define (add-entry-row table currency entry column-vector row-style cust-doc? credit-note?)
|
|
||||||
(let* ((row-contents '())
|
|
||||||
(entry-value (gnc:make-gnc-monetary
|
|
||||||
currency
|
|
||||||
(gncEntryGetDocValue entry #t cust-doc? credit-note?)))
|
|
||||||
(entry-tax-value (gnc:make-gnc-monetary
|
|
||||||
currency
|
|
||||||
(gncEntryGetDocTaxValue entry #t cust-doc? credit-note?))))
|
|
||||||
|
|
||||||
(if (date-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(qof-print-date (gncEntryGetDate entry))))
|
|
||||||
|
|
||||||
(if (description-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gncEntryGetDescription entry)))
|
|
||||||
|
|
||||||
(if (action-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gncEntryGetAction entry)))
|
|
||||||
|
|
||||||
(if (quantity-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
(gncEntryGetDocQuantity entry credit-note?))))
|
|
||||||
|
|
||||||
(if (price-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
(gnc:make-gnc-monetary
|
|
||||||
currency (if cust-doc? (gncEntryGetInvPrice entry)
|
|
||||||
(gncEntryGetBillPrice entry))))))
|
|
||||||
|
|
||||||
(if (discount-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(if cust-doc?
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
(monetary-or-percent (gncEntryGetInvDiscount entry)
|
|
||||||
currency
|
|
||||||
(gncEntryGetInvDiscountType entry)))
|
|
||||||
"")))
|
|
||||||
|
|
||||||
(if (tax-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(if (if cust-doc?
|
|
||||||
(and (gncEntryGetInvTaxable entry)
|
|
||||||
(gncEntryGetInvTaxTable entry))
|
|
||||||
(and (gncEntryGetBillTaxable entry)
|
|
||||||
(gncEntryGetBillTaxTable entry)))
|
|
||||||
;; Translators: This "T" is displayed in the taxable column, if this entry contains tax
|
|
||||||
(_ "T") "")))
|
|
||||||
|
|
||||||
(if (taxvalue-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
entry-tax-value)))
|
|
||||||
|
|
||||||
(if (value-col column-vector)
|
|
||||||
(addto! row-contents
|
|
||||||
(gnc:make-html-table-cell/markup
|
|
||||||
"number-cell"
|
|
||||||
entry-value)))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row/markup! table row-style
|
|
||||||
(reverse row-contents))
|
|
||||||
|
|
||||||
(cons entry-value entry-tax-value)))
|
|
||||||
|
|
||||||
;; oli-custom - here you can set your default options
|
|
||||||
|
|
||||||
(define (options-generator)
|
|
||||||
|
|
||||||
(define gnc:*report-options* (gnc:new-options))
|
|
||||||
|
|
||||||
(define (gnc:register-inv-option new-option)
|
|
||||||
(gnc:register-option gnc:*report-options* new-option))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-invoice-option gnc:pagename-general gnc:optname-invoice-number "x" ""
|
|
||||||
(lambda () '()) #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-string-option
|
|
||||||
gnc:pagename-general (N_ "Custom Title")
|
|
||||||
"z" (N_ "A custom string to replace Invoice, Bill or Expense Voucher.")
|
|
||||||
""))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Date")
|
|
||||||
"b" (N_ "Display the date?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Description")
|
|
||||||
"d" (N_ "Display the description?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Action")
|
|
||||||
"g" (N_ "Display the action?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Quantity")
|
|
||||||
"ha" (N_ "Display the quantity of items?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Price")
|
|
||||||
"hb" (N_ "Display the price per item?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Discount")
|
|
||||||
"k" (N_ "Display the entry's discount?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Taxable")
|
|
||||||
"l" (N_ "Display the entry's taxable status?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Tax Amount")
|
|
||||||
"m" (N_ "Display each entry's total total tax?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display Columns") (N_ "Total")
|
|
||||||
"n" (N_ "Display the entry's value?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Individual Taxes")
|
|
||||||
"o" (N_ "Display all the individual taxes?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Totals")
|
|
||||||
"p" (N_ "Display the totals?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "References")
|
|
||||||
"s" (N_ "Display the invoice references?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Billing Terms")
|
|
||||||
"t" (N_ "Display the invoice billing terms?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Billing ID")
|
|
||||||
"ta" (N_ "Display the billing id?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Invoice Notes")
|
|
||||||
"tb" (N_ "Display the invoice notes?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Payments")
|
|
||||||
"tc" (N_ "Display the payments applied to this invoice?") #f))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-number-range-option
|
|
||||||
(N_ "Display") (N_ "Minimum # of entries")
|
|
||||||
"u" (N_ "The minimum number of invoice entries to display.") 23
|
|
||||||
4 23 0 1))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-text-option
|
|
||||||
(N_ "Display") (N_ "Extra Notes")
|
|
||||||
"u" (N_ "Extra notes to put on the invoice.")
|
|
||||||
(_ "Thank you for your patronage!")))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-complex-boolean-option
|
|
||||||
(N_ "Display") (N_ "Payable to")
|
|
||||||
"ua1" (N_ "Display the Payable to: information.") #t #f
|
|
||||||
(lambda (x) (gnc-option-db-set-option-selectable-by-name
|
|
||||||
gnc:*report-options* "Display" "Payable to string" x))))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-text-option
|
|
||||||
(N_ "Display") (N_ "Payable to string")
|
|
||||||
"ua2" (N_ "The phrase for specifying to whom payments should be made.")
|
|
||||||
(_ "Make all cheques Payable to")))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-complex-boolean-option
|
|
||||||
(N_ "Display") (N_ "Company contact")
|
|
||||||
"ub1" (N_ "Display the Company contact information.") #t #f
|
|
||||||
(lambda (x) (gnc-option-db-set-option-selectable-by-name
|
|
||||||
gnc:*report-options* "Display" "Company contact string" x))))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-text-option
|
|
||||||
(N_ "Display") (N_ "Company contact string")
|
|
||||||
"ub2" (N_ "The phrase used to introduce the company contact.")
|
|
||||||
(_ "Direct all inquiries to")))
|
|
||||||
|
|
||||||
(gnc:options-set-default-section gnc:*report-options* "General")
|
|
||||||
|
|
||||||
gnc:*report-options*)
|
|
||||||
|
|
||||||
|
|
||||||
(define (make-entry-table invoice options add-order cust-doc? credit-note?)
|
|
||||||
(define (opt-val section name)
|
|
||||||
(gnc:option-value
|
|
||||||
(gnc:lookup-option options section name)))
|
|
||||||
|
|
||||||
(let ((show-payments (opt-val "Display" "Payments"))
|
|
||||||
(display-all-taxes (opt-val "Display" "Individual Taxes"))
|
|
||||||
(lot (gncInvoiceGetPostedLot invoice))
|
|
||||||
(txn (gncInvoiceGetPostedTxn invoice))
|
|
||||||
(currency (gncInvoiceGetCurrency invoice))
|
|
||||||
(reverse-payments? (not (gncInvoiceAmountPositive invoice)))
|
|
||||||
(entries-added 0))
|
|
||||||
|
|
||||||
(define (colspan monetary used-columns)
|
|
||||||
(cond
|
|
||||||
((value-col used-columns) (value-col used-columns))
|
|
||||||
((taxvalue-col used-columns) (taxvalue-col used-columns))
|
|
||||||
(else (price-col used-columns))))
|
|
||||||
|
|
||||||
(define (display-subtotal monetary used-columns)
|
|
||||||
(if (value-col used-columns)
|
|
||||||
monetary
|
|
||||||
(let ((amt (gnc:gnc-monetary-amount monetary)))
|
|
||||||
(if amt
|
|
||||||
(if (gnc-numeric-negative-p amt)
|
|
||||||
(gnc:monetary-neg monetary)
|
|
||||||
monetary)
|
|
||||||
monetary))))
|
|
||||||
|
|
||||||
(define (get-empty-row colcount)
|
|
||||||
(define row-contents '())
|
|
||||||
(do ((i 1 (+ i 1)))
|
|
||||||
((> i colcount))
|
|
||||||
(addto! row-contents (gnc:make-html-table-cell)) ;;do stuff here
|
|
||||||
)
|
|
||||||
row-contents
|
|
||||||
)
|
|
||||||
|
|
||||||
(define (add-subtotal-row table used-columns
|
|
||||||
subtotal subtotal-style subtotal-label)
|
|
||||||
(let ((subtotal-mon (gnc:make-gnc-monetary currency subtotal)))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row/markup!
|
|
||||||
table
|
|
||||||
subtotal-style
|
|
||||||
(append (cons (gnc:make-html-table-cell/markup
|
|
||||||
"total-label-cell" subtotal-label)
|
|
||||||
'())
|
|
||||||
(list (gnc:make-html-table-cell/size/markup
|
|
||||||
1 (colspan subtotal-mon used-columns)
|
|
||||||
"total-number-cell"
|
|
||||||
(display-subtotal subtotal-mon used-columns)))))))
|
|
||||||
|
|
||||||
(define (add-payment-row table used-columns split total-collector reverse-payments?)
|
|
||||||
(let* ((t (xaccSplitGetParent split))
|
|
||||||
(currency (xaccTransGetCurrency t))
|
|
||||||
(invoice (opt-val gnc:pagename-general gnc:optname-invoice-number))
|
|
||||||
(owner '())
|
|
||||||
;; Depending on the document type, the payments may need to be sign-reversed
|
|
||||||
(amt (gnc:make-gnc-monetary currency
|
|
||||||
(if reverse-payments?
|
|
||||||
(gnc-numeric-neg(xaccSplitGetValue split))
|
|
||||||
(xaccSplitGetValue split))))
|
|
||||||
(payment-style "grand-total")
|
|
||||||
(row '()))
|
|
||||||
|
|
||||||
(total-collector 'add
|
|
||||||
(gnc:gnc-monetary-commodity amt)
|
|
||||||
(gnc:gnc-monetary-amount amt))
|
|
||||||
|
|
||||||
(if (date-col used-columns)
|
|
||||||
(addto! row
|
|
||||||
(qof-print-date (xaccTransGetDate t))))
|
|
||||||
|
|
||||||
(if (description-col used-columns)
|
|
||||||
(addto! row (_ "Payment, thank you")))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row/markup!
|
|
||||||
table
|
|
||||||
payment-style
|
|
||||||
(append (reverse row)
|
|
||||||
(list (gnc:make-html-table-cell/size/markup
|
|
||||||
1 (colspan currency used-columns)
|
|
||||||
"total-number-cell"
|
|
||||||
(display-subtotal amt used-columns)))))))
|
|
||||||
|
|
||||||
(define (do-rows-with-subtotals entries
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
odd-row?)
|
|
||||||
(if (null? entries)
|
|
||||||
(let ((total-collector (gnc:make-commodity-collector)))
|
|
||||||
|
|
||||||
;; oli-custom - modified to have a minimum of entries per table,
|
|
||||||
;; currently defaults to 24
|
|
||||||
;; also, doesn't count payment rows and stuff
|
|
||||||
(do ((entries-added entries-added (+ entries-added 1))
|
|
||||||
(odd-row? odd-row? (not odd-row?)))
|
|
||||||
((> entries-added (opt-val "Display" "Minimum # of entries" )))
|
|
||||||
(gnc:html-table-append-row/markup!
|
|
||||||
table (if odd-row? "normal-row" "alternate-row")
|
|
||||||
(get-empty-row (num-columns-required used-columns)))
|
|
||||||
)
|
|
||||||
|
|
||||||
(add-subtotal-row table used-columns (gncInvoiceGetTotalSubtotal invoice)
|
|
||||||
"grand-total" (_ "Net Price"))
|
|
||||||
|
|
||||||
(if display-all-taxes
|
|
||||||
(let ((acct-val-list (gncInvoiceGetTotalTaxList invoice)))
|
|
||||||
(for-each
|
|
||||||
(lambda (parm)
|
|
||||||
(let* ((value (cdr parm))
|
|
||||||
(acct (car parm))
|
|
||||||
(name (xaccAccountGetName acct)))
|
|
||||||
(add-subtotal-row table used-columns value
|
|
||||||
"grand-total" (string-expand
|
|
||||||
name #\space " "))))
|
|
||||||
acct-val-list))
|
|
||||||
|
|
||||||
; nope, just show the total tax.
|
|
||||||
(add-subtotal-row table used-columns (gncInvoiceGetTotalTax invoice)
|
|
||||||
"grand-total" (_ "Tax")))
|
|
||||||
|
|
||||||
(add-subtotal-row table used-columns (gncInvoiceGetTotal invoice)
|
|
||||||
"grand-total" (string-expand (_ "Total Price")
|
|
||||||
#\space " "))
|
|
||||||
|
|
||||||
(total-collector 'add currency (gncInvoiceGetTotal invoice))
|
|
||||||
(if (and show-payments (not (null? lot)))
|
|
||||||
(let ((splits (sort-list!
|
|
||||||
(gnc-lot-get-split-list lot)
|
|
||||||
(lambda (s1 s2)
|
|
||||||
(let ((t1 (xaccSplitGetParent s1))
|
|
||||||
(t2 (xaccSplitGetParent s2)))
|
|
||||||
(< (xaccTransOrder t1 t2) 0))))))
|
|
||||||
(for-each
|
|
||||||
(lambda (split)
|
|
||||||
(if (not (equal? (xaccSplitGetParent split) txn))
|
|
||||||
(add-payment-row table used-columns
|
|
||||||
split total-collector
|
|
||||||
reverse-payments?)))
|
|
||||||
splits)))
|
|
||||||
|
|
||||||
(add-subtotal-row table used-columns (cadr (total-collector 'getpair currency #f))
|
|
||||||
"grand-total" (string-expand (_ "Amount Due")
|
|
||||||
#\space " ")))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; End of BEGIN -- now here's the code to handle all the entries!
|
|
||||||
;;
|
|
||||||
(let* ((current (car entries))
|
|
||||||
(current-row-style (if odd-row? "normal-row" "alternate-row"))
|
|
||||||
(rest (cdr entries))
|
|
||||||
(next (if (null? rest) #f
|
|
||||||
(car rest)))
|
|
||||||
(entry-values (add-entry-row table
|
|
||||||
currency
|
|
||||||
current
|
|
||||||
used-columns
|
|
||||||
current-row-style
|
|
||||||
cust-doc? credit-note?)))
|
|
||||||
|
|
||||||
(let ((order (gncEntryGetOrder current)))
|
|
||||||
(if (not (null? order)) (add-order order)))
|
|
||||||
|
|
||||||
(set! entries-added (+ entries-added 1))
|
|
||||||
|
|
||||||
(do-rows-with-subtotals rest
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
(not odd-row?)))))
|
|
||||||
|
|
||||||
(let* ((table (gnc:make-html-table))
|
|
||||||
(used-columns (build-column-used options))
|
|
||||||
(width (num-columns-required used-columns))
|
|
||||||
(entries (gncInvoiceGetEntries invoice)))
|
|
||||||
|
|
||||||
(gnc:html-table-set-col-headers!
|
|
||||||
table
|
|
||||||
(make-heading-list used-columns))
|
|
||||||
|
|
||||||
(do-rows-with-subtotals entries
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
#t)
|
|
||||||
table)))
|
|
||||||
|
|
||||||
(define (string-expand string character replace-string)
|
|
||||||
(define (car-line chars)
|
|
||||||
(take-while (lambda (c) (not (eqv? c character))) chars))
|
|
||||||
(define (cdr-line chars)
|
|
||||||
(let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars)))
|
|
||||||
(if (null? rest)
|
|
||||||
'()
|
|
||||||
(cdr rest))))
|
|
||||||
(define (line-helper chars)
|
|
||||||
(if (null? chars)
|
|
||||||
""
|
|
||||||
(let ((first (car-line chars))
|
|
||||||
(rest (cdr-line chars)))
|
|
||||||
(string-append (list->string first)
|
|
||||||
(if (null? rest) "" replace-string)
|
|
||||||
(line-helper rest)))))
|
|
||||||
(line-helper (string->list string)))
|
|
||||||
|
|
||||||
(define (make-client-table owner orders)
|
|
||||||
(let ((table (gnc:make-html-table))
|
|
||||||
(name-cell (gnc:make-html-table-cell)))
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "border" 0)
|
|
||||||
'attribute (list "cellspacing" 0)
|
|
||||||
'attribute (list "cellpadding" 0))
|
|
||||||
(gnc:html-table-cell-append-objects!
|
|
||||||
name-cell (gnc:owner-get-name-dep owner))
|
|
||||||
(gnc:html-table-cell-set-style!
|
|
||||||
name-cell "td"
|
|
||||||
'font-size "+2")
|
|
||||||
(gnc:html-table-append-row! table (list name-cell "" "")) ;;Bert: had a newline and a "<br/>"
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
(string-expand (gnc:owner-get-address-dep owner) #\newline "<br/>")))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list "<br/>"))
|
|
||||||
(for-each
|
|
||||||
(lambda (order)
|
|
||||||
(let* ((reference (gncOrderGetReference order)))
|
|
||||||
(if (and reference (> (string-length reference) 0))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
(string-append (_ "REF") ": " reference))))))
|
|
||||||
orders)
|
|
||||||
(gnc:html-table-set-last-row-style!
|
|
||||||
table "td"
|
|
||||||
'attribute (list "valign" "top"))
|
|
||||||
table))
|
|
||||||
|
|
||||||
(define (make-date-row! table label date date-format)
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
(string-append label ": ")
|
|
||||||
;; oli-custom - modified to display a custom format
|
|
||||||
;; for the invoice date/due date fields
|
|
||||||
;; I could have taken the format from the report options, but... ;)
|
|
||||||
(string-expand (strftime (gnc-default-strftime-date-format)
|
|
||||||
(gnc-localtime date))
|
|
||||||
#\space " ")
|
|
||||||
;;(string-expand (qof-print-date date) #\space " ")
|
|
||||||
)))
|
|
||||||
|
|
||||||
(define (make-date-table)
|
|
||||||
(let ((table (gnc:make-html-table)))
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "border" 0)
|
|
||||||
'attribute (list "cellpadding" 0))
|
|
||||||
(gnc:html-table-set-last-row-style!
|
|
||||||
table "td"
|
|
||||||
'attribute (list "valign" "top"))
|
|
||||||
table))
|
|
||||||
|
|
||||||
(define (make-myname-table book title)
|
|
||||||
(let* ((table (gnc:make-html-table))
|
|
||||||
(name (gnc:company-info book gnc:*company-name*))
|
|
||||||
;; (contact (gnc:company-info book gnc:*company-contact*))
|
|
||||||
(addy (gnc:company-info book gnc:*company-addy*))
|
|
||||||
(id (gnc:company-info book gnc:*company-id*))
|
|
||||||
(phone (gnc:company-info book gnc:*company-phone*))
|
|
||||||
(fax (gnc:company-info book gnc:*company-fax*))
|
|
||||||
(url (gnc:company-info book gnc:*company-url*))
|
|
||||||
(invoice-cell (gnc:make-html-table-cell))
|
|
||||||
(name-cell (gnc:make-html-table-cell))
|
|
||||||
|
|
||||||
)
|
|
||||||
;; oli-custom - modified the name table to increase the
|
|
||||||
;; font size of the company name
|
|
||||||
;; and add an "INVOICE" title to the upper right, also,
|
|
||||||
;; put some contact information in the middle
|
|
||||||
;; FIXME: "INVOICE" should be translated and support bills/expense vouchers
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "border" 0)
|
|
||||||
'attribute (list "cellspacing" 0)
|
|
||||||
'attribute (list "cellpadding" 0)
|
|
||||||
'attribute (list "width" "100%"))
|
|
||||||
(gnc:html-table-cell-append-objects!
|
|
||||||
invoice-cell title)
|
|
||||||
(gnc:html-table-cell-set-style!
|
|
||||||
invoice-cell "td"
|
|
||||||
'font-size "+2")
|
|
||||||
(gnc:html-table-cell-append-objects!
|
|
||||||
name-cell (if name name ""))
|
|
||||||
(gnc:html-table-cell-set-style!
|
|
||||||
name-cell "td"
|
|
||||||
'font-size "+2")
|
|
||||||
(gnc:html-table-append-row! table (list name-cell (gnc:make-html-table-cell) invoice-cell)) ;;(gnc:make-html-table-cell) was ""
|
|
||||||
(gnc:html-table-set-col-style!
|
|
||||||
table 1 "td"
|
|
||||||
'attribute (list "align" "center")
|
|
||||||
'attribute (list "width" "33%"))
|
|
||||||
(gnc:html-table-set-col-style!
|
|
||||||
table 2 "td"
|
|
||||||
'attribute (list "align" "right")
|
|
||||||
'attribute (list "width" "33%"))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table (list (string-expand (string-append (if addy addy "") (if id (string-append "\n" id) "")) #\newline "<br/>")
|
|
||||||
(string-expand
|
|
||||||
(string-append (if phone
|
|
||||||
(string-append (_ "Phone:") " " phone)
|
|
||||||
"")
|
|
||||||
(if fax (string-append (if phone "\n" "")
|
|
||||||
(_ "Fax:") " " fax)
|
|
||||||
""))
|
|
||||||
#\newline "<br/>" )
|
|
||||||
(if url (string-append (_ "Web:") " " url) "")))
|
|
||||||
|
|
||||||
;; oli-custom - I didn't want today's date on the invoice.
|
|
||||||
;; The invoice already has a date.
|
|
||||||
;; Today's date can be in the email, fax or letter accompanying the invoice.
|
|
||||||
;; (gnc:html-table-append-row! table (list
|
|
||||||
;; (strftime
|
|
||||||
;; date-format
|
|
||||||
;; (gnc-localtime (gnc:get-today)))))
|
|
||||||
table))
|
|
||||||
|
|
||||||
(define (make-break! document)
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(gnc:html-markup-br))))
|
|
||||||
|
|
||||||
(define (reg-renderer report-obj)
|
|
||||||
(define (opt-val section name)
|
|
||||||
(gnc:option-value
|
|
||||||
(gnc:lookup-option (gnc:report-options report-obj) section name)))
|
|
||||||
|
|
||||||
(define (title-string title custom-title)
|
|
||||||
(if (not (equal? "" custom-title))
|
|
||||||
(string-expand custom-title
|
|
||||||
#\space " ")
|
|
||||||
title))
|
|
||||||
|
|
||||||
(let* ((document (gnc:make-html-document))
|
|
||||||
(table '())
|
|
||||||
(orders '())
|
|
||||||
(invoice (opt-val gnc:pagename-general gnc:optname-invoice-number))
|
|
||||||
(owner '())
|
|
||||||
(references? (opt-val "Display" "References"))
|
|
||||||
(default-title (_ "Invoice"))
|
|
||||||
(custom-title (opt-val gnc:pagename-general "Custom Title"))
|
|
||||||
(cust-doc? #f)
|
|
||||||
(credit-note? #f))
|
|
||||||
|
|
||||||
|
|
||||||
(define (add-order o)
|
|
||||||
(if (and references? (not (member o orders)))
|
|
||||||
(addto! orders o)))
|
|
||||||
|
|
||||||
(if (not (null? invoice))
|
|
||||||
(begin
|
|
||||||
(set! owner (gncInvoiceGetOwner invoice))
|
|
||||||
(let ((type (gncInvoiceGetType invoice)))
|
|
||||||
(cond
|
|
||||||
((eqv? type GNC-INVOICE-CUST-INVOICE)
|
|
||||||
(set! cust-doc? #t))
|
|
||||||
((eqv? type GNC-INVOICE-VEND-INVOICE)
|
|
||||||
(set! default-title (_ "Bill")))
|
|
||||||
((eqv? type GNC-INVOICE-EMPL-INVOICE)
|
|
||||||
(set! default-title (_ "Expense Voucher")))
|
|
||||||
((eqv? type GNC-INVOICE-CUST-CREDIT-NOTE)
|
|
||||||
(begin
|
|
||||||
(set! cust-doc? #t)
|
|
||||||
(set! credit-note? #t)
|
|
||||||
(set! default-title (_ "Credit Note"))))
|
|
||||||
((eqv? type GNC-INVOICE-VEND-CREDIT-NOTE)
|
|
||||||
(begin
|
|
||||||
(set! credit-note? #t)
|
|
||||||
(set! default-title (_ "Credit Note"))))
|
|
||||||
((eqv? type GNC-INVOICE-EMPL-CREDIT-NOTE)
|
|
||||||
(begin
|
|
||||||
(set! credit-note? #t)
|
|
||||||
(set! default-title (_ "Credit Note"))))))
|
|
||||||
))
|
|
||||||
|
|
||||||
;; oli-custom - title redundant, "Invoice" moved to myname-table,
|
|
||||||
;; invoice number moved below
|
|
||||||
;;(gnc:html-document-set-title! document title)
|
|
||||||
|
|
||||||
|
|
||||||
(if (not (null? invoice))
|
|
||||||
(let* ((book (gncInvoiceGetBook invoice))
|
|
||||||
(date-object #f)
|
|
||||||
(date-format (gnc:options-fancy-date book))
|
|
||||||
(helper-table (gnc:make-html-table))
|
|
||||||
(title (title-string default-title custom-title)))
|
|
||||||
|
|
||||||
(set! table (make-entry-table invoice
|
|
||||||
(gnc:report-options report-obj)
|
|
||||||
add-order cust-doc? credit-note?))
|
|
||||||
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "table"
|
|
||||||
'attribute (list "border" 1)
|
|
||||||
'attribute (list "cellspacing" 0)
|
|
||||||
'attribute (list "cellpadding" 4)
|
|
||||||
;; oli-custom - make table as wide as possible
|
|
||||||
;; works fine with simple style sheet templates,
|
|
||||||
;; doesn't work quite right with fancy ones
|
|
||||||
;; probably supplying the style sheet with a wide image
|
|
||||||
;; for the header (even if transparent/white) would fix it
|
|
||||||
'attribute (list "width" "100%"))
|
|
||||||
|
|
||||||
;; oli-custom - make the description column big
|
|
||||||
;; 50% or 60%, depending on whether the first column is
|
|
||||||
;; displayed or not
|
|
||||||
;; should actually be something more complicated,
|
|
||||||
;; it's a really ugly hack right now :)
|
|
||||||
(gnc:html-table-set-col-style!
|
|
||||||
table (if (opt-val "Display Columns" "Date") 1 0) "td"
|
|
||||||
'attribute (list "width" (if (opt-val "Display Columns" "Date")
|
|
||||||
"50%" "60%")))
|
|
||||||
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document (make-myname-table
|
|
||||||
book title))
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
(make-break! document)
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
;; oli-custom - client table and table with invoice
|
|
||||||
;; number/date/due date both inserted into a table
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
helper-table "table"
|
|
||||||
'attribute (list "border" 0)
|
|
||||||
'attribute (list "cellspacing" 0)
|
|
||||||
'attribute (list "cellpadding" 0)
|
|
||||||
'attribute (list "width" "100%"))
|
|
||||||
|
|
||||||
(set! date-object
|
|
||||||
(if (gncInvoiceIsPosted invoice)
|
|
||||||
(let ((date-table #f)
|
|
||||||
(post-date (gncInvoiceGetDatePosted invoice))
|
|
||||||
(due-date (gncInvoiceGetDateDue invoice)))
|
|
||||||
(set! date-table (make-date-table))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
;; Translators: ~a below is "Invoice" or "Bill" or even the
|
|
||||||
;; custom title from the options. The next column contains
|
|
||||||
;; the number of the document.
|
|
||||||
date-table (list (format #f (_ "~a #") title) (gncInvoiceGetID invoice)))
|
|
||||||
;; Translators: The first ~a below is "Invoice" or
|
|
||||||
;; "Bill" or even the custom title from the
|
|
||||||
;; options. This string sucks for i18n, but I don't
|
|
||||||
;; have a better solution right now without breaking
|
|
||||||
;; other people's invoices.
|
|
||||||
(make-date-row! date-table (format #f (_ "~a Date") title) post-date date-format)
|
|
||||||
(make-date-row! date-table (_ "Due Date") due-date date-format)
|
|
||||||
date-table)
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-append title "<br/>"
|
|
||||||
(_ "Invoice in progress...")))))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
helper-table
|
|
||||||
(list (make-client-table owner orders) date-object))
|
|
||||||
|
|
||||||
(gnc:html-table-set-col-style!
|
|
||||||
helper-table 0 "td"
|
|
||||||
'attribute (list "valign" "top"))
|
|
||||||
|
|
||||||
(gnc:html-table-set-col-style!
|
|
||||||
helper-table 1 "td"
|
|
||||||
'attribute (list "valign" "top")
|
|
||||||
'attribute (list "align" "right")
|
|
||||||
;; oli-custom - "squeeze" the date table,
|
|
||||||
;; or else it's spaced out
|
|
||||||
'attribute (list "width" "1%"))
|
|
||||||
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
helper-table)
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Billing ID")
|
|
||||||
(let ((billing-id (gncInvoiceGetBillingID invoice)))
|
|
||||||
(if (and billing-id (> (string-length billing-id) 0))
|
|
||||||
(begin
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-append
|
|
||||||
(_ "Reference") ": "
|
|
||||||
(string-expand billing-id #\newline "<br/>"))))
|
|
||||||
(make-break! document)))))
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Billing Terms")
|
|
||||||
(let* ((term (gncInvoiceGetTerms invoice))
|
|
||||||
(terms (gncBillTermGetDescription term)))
|
|
||||||
(if (and terms (> (string-length terms) 0))
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-append
|
|
||||||
(_ "Terms") ": "
|
|
||||||
(string-expand terms #\newline "<br/>")))))))
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
(gnc:html-document-add-object! document table)
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Invoice Notes")
|
|
||||||
(let ((notes (gncInvoiceGetNotes invoice)))
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-expand notes #\newline "<br/>")))))
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Payable to")
|
|
||||||
(let* ((name (gnc:company-info book gnc:*company-name*))
|
|
||||||
(name-str (opt-val "Display" "Payable to string")))
|
|
||||||
(if (and name (> (string-length name) 0))
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-append name-str ": "
|
|
||||||
(string-expand name #\newline "<br/>")))))))
|
|
||||||
|
|
||||||
(make-break! document)
|
|
||||||
|
|
||||||
(if (opt-val "Display" "Company contact")
|
|
||||||
(let* ((contact (gnc:company-info book gnc:*company-contact*))
|
|
||||||
(contact-str (opt-val "Display" "Company contact string")))
|
|
||||||
(if (and contact (> (string-length contact) 0))
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(string-append contact-str ": "
|
|
||||||
(string-expand contact #\newline "<br/>")))))))
|
|
||||||
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(gnc:html-markup-br)
|
|
||||||
(string-expand (opt-val "Display" "Extra Notes") #\newline "<br/>")
|
|
||||||
(gnc:html-markup-br))))
|
|
||||||
|
|
||||||
; else
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(_ "No valid invoice selected. Click on the Options button and select the invoice to use."))))
|
|
||||||
|
|
||||||
document))
|
|
||||||
|
|
||||||
(define fancy-invoice-guid "3ce293441e894423a2425d7a22dd1ac6")
|
|
||||||
|
|
||||||
(gnc:define-report
|
|
||||||
'version 1
|
|
||||||
'name (N_ "Fancy Invoice")
|
|
||||||
'report-guid fancy-invoice-guid
|
|
||||||
'menu-path (list gnc:menuname-business-reports)
|
|
||||||
'options-generator options-generator
|
|
||||||
'renderer reg-renderer
|
|
||||||
'in-menu? #t)
|
|
||||||
|
|
||||||
(define (gnc:fancy-invoice-report-create-internal invoice)
|
|
||||||
(let* ((options (gnc:make-report-options fancy-invoice-guid))
|
|
||||||
(invoice-op (gnc:lookup-option options gnc:pagename-general gnc:optname-invoice-number)))
|
|
||||||
|
|
||||||
(gnc:option-set-value invoice-op invoice)
|
|
||||||
(gnc:make-report fancy-invoice-guid options)))
|
|
||||||
|
|
||||||
(export gnc:fancy-invoice-report-create-internal)
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -45,8 +45,11 @@
|
|||||||
(inv-tests 'fancy-invoice)
|
(inv-tests 'fancy-invoice)
|
||||||
(test-end "test-invoice.scm"))
|
(test-end "test-invoice.scm"))
|
||||||
|
|
||||||
(define (sxml-main-get-row-col sxml row col)
|
(define (sxml-get-row-col classname sxml row col)
|
||||||
(sxml->table-row-col sxml 3 row col))
|
(sxml->table-row-col
|
||||||
|
((sxpath `(// (div (@ (equal? (class ,classname))))))
|
||||||
|
sxml)
|
||||||
|
1 row col))
|
||||||
|
|
||||||
(define (set-option! options section name value)
|
(define (set-option! options section name value)
|
||||||
(let ((option (gnc:lookup-option options section name)))
|
(let ((option (gnc:lookup-option options section name)))
|
||||||
@ -192,28 +195,15 @@
|
|||||||
(for-each
|
(for-each
|
||||||
(lambda (disp-col-name)
|
(lambda (disp-col-name)
|
||||||
(set-option! options "Display Columns" disp-col-name setting))
|
(set-option! options "Display Columns" disp-col-name setting))
|
||||||
(case variant
|
'("Date" "Description" "Action" "Quantity" "Price" "Discount"
|
||||||
((invoice fancy-invoice)
|
|
||||||
'("Date" "Description" "Action" "Quantity" "Price" "Discount"
|
|
||||||
"Taxable" "Tax Amount" "Total"))
|
"Taxable" "Tax Amount" "Total"))
|
||||||
((easy-invoice)
|
|
||||||
'("Date" "Description" "Charge Type" "Quantity"
|
|
||||||
"Price" "Discount" "Taxable" "Tax Amount" "Total"))))
|
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (disp-col-name)
|
(lambda (disp-col-name)
|
||||||
(set-option! options "Display" disp-col-name setting))
|
(set-option! options "Display" disp-col-name setting))
|
||||||
(case variant
|
'("My Company" "My Company ID" "Due Date"
|
||||||
((invoice)
|
"Individual Taxes" "Totals" "Subtotal" "References"
|
||||||
'("Individual Taxes" "Totals" "References" "Billing Terms"
|
"Billing Terms" "Billing ID" "Invoice Notes"
|
||||||
"Billing ID" "Invoice Notes" "Payments" "Job Details"))
|
"Payments" "Job Details"))
|
||||||
((fancy-invoice)
|
|
||||||
'("Individual Taxes" "Totals" "References" "Billing Terms"
|
|
||||||
"Billing ID" "Invoice Notes" "Payments"))
|
|
||||||
((easy-invoice)
|
|
||||||
'("My Company" "My Company ID" "Due Date"
|
|
||||||
"Individual Taxes" "Totals" "Subtotal" "References"
|
|
||||||
"Billing Terms" "Billing ID" "Invoice Notes"
|
|
||||||
"Payments"))))
|
|
||||||
options))
|
options))
|
||||||
|
|
||||||
;; entry-1 2 widgets of $3 = $6
|
;; entry-1 2 widgets of $3 = $6
|
||||||
@ -232,20 +222,16 @@
|
|||||||
(sxml (options->sxml options "inv-1 simple entry")))
|
(sxml (options->sxml options "inv-1 simple entry")))
|
||||||
(test-equal "inv-1 simple entry amounts are correct"
|
(test-equal "inv-1 simple entry amounts are correct"
|
||||||
'("$6.00" "$6.00" "$6.00" "$6.00")
|
'("$6.00" "$6.00" "$6.00" "$6.00")
|
||||||
(sxml-main-get-row-col sxml #f -1))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(test-equal "inv-1 simple entry details are correct"
|
(test-equal "inv-1 simple entry details are correct"
|
||||||
'("entry-1-desc" "entry-1-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00")
|
'("entry-1-desc" "entry-1-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00")
|
||||||
(cdr (sxml-main-get-row-col sxml 1 #f)))
|
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||||
(unless (eq? variant 'fancy-invoice)
|
(test-equal "inv-1 cust-name is correct"
|
||||||
(test-equal "inv-1 cust-name is correct"
|
'("cust-1-name")
|
||||||
'("cust-1-name")
|
(sxml-get-row-col "client-table" sxml 1 1))
|
||||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
|
||||||
sxml)))
|
|
||||||
(test-assert "inv-1-billing-id is in invoice body"
|
(test-assert "inv-1-billing-id is in invoice body"
|
||||||
(member
|
(member
|
||||||
(case variant
|
"inv-1-billing-id"
|
||||||
((invoice fancy-invoice) "Reference:\xa0inv-1-billing-id")
|
|
||||||
((easy-invoice) "Billing ID:\xa0inv-1-billing-id"))
|
|
||||||
((sxpath '(// body // *text*)) sxml)))
|
((sxpath '(// body // *text*)) sxml)))
|
||||||
(test-assert "inv-1 inv-notes is in invoice body"
|
(test-assert "inv-1 inv-notes is in invoice body"
|
||||||
(member
|
(member
|
||||||
@ -257,16 +243,11 @@
|
|||||||
(let* ((options (default-testing-options inv-1 #f))
|
(let* ((options (default-testing-options inv-1 #f))
|
||||||
(sxml (options->sxml options "inv-1 simple entry sparse")))
|
(sxml (options->sxml options "inv-1 simple entry sparse")))
|
||||||
(test-equal "inv-1 sparse simple entry headers are correct"
|
(test-equal "inv-1 sparse simple entry headers are correct"
|
||||||
(case variant
|
'("Tax" "Total Price" "Amount Due")
|
||||||
((invoice) '("Net Price" "Tax" "Total Price" "Amount Due"))
|
(sxml-get-row-col "entries-table" sxml #f 1))
|
||||||
((fancy-invoice) '("Net Price" "Tax" "Total\xa0Price" "Amount\xa0Due"))
|
|
||||||
((easy-invoice) '("Tax" "Total Price" "Amount Due")))
|
|
||||||
(sxml-main-get-row-col sxml #f 1))
|
|
||||||
(test-equal "inv-1 sparse simple entry amounts are correct"
|
(test-equal "inv-1 sparse simple entry amounts are correct"
|
||||||
(case variant
|
'("$0.00" "$6.00" "$6.00")
|
||||||
((invoice fancy-invoice) '("$6.00" "$0.00" "$6.00" "$6.00"))
|
(sxml-get-row-col "entries-table" sxml #f -1)))
|
||||||
((easy-invoice) '("$0.00" "$6.00" "$6.00")))
|
|
||||||
(sxml-main-get-row-col sxml #f -1)))
|
|
||||||
(test-end "inv-1 simple entry, sparse options")
|
(test-end "inv-1 simple entry, sparse options")
|
||||||
|
|
||||||
(test-begin "inv-2")
|
(test-begin "inv-2")
|
||||||
@ -295,29 +276,25 @@
|
|||||||
(sxml (options->sxml options "inv-2 simple entry")))
|
(sxml (options->sxml options "inv-2 simple entry")))
|
||||||
(test-equal "inv-2 simple entry amounts are correct"
|
(test-equal "inv-2 simple entry amounts are correct"
|
||||||
'("$6.00" "$6.00" "$6.00" "$6.00")
|
'("$6.00" "$6.00" "$6.00" "$6.00")
|
||||||
(sxml-main-get-row-col sxml #f -1))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(test-equal "inv-2 simple entry details are correct"
|
(test-equal "inv-2 simple entry details are correct"
|
||||||
'("entry-inv-2-desc" "entry-inv-2-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00")
|
'("entry-inv-2-desc" "entry-inv-2-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00")
|
||||||
(cdr (sxml-main-get-row-col sxml 1 #f)))
|
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||||
(unless (eq? variant 'fancy-invoice)
|
(test-equal "inv-2 cust-name is correct"
|
||||||
(test-equal "inv-2 cust-name is correct"
|
'("cust-1-name")
|
||||||
'("cust-1-name")
|
(sxml-get-row-col "client-table" sxml 1 1))
|
||||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
|
||||||
sxml)))
|
|
||||||
(test-assert "inv-2 inv-notes is in invoice body"
|
(test-assert "inv-2 inv-notes is in invoice body"
|
||||||
(member
|
(member
|
||||||
"inv-2-notes"
|
"inv-2-notes"
|
||||||
((sxpath '(// body // *text*)) sxml)))
|
((sxpath '(// body // *text*)) sxml)))
|
||||||
(when (eq? variant 'invoice)
|
(test-assert "inv-2 jobnumber is in invoice body"
|
||||||
(test-assert "inv-2 jobnumber is in invoice body"
|
(member
|
||||||
(member
|
"job-1-id"
|
||||||
"Job number:\xa0job-1-id"
|
((sxpath '(// body // *text*)) sxml)))
|
||||||
((sxpath '(// body // *text*)) sxml)))
|
(test-assert "inv-2 jobname is in invoice body"
|
||||||
(test-assert "inv-2 jobname is in invoice body"
|
(member
|
||||||
(member
|
"job-1-name"
|
||||||
"Job name:\xa0job-1-name"
|
((sxpath '(// body // *text*)) sxml))))
|
||||||
((sxpath '(// body // *text*)) sxml))))
|
|
||||||
)
|
|
||||||
(test-end "inv-2")
|
(test-end "inv-2")
|
||||||
|
|
||||||
(test-begin "inv-3")
|
(test-begin "inv-3")
|
||||||
@ -335,15 +312,13 @@
|
|||||||
(sxml (options->sxml options "inv-3 simple entry")))
|
(sxml (options->sxml options "inv-3 simple entry")))
|
||||||
(test-equal "inv-3 simple entry amounts are correct"
|
(test-equal "inv-3 simple entry amounts are correct"
|
||||||
'("$6.00" "$6.00" "$6.00" "$6.00")
|
'("$6.00" "$6.00" "$6.00" "$6.00")
|
||||||
(sxml-main-get-row-col sxml #f -1))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(test-equal "inv-3 simple entry details are correct"
|
(test-equal "inv-3 simple entry details are correct"
|
||||||
'("entry-inv-3-desc" "entry-inv-3-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
'("entry-inv-3-desc" "entry-inv-3-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
||||||
(cdr (sxml-main-get-row-col sxml 1 #f)))
|
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||||
(unless (eq? variant 'fancy-invoice)
|
(test-equal "inv-3 vend-name is correct"
|
||||||
(test-equal "inv-3 vend-name is correct"
|
'("vend-1-name")
|
||||||
'("vend-1-name")
|
(sxml-get-row-col "client-table" sxml 1 1))
|
||||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
|
||||||
sxml)))
|
|
||||||
(test-assert "inv-3 inv-notes is in invoice body"
|
(test-assert "inv-3 inv-notes is in invoice body"
|
||||||
(member
|
(member
|
||||||
"inv-3-notes"
|
"inv-3-notes"
|
||||||
@ -366,15 +341,13 @@
|
|||||||
(sxml (options->sxml options "inv-4 simple entry")))
|
(sxml (options->sxml options "inv-4 simple entry")))
|
||||||
(test-equal "inv-4 simple entry amounts are correct"
|
(test-equal "inv-4 simple entry amounts are correct"
|
||||||
'("$6.00" "$6.00" "$6.00" "$6.00")
|
'("$6.00" "$6.00" "$6.00" "$6.00")
|
||||||
(sxml->table-row-col sxml 3 #f -1))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(test-equal "inv-4 simple entry details are correct"
|
(test-equal "inv-4 simple entry details are correct"
|
||||||
'("entry-inv-4-desc" "entry-inv-4-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
'("entry-inv-4-desc" "entry-inv-4-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
||||||
(cdr (sxml->table-row-col sxml 3 1 #f)))
|
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||||
(unless (eq? variant 'fancy-invoice)
|
(test-equal "inv-4 vend-name is correct"
|
||||||
(test-equal "inv-4 vend-name is correct"
|
'("emp-1-name")
|
||||||
'("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated????
|
(sxml-get-row-col "client-table" sxml 1 1))
|
||||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
|
||||||
sxml)))
|
|
||||||
(test-assert "inv-4 inv-notes is in invoice body"
|
(test-assert "inv-4 inv-notes is in invoice body"
|
||||||
(member
|
(member
|
||||||
"inv-4-notes"
|
"inv-4-notes"
|
||||||
@ -396,15 +369,13 @@
|
|||||||
(sxml (options->sxml options "inv-5 simple entry")))
|
(sxml (options->sxml options "inv-5 simple entry")))
|
||||||
(test-equal "inv-5 simple entry amounts are correct"
|
(test-equal "inv-5 simple entry amounts are correct"
|
||||||
'("$6.00" "$6.00" "$6.00" "$6.00")
|
'("$6.00" "$6.00" "$6.00" "$6.00")
|
||||||
(sxml-main-get-row-col sxml #f -1))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(test-equal "inv-5 simple entry details are correct"
|
(test-equal "inv-5 simple entry details are correct"
|
||||||
'("entry-5-desc" "entry-5-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00")
|
'("entry-5-desc" "entry-5-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00")
|
||||||
(cdr (sxml-main-get-row-col sxml 1 #f)))
|
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||||
(unless (eq? variant 'fancy-invoice)
|
(test-equal "inv-5 cust-name is correct"
|
||||||
(test-equal "inv-5 cust-name is correct"
|
'("cust-1-name")
|
||||||
'("cust-1-name")
|
(sxml-get-row-col "client-table" sxml 1 1)))
|
||||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
|
||||||
sxml))))
|
|
||||||
(test-end "inv-5 simple entry")
|
(test-end "inv-5 simple entry")
|
||||||
|
|
||||||
(test-begin "inv-6")
|
(test-begin "inv-6")
|
||||||
@ -421,15 +392,13 @@
|
|||||||
(sxml (options->sxml options "inv-6 simple entry")))
|
(sxml (options->sxml options "inv-6 simple entry")))
|
||||||
(test-equal "inv-6 simple entry amounts are correct"
|
(test-equal "inv-6 simple entry amounts are correct"
|
||||||
'("$6.00" "$6.00" "$6.00" "$6.00")
|
'("$6.00" "$6.00" "$6.00" "$6.00")
|
||||||
(sxml-main-get-row-col sxml #f -1))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(test-equal "inv-6 simple entry details are correct"
|
(test-equal "inv-6 simple entry details are correct"
|
||||||
'("entry-inv-6-desc" "entry-inv-6-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
'("entry-inv-6-desc" "entry-inv-6-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
||||||
(cdr (sxml-main-get-row-col sxml 1 #f)))
|
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||||
(unless (eq? variant 'fancy-invoice)
|
(test-equal "inv-6 vend-name is correct"
|
||||||
(test-equal "inv-6 vend-name is correct"
|
'("vend-1-name")
|
||||||
'("vend-1-name")
|
(sxml-get-row-col "client-table" sxml 1 1))
|
||||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
|
||||||
sxml)))
|
|
||||||
(test-assert "inv-6 inv-3-notes is in invoice body"
|
(test-assert "inv-6 inv-3-notes is in invoice body"
|
||||||
(member
|
(member
|
||||||
"inv-3-notes"
|
"inv-3-notes"
|
||||||
@ -451,15 +420,13 @@
|
|||||||
(sxml (options->sxml options "inv-7 simple entry")))
|
(sxml (options->sxml options "inv-7 simple entry")))
|
||||||
(test-equal "inv-7 simple entry amounts are correct"
|
(test-equal "inv-7 simple entry amounts are correct"
|
||||||
'("$6.00" "$6.00" "$6.00" "$6.00")
|
'("$6.00" "$6.00" "$6.00" "$6.00")
|
||||||
(sxml-main-get-row-col sxml #f -1))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(test-equal "inv-7 simple entry details are correct"
|
(test-equal "inv-7 simple entry details are correct"
|
||||||
'("entry-inv-7-desc" "entry-inv-7-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
'("entry-inv-7-desc" "entry-inv-7-action" "2.00" "$3.00" "T" "$0.00" "$6.00")
|
||||||
(cdr (sxml-main-get-row-col sxml 1 #f)))
|
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||||
(unless (eq? variant 'fancy-invoice)
|
(test-equal "inv-7 vend-name is correct"
|
||||||
(test-equal "inv-7 vend-name is correct"
|
'("emp-1-name")
|
||||||
'("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated????
|
(sxml-get-row-col "client-table" sxml 1 1))
|
||||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
|
||||||
sxml)))
|
|
||||||
(test-assert "inv-7 inv-4-notes is in invoice body"
|
(test-assert "inv-7 inv-4-notes is in invoice body"
|
||||||
(member
|
(member
|
||||||
"inv-4-notes"
|
"inv-4-notes"
|
||||||
@ -559,34 +526,23 @@
|
|||||||
(sxml (options->sxml options "inv-8 combinatorics")))
|
(sxml (options->sxml options "inv-8 combinatorics")))
|
||||||
(test-assert "inv-8 billterm-desc is in invoice body"
|
(test-assert "inv-8 billterm-desc is in invoice body"
|
||||||
(member
|
(member
|
||||||
"Terms:\xa0billterm-desc"
|
"billterm-desc"
|
||||||
((sxpath '(// body // *text*)) sxml)))
|
((sxpath '(// body // *text*)) sxml)))
|
||||||
(test-assert "inv-8 gncOrder reference is in invoice body"
|
(test-assert "inv-8 gncOrder reference is in invoice body"
|
||||||
(member
|
(member
|
||||||
"REF:\xa0order-ref"
|
"REF order-ref"
|
||||||
((sxpath '(// body // *text*)) sxml)))
|
((sxpath '(// body // *text*)) sxml)))
|
||||||
(case variant
|
(test-equal "inv-8 invoice date is in invoice body"
|
||||||
((invoice)
|
'("Date:")
|
||||||
(test-equal "inv-8 invoice date is in invoice body"
|
(sxml-get-row-col "invoice-details-table" sxml 1 1))
|
||||||
'("Invoice Date:\xa0")
|
(test-equal "inv-8 due date is in invoice body"
|
||||||
(sxml->table-row-col sxml 2 1 1))
|
'("Due Date:")
|
||||||
(test-equal "inv-8 due date is in invoice body"
|
(sxml-get-row-col "invoice-details-table" sxml 2 1))
|
||||||
'("Due Date:\xa0")
|
|
||||||
(sxml->table-row-col sxml 2 2 1)))
|
|
||||||
((easy-invoice)
|
|
||||||
(test-equal "inv-8 invoice date is in invoice body"
|
|
||||||
'("Date:\xa0")
|
|
||||||
(sxml->table-row-col sxml 3 1 1))
|
|
||||||
(test-equal "inv-8 invoice date is in invoice body"
|
|
||||||
'("Due:\xa0")
|
|
||||||
(sxml->table-row-col sxml 3 2 1))))
|
|
||||||
(test-equal "inv-8 combo amounts are correct"
|
(test-equal "inv-8 combo amounts are correct"
|
||||||
'("$2,133.25" "$2,061.96" "$2,133.25" "$2,061.96" "$2,133.25" "$2,133.25"
|
'("$2,133.25" "$2,061.96" "$2,133.25" "$2,061.96" "$2,133.25" "$2,133.25"
|
||||||
"$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18"
|
"$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18"
|
||||||
"-$17,479.18" "$0.00")
|
"-$17,479.18" "$0.00")
|
||||||
(if (eq? variant 'fancy-invoice)
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(sxml->table-row-col sxml 3 #f -1)
|
|
||||||
(sxml->table-row-col sxml 4 #f -1)))
|
|
||||||
(test-assert "inv-8 is fully paid up!"
|
(test-assert "inv-8 is fully paid up!"
|
||||||
(gncInvoiceIsPaid inv-8))))
|
(gncInvoiceIsPaid inv-8))))
|
||||||
(test-end "combinations of gncEntry options")))
|
(test-end "combinations of gncEntry options")))
|
||||||
|
|||||||
@ -1717,6 +1717,7 @@
|
|||||||
"Show zero balance items?" (cons #f "Show zero balance items")
|
"Show zero balance items?" (cons #f "Show zero balance items")
|
||||||
"Sign Reverses?" (cons #f "Sign Reverses")
|
"Sign Reverses?" (cons #f "Sign Reverses")
|
||||||
"To" (cons #f "End Date")
|
"To" (cons #f "End Date")
|
||||||
|
"Charge Type" (cons #f "Action") ;easy-invoice.scm, renamed June 2018
|
||||||
"Use Full Account Name?" (cons #f "Use Full Account Name")
|
"Use Full Account Name?" (cons #f "Use Full Account Name")
|
||||||
"Use Full Other Account Name?" (cons #f "Use Full Other Account Name")
|
"Use Full Other Account Name?" (cons #f "Use Full Other Account Name")
|
||||||
"Void Transactions?" (cons "Filter" "Void Transactions")
|
"Void Transactions?" (cons "Filter" "Void Transactions")
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user