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

James Strandboge's "Easy Invoice" patch.

Browse Source 
* src/business/business-reports/Makefile.am:
	* src/business/business-reports/business-reports.scm:
	* src/business/business-reports/easy-invoice.scm:
	  add "easy invoice" code.
	* src/business/business-utils/business-prefs.scm:
	* src/business/business-utils/business-utils.scm:
	  add preferences for the business ID, used in the easy invoice.
	* src/report/stylesheets/Makefile.am:
	* src/report/stylesheets/stylesheets.scm:
	* src/report/stylesheets/stylesheet-easy.scm:
	  add "easy stylesheet" code.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@10317 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
2004-11-01 02:10:05 +00:00
parent c5857de175
commit 1a43c812b0
9 changed files with 1253 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
ChangeLog
View File

@@ -23,6 +23,19 @@
* src/import-export/import-match-map.c:
use GPOINTER_TO_INT and GINT_TO_POINTER macros to be 64-bit safe.
James Strandboge's "Easy Invoice" patch:
* src/business/business-reports/Makefile.am:
* src/business/business-reports/business-reports.scm:
* src/business/business-reports/easy-invoice.scm:
add "easy invoice" code.
* src/business/business-utils/business-prefs.scm:
* src/business/business-utils/business-utils.scm:
add preferences for the business ID, used in the easy invoice.
* src/report/stylesheets/Makefile.am:
* src/report/stylesheets/stylesheets.scm:
* src/report/stylesheets/stylesheet-easy.scm:
add "easy stylesheet" code.
2004-10-30 Christian Stimming <stimming@tuhh.de>
* doc/README.HBCI: Updated HBCI readme.

1
src/business/business-reports/Makefile.am
View File

@@ -10,6 +10,7 @@ gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report
gncscmmod_DATA = \
business-reports.scm \
aging.scm \
easy-invoice.scm \
fancy-invoice.scm \
payables.scm \
receivables.scm \

1
src/business/business-reports/business-reports.scm
View File

@@ -102,6 +102,7 @@
(use-modules (gnucash report fancy-invoice))
(use-modules (gnucash report invoice))
(use-modules (gnucash report easy-invoice))
(use-modules (gnucash report owner-report))
(use-modules (gnucash report payables))
(use-modules (gnucash report receivables))

866
src/business/business-reports/easy-invoice.scm Normal file
View File

