On Tue, 2004-06-15 at 12:29, Derek Atkins wrote:
> James Strandboge <[EMAIL PROTECTED]> writes:
> > I find this updated stylesheet very useful, but it may be more
> > appropriate to just have this be a separate 3rd stylesheet.
>
> I agree that this should probably be a third stylesheet...
I have attached a new stylesheet and patch against stylesheets.scm to
add it to gnucash.
> > easy-invoice.scm is a new invoice based on invoice.scm. Its named 'Easy
> > Invoice' because it is easily configurable, but I am not entirely
> > satisfied with the name, and would be more than happy to change it. :)
> > The main features of this invoice (beyond those found in invoice.scm) is
> > that it supports options for displaying My Company (data from
> > File/Properties), invoice width, and an added 'ID String'.
>
> What kind of options did you add for displaying "My Company"?
> What's the "ID String" and how is it used?
"My Company" has no options other than to display it or not display it.
When displayed, it shows up on the right hand side, across from the
customer's address and is right justified. There is a bug in my
previous easy-invoice.scm that is fixed in the attached version (if
File/Properties values are blank, and My Company is selected, the page
errors out).
"ID-String" is simply text (it can be anything) that is displayed on the
right side of the page directly across from "Invoice #." If left blank,
nothing is displayed, but our company uses the format:
<b><u>Tax ID: 00-0000000</u></b>
as the "ID-String" (incidentally, I was very pleased when I realized
that simple HTML formatting tags like <b>, <i> and others could be used
in Extra Notes and ID-String). The above entry gives the same
formatting as "Invoice #," but the user can put whatever text he/she
wants there. Since we use it for our Tax-ID, I just named it
"ID-String," but it certainly can be renamed to something even more
general.
Jamie
--
Targeted Performance Partners, LLC
Web: http://www.tpptraining.com
E-mail: [EMAIL PROTECTED]
Tel: (585) 271-8370
Fax: (585) 271-8373
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stylesheet-easy.scm: stylesheet with nicer formatting for
;; printing and easier configurability
;;
;; Copyright 2004 James Strandboge <[EMAIL PROTECTED]>
;;
;; 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 [EMAIL PROTECTED]
;;
;; Based on work from:
;; stylesheet-header.scm
;; Copyright 2000 Bill Gribble <[EMAIL PROTECTED]>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 " ")))
(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"))
--- ./stylesheets.scm.orig Thu Jun 17 09:35:49 2004
+++ ./stylesheets.scm Thu Jun 17 09:35:34 2004
@@ -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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; -*-scheme-*-
;; easy-invoice.scm -- an easily configured Invoice Report,
;; used to print a GncInvoice
;;
;; Created by: James Strandboge <[EMAIL PROTECTED]>
;;
;; Based on invoice.scm by Derek Atkins <[EMAIL PROTECTED]>
;;
;; stylesheet-header.scm : stylesheet with nicer layout
;; Copyright 2000 Bill Gribble <[EMAIL PROTECTED]>
;;
;; 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 [EMAIL PROTECTED]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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_ "Due Date")
"ob" (N_ "Display due date?") #t))
(gnc:register-inv-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Individual Taxes")
"oc" (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-text-option
(N_ "Text") (N_ "ID String")
"w" (N_ "ID string for your company")
"<b><u>Tax ID: 00-0000000</u></b>"))
(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") ": " 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 ": ")
(string-expand (gnc: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))
(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'>")
(let ((taxid (opt-val "Text" "ID String")))
(if (and taxid (> (string-length taxid) 0))
(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 (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") ": "
(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") ": "
(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)
_______________________________________________
gnucash-devel mailing list
[EMAIL PROTECTED]
https://lists.gnucash.org/mailman/listinfo/gnucash-devel
