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
|
||||
aging.scm
|
||||
customer-summary.scm
|
||||
easy-invoice.scm
|
||||
fancy-invoice.scm
|
||||
taxinvoice.scm
|
||||
receipt.scm
|
||||
invoice.scm
|
||||
|
||||
@ -110,9 +110,7 @@
|
||||
0
|
||||
))
|
||||
|
||||
(use-modules (gnucash report fancy-invoice))
|
||||
(use-modules (gnucash report invoice))
|
||||
(use-modules (gnucash report easy-invoice))
|
||||
(use-modules (gnucash report taxinvoice))
|
||||
(use-modules (gnucash report receipt))
|
||||
(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)
|
||||
(test-end "test-invoice.scm"))
|
||||
|
||||
(define (sxml-main-get-row-col sxml row col)
|
||||
(sxml->table-row-col sxml 3 row col))
|
||||
(define (sxml-get-row-col classname sxml row col)
|
||||
(sxml->table-row-col
|
||||
((sxpath `(// (div (@ (equal? (class ,classname))))))
|
||||
sxml)
|
||||
1 row col))
|
||||
|
||||
(define (set-option! options section name value)
|
||||
(let ((option (gnc:lookup-option options section name)))
|
||||
@ -192,28 +195,15 @@
|
||||
(for-each
|
||||
(lambda (disp-col-name)
|
||||
(set-option! options "Display Columns" disp-col-name setting))
|
||||
(case variant
|
||||
((invoice fancy-invoice)
|
||||
'("Date" "Description" "Action" "Quantity" "Price" "Discount"
|
||||
'("Date" "Description" "Action" "Quantity" "Price" "Discount"
|
||||
"Taxable" "Tax Amount" "Total"))
|
||||
((easy-invoice)
|
||||
'("Date" "Description" "Charge Type" "Quantity"
|
||||
"Price" "Discount" "Taxable" "Tax Amount" "Total"))))
|
||||
(for-each
|
||||
(lambda (disp-col-name)
|
||||
(set-option! options "Display" disp-col-name setting))
|
||||
(case variant
|
||||
((invoice)
|
||||
'("Individual Taxes" "Totals" "References" "Billing Terms"
|
||||
"Billing ID" "Invoice Notes" "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"))))
|
||||
'("My Company" "My Company ID" "Due Date"
|
||||
"Individual Taxes" "Totals" "Subtotal" "References"
|
||||
"Billing Terms" "Billing ID" "Invoice Notes"
|
||||
"Payments" "Job Details"))
|
||||
options))
|
||||
|
||||
;; entry-1 2 widgets of $3 = $6
|
||||
@ -232,20 +222,16 @@
|
||||
(sxml (options->sxml options "inv-1 simple entry")))
|
||||
(test-equal "inv-1 simple entry amounts are correct"
|
||||
'("$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"
|
||||
'("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)))
|
||||
(unless (eq? variant 'fancy-invoice)
|
||||
(test-equal "inv-1 cust-name is correct"
|
||||
'("cust-1-name")
|
||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
||||
sxml)))
|
||||
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||
(test-equal "inv-1 cust-name is correct"
|
||||
'("cust-1-name")
|
||||
(sxml-get-row-col "client-table" sxml 1 1))
|
||||
(test-assert "inv-1-billing-id is in invoice body"
|
||||
(member
|
||||
(case variant
|
||||
((invoice fancy-invoice) "Reference:\xa0inv-1-billing-id")
|
||||
((easy-invoice) "Billing ID:\xa0inv-1-billing-id"))
|
||||
"inv-1-billing-id"
|
||||
((sxpath '(// body // *text*)) sxml)))
|
||||
(test-assert "inv-1 inv-notes is in invoice body"
|
||||
(member
|
||||
@ -257,16 +243,11 @@
|
||||
(let* ((options (default-testing-options inv-1 #f))
|
||||
(sxml (options->sxml options "inv-1 simple entry sparse")))
|
||||
(test-equal "inv-1 sparse simple entry headers are correct"
|
||||
(case variant
|
||||
((invoice) '("Net Price" "Tax" "Total Price" "Amount Due"))
|
||||
((fancy-invoice) '("Net Price" "Tax" "Total\xa0Price" "Amount\xa0Due"))
|
||||
((easy-invoice) '("Tax" "Total Price" "Amount Due")))
|
||||
(sxml-main-get-row-col sxml #f 1))
|
||||
'("Tax" "Total Price" "Amount Due")
|
||||
(sxml-get-row-col "entries-table" sxml #f 1))
|
||||
(test-equal "inv-1 sparse simple entry amounts are correct"
|
||||
(case variant
|
||||
((invoice fancy-invoice) '("$6.00" "$0.00" "$6.00" "$6.00"))
|
||||
((easy-invoice) '("$0.00" "$6.00" "$6.00")))
|
||||
(sxml-main-get-row-col sxml #f -1)))
|
||||
'("$0.00" "$6.00" "$6.00")
|
||||
(sxml-get-row-col "entries-table" sxml #f -1)))
|
||||
(test-end "inv-1 simple entry, sparse options")
|
||||
|
||||
(test-begin "inv-2")
|
||||
@ -295,29 +276,25 @@
|
||||
(sxml (options->sxml options "inv-2 simple entry")))
|
||||
(test-equal "inv-2 simple entry amounts are correct"
|
||||
'("$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"
|
||||
'("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)))
|
||||
(unless (eq? variant 'fancy-invoice)
|
||||
(test-equal "inv-2 cust-name is correct"
|
||||
'("cust-1-name")
|
||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
||||
sxml)))
|
||||
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||
(test-equal "inv-2 cust-name is correct"
|
||||
'("cust-1-name")
|
||||
(sxml-get-row-col "client-table" sxml 1 1))
|
||||
(test-assert "inv-2 inv-notes is in invoice body"
|
||||
(member
|
||||
"inv-2-notes"
|
||||
((sxpath '(// body // *text*)) sxml)))
|
||||
(when (eq? variant 'invoice)
|
||||
(test-assert "inv-2 jobnumber is in invoice body"
|
||||
(member
|
||||
"Job number:\xa0job-1-id"
|
||||
((sxpath '(// body // *text*)) sxml)))
|
||||
(test-assert "inv-2 jobname is in invoice body"
|
||||
(member
|
||||
"Job name:\xa0job-1-name"
|
||||
((sxpath '(// body // *text*)) sxml))))
|
||||
)
|
||||
(test-assert "inv-2 jobnumber is in invoice body"
|
||||
(member
|
||||
"job-1-id"
|
||||
((sxpath '(// body // *text*)) sxml)))
|
||||
(test-assert "inv-2 jobname is in invoice body"
|
||||
(member
|
||||
"job-1-name"
|
||||
((sxpath '(// body // *text*)) sxml))))
|
||||
(test-end "inv-2")
|
||||
|
||||
(test-begin "inv-3")
|
||||
@ -335,15 +312,13 @@
|
||||
(sxml (options->sxml options "inv-3 simple entry")))
|
||||
(test-equal "inv-3 simple entry amounts are correct"
|
||||
'("$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"
|
||||
'("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)))
|
||||
(unless (eq? variant 'fancy-invoice)
|
||||
(test-equal "inv-3 vend-name is correct"
|
||||
'("vend-1-name")
|
||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
||||
sxml)))
|
||||
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||
(test-equal "inv-3 vend-name is correct"
|
||||
'("vend-1-name")
|
||||
(sxml-get-row-col "client-table" sxml 1 1))
|
||||
(test-assert "inv-3 inv-notes is in invoice body"
|
||||
(member
|
||||
"inv-3-notes"
|
||||
@ -366,15 +341,13 @@
|
||||
(sxml (options->sxml options "inv-4 simple entry")))
|
||||
(test-equal "inv-4 simple entry amounts are correct"
|
||||
'("$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"
|
||||
'("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)))
|
||||
(unless (eq? variant 'fancy-invoice)
|
||||
(test-equal "inv-4 vend-name is correct"
|
||||
'("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated????
|
||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
||||
sxml)))
|
||||
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||
(test-equal "inv-4 vend-name is correct"
|
||||
'("emp-1-name")
|
||||
(sxml-get-row-col "client-table" sxml 1 1))
|
||||
(test-assert "inv-4 inv-notes is in invoice body"
|
||||
(member
|
||||
"inv-4-notes"
|
||||
@ -396,15 +369,13 @@
|
||||
(sxml (options->sxml options "inv-5 simple entry")))
|
||||
(test-equal "inv-5 simple entry amounts are correct"
|
||||
'("$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"
|
||||
'("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)))
|
||||
(unless (eq? variant 'fancy-invoice)
|
||||
(test-equal "inv-5 cust-name is correct"
|
||||
'("cust-1-name")
|
||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
||||
sxml))))
|
||||
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||
(test-equal "inv-5 cust-name is correct"
|
||||
'("cust-1-name")
|
||||
(sxml-get-row-col "client-table" sxml 1 1)))
|
||||
(test-end "inv-5 simple entry")
|
||||
|
||||
(test-begin "inv-6")
|
||||
@ -421,15 +392,13 @@
|
||||
(sxml (options->sxml options "inv-6 simple entry")))
|
||||
(test-equal "inv-6 simple entry amounts are correct"
|
||||
'("$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"
|
||||
'("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)))
|
||||
(unless (eq? variant 'fancy-invoice)
|
||||
(test-equal "inv-6 vend-name is correct"
|
||||
'("vend-1-name")
|
||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
||||
sxml)))
|
||||
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||
(test-equal "inv-6 vend-name is correct"
|
||||
'("vend-1-name")
|
||||
(sxml-get-row-col "client-table" sxml 1 1))
|
||||
(test-assert "inv-6 inv-3-notes is in invoice body"
|
||||
(member
|
||||
"inv-3-notes"
|
||||
@ -451,15 +420,13 @@
|
||||
(sxml (options->sxml options "inv-7 simple entry")))
|
||||
(test-equal "inv-7 simple entry amounts are correct"
|
||||
'("$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"
|
||||
'("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)))
|
||||
(unless (eq? variant 'fancy-invoice)
|
||||
(test-equal "inv-7 vend-name is correct"
|
||||
'("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated????
|
||||
((sxpath '(// (table 2) // tbody // tr // td // *text*))
|
||||
sxml)))
|
||||
(cdr (sxml-get-row-col "entries-table" sxml 1 #f)))
|
||||
(test-equal "inv-7 vend-name is correct"
|
||||
'("emp-1-name")
|
||||
(sxml-get-row-col "client-table" sxml 1 1))
|
||||
(test-assert "inv-7 inv-4-notes is in invoice body"
|
||||
(member
|
||||
"inv-4-notes"
|
||||
@ -559,34 +526,23 @@
|
||||
(sxml (options->sxml options "inv-8 combinatorics")))
|
||||
(test-assert "inv-8 billterm-desc is in invoice body"
|
||||
(member
|
||||
"Terms:\xa0billterm-desc"
|
||||
"billterm-desc"
|
||||
((sxpath '(// body // *text*)) sxml)))
|
||||
(test-assert "inv-8 gncOrder reference is in invoice body"
|
||||
(member
|
||||
"REF:\xa0order-ref"
|
||||
"REF order-ref"
|
||||
((sxpath '(// body // *text*)) sxml)))
|
||||
(case variant
|
||||
((invoice)
|
||||
(test-equal "inv-8 invoice date is in invoice body"
|
||||
'("Invoice Date:\xa0")
|
||||
(sxml->table-row-col sxml 2 1 1))
|
||||
(test-equal "inv-8 due date is in invoice body"
|
||||
'("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 invoice date is in invoice body"
|
||||
'("Date:")
|
||||
(sxml-get-row-col "invoice-details-table" sxml 1 1))
|
||||
(test-equal "inv-8 due date is in invoice body"
|
||||
'("Due Date:")
|
||||
(sxml-get-row-col "invoice-details-table" sxml 2 1))
|
||||
(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"
|
||||
"$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18"
|
||||
"-$17,479.18" "$0.00")
|
||||
(if (eq? variant 'fancy-invoice)
|
||||
(sxml->table-row-col sxml 3 #f -1)
|
||||
(sxml->table-row-col sxml 4 #f -1)))
|
||||
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||
(test-assert "inv-8 is fully paid up!"
|
||||
(gncInvoiceIsPaid inv-8))))
|
||||
(test-end "combinations of gncEntry options")))
|
||||
|
||||
@ -1717,6 +1717,7 @@
|
||||
"Show zero balance items?" (cons #f "Show zero balance items")
|
||||
"Sign Reverses?" (cons #f "Sign Reverses")
|
||||
"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 Other Account Name?" (cons #f "Use Full Other Account Name")
|
||||
"Void Transactions?" (cons "Filter" "Void Transactions")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user