@@ -0,0 +1,866 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; -*-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
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report easy-invoice))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(use-modules (gnucash gnc-module))
(require 'hash-table)
(require 'record)
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/business-utils" 0)
(use-modules (gnucash report standard-reports))
(use-modules (gnucash report business-reports))
(define invoice-page gnc:pagename-general)
(define invoice-name (N_ "Invoice Number"))
(define-macro (addto! alist element)
`(set! ,alist (cons ,element ,alist)))
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
(cons (- (gnc:html-table-num-rows table) 1)
(cons tag rest)))))
(apply gnc:html-table-set-row-style! arg-list)))
(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 (_ "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 (make-account-hash) (make-hash-table 23))
(define (update-account-hash hash values)
(for-each
(lambda (item)
(let* ((acct (car item))
(val (cdr item))
(ref (hash-ref hash acct)))
(hash-set! hash acct (if ref (gnc:numeric-add-fixed ref val) val))))
values))
(define (monetary-or-percent numeric currency entry-type)
(if (gnc:entry-type-percent-p entry-type)
(let ((table (gnc:make-html-table)))
(gnc:html-table-set-style!
table "table"
'attribute (list "border" 0)
'attribute (list "cellspacing" 1)
'attribute (list "cellpadding" 0))
(gnc:html-table-append-row!
table
(list numeric (_ "%")))
(set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table)
(gnc:make-gnc-monetary currency numeric)))
(define (add-entry-row table currency entry column-vector row-style invoice?)
(let* ((row-contents '())
(entry-value (gnc:make-gnc-monetary
currency
(gnc:entry-get-value entry invoice?)))
(entry-tax-value (gnc:make-gnc-monetary
currency
(gnc:entry-get-tax-value entry invoice?))))
(if (date-col column-vector)
(addto! row-contents
(gnc:print-date (gnc:entry-get-date entry))))
(if (description-col column-vector)
(addto! row-contents
(gnc:entry-get-description entry)))
(if (action-col column-vector)
(addto! row-contents
(gnc:entry-get-action entry)))
(if (quantity-col column-vector)
(addto! row-contents
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:entry-get-quantity entry))))
(if (price-col column-vector)
(addto! row-contents
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:make-gnc-monetary
currency (if invoice? (gnc:entry-get-inv-price entry)
(gnc:entry-get-bill-price entry))))))
(if (discount-col column-vector)
(addto! row-contents
(if invoice?
(gnc:make-html-table-cell/markup
"number-cell"
(monetary-or-percent (gnc:entry-get-inv-discount entry)
currency
(gnc:entry-get-inv-discount-type entry)))
"")))
(if (tax-col column-vector)
(addto! row-contents
(if (if invoice?
(and (gnc:entry-get-inv-taxable entry)
(gnc:entry-get-inv-tax-table entry))
(and (gnc:entry-get-bill-taxable entry)
(gnc:entry-get-bill-tax-table entry)))
(_ "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 invoice-page invoice-name "x" ""
(lambda () #f) #f))
(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_ "Action")
"g" (N_ "Display the action?") #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" "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:register-inv-option
(gnc:make-string-option
(N_ "Text") (N_ "Today Date Format")
"x" (N_ "The format for the date->string conversion for today's date.")
"%B %e, %Y"))
(gnc:options-set-default-section gnc:*report-options* "General")
gnc:*report-options*)
(define (make-entry-table invoice options add-order invoice?)
(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 (gnc:invoice-get-posted-lot invoice))
(txn (gnc:invoice-get-posted-txn invoice))
(currency (gnc:invoice-get-currency 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-collector subtotal-style subtotal-label)
(let ((currency-totals (subtotal-collector
'format gnc:make-gnc-monetary #f)))
(for-each (lambda (currency)
(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 currency used-columns)
"total-number-cell"
(display-subtotal currency used-columns))))))
currency-totals)))
(define (add-payment-row table used-columns split total-collector)
(let* ((t (gnc:split-get-parent split))
(currency (gnc:transaction-get-currency t))
;; XXX Need to know when to reverse the value
(amt (gnc:make-gnc-monetary currency (gnc:split-get-value 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
(gnc:print-date (gnc:transaction-get-date-posted 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?
value-collector
tax-collector
total-collector
acct-hash)
(if (null? entries)
(begin
; jamie
(if (opt-val "Display" "Subtotal")
(add-subtotal-row table used-columns value-collector
"grand-total" (_ "Subtotal")))
(if display-all-taxes
(hash-for-each
(lambda (acct value)
(let ((collector (gnc:make-commodity-collector))
(commodity (gnc:account-get-commodity acct))
(name (gnc:account-get-name acct)))
(collector 'add commodity value)
(add-subtotal-row table used-columns collector
"grand-total" name)))
acct-hash)
; nope, just show the total tax.
(add-subtotal-row table used-columns tax-collector
"grand-total" (_ "Tax")))
(if (and show-payments lot)
(let ((splits (sort-list!
(gnc:lot-get-splits lot)
(lambda (s1 s2)
(let ((t1 (gnc:split-get-parent s1))
(t2 (gnc:split-get-parent s2)))
(< (gnc:transaction-order t1 t2) 0))))))
(for-each
(lambda (split)
(if (not (equal? (gnc:split-get-parent split) txn))
(add-payment-row table used-columns
split total-collector)))
splits)))
(add-subtotal-row table used-columns total-collector
"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
invoice?)))
(if display-all-taxes
(let ((tax-list (gnc:entry-get-tax-values current invoice?)))
(update-account-hash acct-hash tax-list))
(tax-collector 'add
(gnc:gnc-monetary-commodity (cdr entry-values))
(gnc:gnc-monetary-amount (cdr entry-values))))
(value-collector 'add
(gnc:gnc-monetary-commodity (car entry-values))
(gnc:gnc-monetary-amount (car entry-values)))
(total-collector 'add
(gnc:gnc-monetary-commodity (car entry-values))
(gnc:gnc-monetary-amount (car entry-values)))
(total-collector 'add
(gnc:gnc-monetary-commodity (cdr entry-values))
(gnc:gnc-monetary-amount (cdr entry-values)))
(let ((order (gnc:entry-get-order current)))
(if order (add-order order)))
(do-rows-with-subtotals rest
table
used-columns
width
(not odd-row?)
value-collector
tax-collector
total-collector
acct-hash))))
(let* ((table (gnc:make-html-table))
(used-columns (build-column-used options))
(width (num-columns-required used-columns))
(entries (gnc:invoice-get-entries invoice))
(totals (gnc:make-commodity-collector)))
(gnc:html-table-set-col-headers!
table
(make-heading-list used-columns))
(do-rows-with-subtotals entries
table
used-columns
width
#t
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
totals
(make-account-hash))
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-address-dep owner) #\newline "<br>")))
(gnc:html-table-append-row!
table
(list "<br>"))
(for-each
(lambda (order)
(let* ((reference (gnc:order-get-reference order)))
(if (and reference (> (string-length reference) 0))
(gnc:html-table-append-row!
table
(list
(string-append (_ "REF") ":&nbsp;" reference))))))
orders)
(set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
(define (make-date-row! table label date)
(gnc:html-table-append-row!
table
(list
(string-append label ":&nbsp;")
(string-expand (gnc:print-date date) #\space "&nbsp;"))))
(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))
(set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
(define (make-myname-table book)
(let* ((table (gnc:make-html-table))
(slots (gnc:book-get-slots book))
(name (gnc:kvp-frame-get-slot-path
slots (append gnc:*kvp-option-path*
(list gnc:*business-label* gnc:*company-name*))))
(addy (gnc:kvp-frame-get-slot-path
slots (append gnc:*kvp-option-path*
(list gnc:*business-label* 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)))
(let* ((document (gnc:make-html-document))
(table '())
(orders '())
(invoice (opt-val invoice-page invoice-name))
(owner #f)
(references? (opt-val "Display" "References"))
(title (_ "Invoice"))
(invoice? #f))
(define (add-order o)
(if (and references? (not (member o orders)))
(addto! orders o)))
(if invoice
(begin
(set! owner (gnc:invoice-get-owner invoice))
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
(gnc:owner-get-type
(gnc:owner-get-end-owner owner)) #f)))
(case type
((gnc-owner-customer)
(set! invoice? #t))
((gnc-owner-vendor)
(set! title (_ "Bill")))
((gnc-owner-employee)
(set! title (_ "Expense Voucher")))))
(set! title (string-append title " #"
(gnc:invoice-get-id 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 invoice
(begin
; invoice number and ID String table
(add-html! document "<table width='100%'><tr>")
(add-html! document "<td align='left'>")
(add-html! document "<b><u>Invoice #")
(add-html! document (gnc:invoice-get-id invoice))
(add-html! document "</u></b></td>")
(add-html! document "<td align='right'>")
(if (opt-val "Display" "My Company ID")
(let* ((book (gnc:invoice-get-book invoice))
(slots (gnc:book-get-slots book))
(taxid (gnc:kvp-frame-get-slot-path
slots (append gnc:*kvp-option-path*
(list gnc:*business-label* gnc:*company-id*)))))
(if (and taxid (> (string-length taxid) 0))
(begin
(add-html! document taxid)
(add-html! document "&nbsp;")))
)
)
(add-html! document "</td>")
(add-html! document "</tr></table>")
(make-break! document)
(make-break! document)
; add the client and company name table
(let ((book (gnc:invoice-get-book invoice)))
(set! table (make-entry-table invoice
(gnc:report-options report-obj)
add-order invoice?))
(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
(let ((date-table #f)
(post-date (gnc:invoice-get-date-posted invoice))
(due-date (gnc:invoice-get-date-due invoice)))
(if (not (equal? post-date (cons 0 0)))
(begin
(add-html! document "<table border=0><tr>")
(add-html! document "<td>")
(add-html! document "Date: ")
(add-html! document "</td>")
(add-html! document "<td>")
(add-html! document (gnc:print-date post-date))
(add-html! document "</td>")
(if (opt-val "Display" "Due Date")
(begin
(add-html! document "<tr><td>")
(add-html! document "Due: ")
(add-html! document "</td>")
(add-html! document "<td>")
(add-html! document (gnc:print-date due-date))
(add-html! document "</td>")))
(add-html! document "</tr></table>"))
(add-html! document "<font color='red'>INVOICE NOT POSTED</font>")))
;(add-html! document (strftime (opt-val "Text" "Today Date Format")
; (localtime (car (gnc:get-today))))))
(make-break! document)
(if (opt-val "Display" "Billing ID")
(let ((billing-id (gnc:invoice-get-billing-id 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") ":&nbsp;"
(string-expand billing-id #\newline "<br>"))))
(make-break! document)))))
(if (opt-val "Display" "Billing Terms")
(let* ((term (gnc:invoice-get-terms invoice))
(terms (gnc:bill-term-get-description term)))
(if (and terms (> (string-length terms) 0))
(gnc:html-document-add-object!
document
(gnc:make-html-text
(string-append
(_ "Terms") ":&nbsp;"
(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 (gnc:invoice-get-notes 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
(N_ "No Valid Invoice Selected"))))
document))
(gnc:define-report
'version 1
'name (N_ "Easy Invoice")
'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 (N_ "Easy Invoice")))
(invoice-op (gnc:lookup-option options invoice-page invoice-name)))
(gnc:option-set-value invoice-op invoice)
(gnc:make-report (N_ "Easy Invoice") options)))
(export gnc:easy-invoice-report-create-internal)

8
src/business/business-utils/business-prefs.scm
View File

@@ -101,7 +101,13 @@
(reg-option
(gnc:make-text-option
gnc:*business-label* gnc:*company-addy*
"b" (N_ "The address of your business") ""))
"b1" (N_ "The address of your business") ""))
(reg-option
(gnc:make-string-option
gnc:*business-label* gnc:*company-id*
"b2" (N_ "The ID for your company (eg 'Tax-ID: 00-000000")
""))
(reg-option
(gnc:make-taxtable-option

3
src/business/business-utils/business-utils.scm
View File

@@ -7,8 +7,9 @@
(define gnc:*business-label* (N_ "Business"))
(define gnc:*company-name* (N_ "Company Name"))
(define gnc:*company-addy* (N_ "Company Address"))
(define gnc:*company-id* (N_ "Company ID"))
(export gnc:*business-label* gnc:*company-name* gnc:*company-addy*)
(export gnc:*business-label* gnc:*company-name* gnc:*company-addy* gnc:*company-id*)
(load-from-path "business-options.scm")
(load-from-path "business-prefs.scm")

3
src/report/stylesheets/Makefile.am
View File

@@ -24,7 +24,8 @@ gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report/
gncscmmod_DATA = \
stylesheets.scm \
stylesheet-plain.scm \
stylesheet-fancy.scm
stylesheet-fancy.scm \
stylesheet-easy.scm
EXTRA_DIST = ${gncscmmod_DATA}

360
src/report/stylesheets/stylesheet-easy.scm Normal file
View File

@@ -0,0 +1,360 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stylesheet-easy.scm: stylesheet with nicer formatting for
;; printing and easier configurability
;;
;; Copyright 2004 James Strandboge <jstrand1@rochester.rr.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
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
;;
;; Based on work from:
;; stylesheet-header.scm
;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report stylesheet-easy))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/report/report-system" 0)
(define (easy-options)
(let* ((options (gnc:new-options))
(opt-register
(lambda (opt)
(gnc:register-option options opt))))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Preparer") "a"
(N_ "Name of person preparing the report")
""))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for")
""))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Show preparer info") "c"
(N_ "Name of organization or company")
#f))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Enable Links") "c"
(N_ "Enable hyperlinks in reports")
#t))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Background Tile") "a" (N_ "Background tile for reports.")
""))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Heading Banner") "b" (N_ "Banner for top of report.")
""))
(opt-register
(gnc:make-multichoice-option
(N_ "Images")
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left
(list (vector 'left
(N_ "Left")
(N_ "Align the banner to the left"))
(vector 'center
(N_ "Center")
(N_ "Align the banner in the center"))
(vector 'right
(N_ "Right")
(N_ "Align the banner to the right"))
)))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Logo") "d" (N_ "Company logo image.")
""))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #xff #xff 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Link Color") "c" (N_ "Link text color.")
(list #xb2 #x22 #x22 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Table Cell Color") "c" (N_ "Default background for table cells.")
(list #xff #xff #xff 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Alternate Table Cell Color") "d"
(N_ "Default alternate background for table cells.")
(list #xff #xff #xff 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Subheading/Subtotal Cell Color") "e"
(N_ "Default color for subtotal rows.")
(list #xee #xe8 #xaa 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Sub-subheading/total Cell Color") "f"
(N_ "Color for subsubtotals")
(list #xfa #xfa #xd2 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Grand Total Cell Color") "g"
(N_ "Color for grand totals")
(list #xff #xff #x00 0)
255 #f))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell spacing") "a" (N_ "Space between table cells")
1 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell padding") "b" (N_ "Space between table cells")
1 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables")
1 0 20 0 1))
options))
(define (easy-renderer options doc)
(let* ((ssdoc (gnc:make-html-document))
(opt-val
(lambda (section name)
(gnc:option-value
(gnc:lookup-option options section name))))
(color-val
(lambda (section name)
(gnc:color-option->html
(gnc:lookup-option options section name))))
(preparer (opt-val (N_ "General") (N_ "Preparer")))
(prepared-for (opt-val (N_ "General") (N_ "Prepared for")))
(show-preparer? (opt-val (N_ "General") (N_ "Show preparer info")))
(links? (opt-val (N_ "General") (N_ "Enable Links")))
(bgcolor (color-val (N_ "Colors") (N_ "Background Color")))
(textcolor (color-val (N_ "Colors") (N_ "Text Color")))
(linkcolor (color-val (N_ "Colors") (N_ "Link Color")))
(normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color")))
(alternate-row-color (color-val (N_ "Colors")
(N_ "Alternate Table Cell Color")))
(primary-subheading-color
(color-val (N_ "Colors")
(N_ "Subheading/Subtotal Cell Color")))
(secondary-subheading-color
(color-val (N_ "Colors")
(N_ "Sub-subheading/total Cell Color")))
(grand-total-color (color-val (N_ "Colors")
(N_ "Grand Total Cell Color")))
(bgpixmap (opt-val (N_ "Images") (N_ "Background Tile")))
(headpixmap (opt-val (N_ "Images") (N_ "Heading Banner")))
(logopixmap (opt-val (N_ "Images") (N_ "Logo")))
(align (gnc:value->string(opt-val (N_ "Images") (N_ "Heading Alignment"))))
(spacing (opt-val (N_ "Tables") (N_ "Table cell spacing")))
(padding (opt-val (N_ "Tables") (N_ "Table cell padding")))
(border (opt-val (N_ "Tables") (N_ "Table border width")))
(headcolumn 0))
; center the document without elements inheriting anything
(gnc:html-document-add-object! ssdoc
(gnc:make-html-text "<center>"))
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor)
'attribute (list "link" linkcolor))
(gnc:html-document-set-style!
ssdoc "number-cell"
'tag "td"
'attribute (list "align" "right")
'attribute (list "nowrap"))
(if (and bgpixmap
(not (string=? bgpixmap "")))
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "background" bgpixmap)))
(gnc:html-document-set-style!
ssdoc "table"
'attribute (list "border" border)
'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding))
(gnc:html-document-set-style!
ssdoc "normal-row"
'attribute (list "bgcolor" normal-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "text-cell"
'tag "td"
'attribute (list "align" "left"))
(gnc:html-document-set-style!
ssdoc "total-number-cell"
'tag '("td" "b")
'attribute (list "align" "right"))
(gnc:html-document-set-style!
ssdoc "total-label-cell"
'tag '("td" "b")
'attribute (list "align" "left"))
(gnc:html-document-set-style!
ssdoc "centered-label-cell"
'tag '("td" "b")
'attribute (list "align" "center"))
;; don't surround marked-up links with <a> </a>
(if (not links?)
(gnc:html-document-set-style!
ssdoc "a" 'tag ""))
(let ((t (gnc:make-html-table)))
;; we don't want a bevel for this table, but we don't want
;; that to propagate
(gnc:html-table-set-style!
t "table"
'attribute (list "border" 0)
'inheritable? #f)
; set the header column to be the 2nd when we have a logo
; do this so that when logo is not present, the document
; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1))
(gnc:html-table-set-cell!
t 1 headcolumn
(if show-preparer?
;; title plus preparer info
(gnc:make-html-text
(gnc:html-markup-b
(gnc:html-document-title doc))
(gnc:html-markup-br)
(_ "Prepared by: ")
(gnc:html-markup-b preparer)
(gnc:html-markup-br)
(_ "Prepared for: ")
(gnc:html-markup-b prepared-for)
(gnc:html-markup-br)
(_ "Date: ")
(gnc:print-date
(cons (current-time) 0)))
;; title only
(gnc:make-html-text
(gnc:html-markup-b
(gnc:html-document-title doc)))))
; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0))
(begin
(gnc:html-table-set-cell!
t 0 0
(gnc:make-html-text
(gnc:html-markup-img logopixmap)))))
(if (and headpixmap (> (string-length headpixmap) 0))
(begin
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text
(string-append
"<div align=\"" align "\">"
"<img src=\"" headpixmap "\">"
"</div>")))
)
(gnc:html-table-set-cell!
t 0 headcolumn
(gnc:make-html-text "&nbsp;")))
(apply
gnc:html-table-set-cell!
t 2 headcolumn
(gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t))
ssdoc))
(gnc:define-html-style-sheet
'version 1
'name (N_ "Easy")
'renderer easy-renderer
'options-generator easy-options)
(gnc:make-html-style-sheet "Easy" (N_ "Easy"))

1
src/report/stylesheets/stylesheets.scm
View File

@@ -10,3 +10,4 @@
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash report stylesheet-plain))
(use-modules (gnucash report stylesheet-fancy))
(use-modules (gnucash report stylesheet-easy))