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

* Create an "owner-report" which prints out a set of Invoice and

Browse Source 
Payment transactions and also an aging report for a single "owner"
	(e.g. Customer or Vendor).  This is still a first pass, so it
	might not be correct.  It uses Lots, but it assumes that the
	Account is periodically closed and re-opened (does not have a
	'start-date').  It still needs to be tied into the main GUI.

	* gncJob: add gncJobRetGUID() and gncJobLookupDirect()

	* gncOwner: add gncOwnerRetGUID()

	* gw-business-core-spec.scm: wrap GncAmountType, GncTaxIncluded
	GncBillTermType, gncInvoiceGetInvoiceFromLot(), gncJobRetGUID(),
	jobJobLookupDirect(), gncOwnerGetEndOwner(),
	gncOwnerGetOwnerFromLot(), gncOwnerRetGUID()

	* business-gnome.scm: add extensions to test the owner-report

	* business-options.scm: add an "owner" option-type


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7037 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
2002-06-27 20:03:19 +00:00
parent 4e89bf835d
commit 43083bb2db
11 changed files with 700 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
ChangeLog
View File

@@ -1,3 +1,25 @@
2002-06-27 Derek Atkins <derek@ihtfp.com>
* Create an "owner-report" which prints out a set of Invoice and
Payment transactions and also an aging report for a single "owner"
(e.g. Customer or Vendor). This is still a first pass, so it
might not be correct. It uses Lots, but it assumes that the
Account is periodically closed and re-opened (does not have a
'start-date'). It still needs to be tied into the main GUI.
* gncJob: add gncJobRetGUID() and gncJobLookupDirect()
* gncOwner: add gncOwnerRetGUID()
* gw-business-core-spec.scm: wrap GncAmountType, GncTaxIncluded
GncBillTermType, gncInvoiceGetInvoiceFromLot(), gncJobRetGUID(),
jobJobLookupDirect(), gncOwnerGetEndOwner(),
gncOwnerGetOwnerFromLot(), gncOwnerRetGUID()
* business-gnome.scm: add extensions to test the owner-report
* business-options.scm: add an "owner" option-type
2002-06-25 Derek Atkins <derek@ihtfp.com>
* gncOwner.[ch]: Provide functions to store/lookup an owner in a

14
src/business/business-core/gncJob.c
View File

@@ -232,6 +232,14 @@ const GUID * gncJobGetGUID (GncJob *job)
return &job->guid;
}
GUID gncJobRetGUID (GncJob *job)
{
const GUID *guid = gncJobGetGUID (job);
if (guid)
return *guid;
return *xaccGUIDNULL ();
}
gboolean gncJobGetActive (GncJob *job)
{
if (!job) return FALSE;
@@ -245,6 +253,12 @@ GncJob * gncJobLookup (GNCBook *book, const GUID *guid)
guid, _GNC_MOD_NAME);
}
GncJob * gncJobLookupDirect (GUID guid, GNCBook *book)
{
if (!book) return NULL;
return gncJobLookup (book, &guid);
}
gboolean gncJobIsDirty (GncJob *job)
{
if (!job) return FALSE;

3
src/business/business-core/gncJob.h
View File

@@ -39,6 +39,9 @@ const char * gncJobGetReference (GncJob *job);
GncOwner * gncJobGetOwner (GncJob *job);
gboolean gncJobGetActive (GncJob *job);
GUID gncJobRetGUID (GncJob *job);
GncJob *gncJobLookupDirect (GUID guid, GNCBook *book);
GncJob * gncJobLookup (GNCBook *book, const GUID *guid);
gboolean gncJobIsDirty (GncJob *job);

8
src/business/business-core/gncOwner.c
View File

@@ -161,6 +161,14 @@ const GUID * gncOwnerGetGUID (GncOwner *owner)
}
}
GUID gncOwnerRetGUID (GncOwner *owner)
{
const GUID *guid = gncOwnerGetGUID (owner);
if (guid)
return *guid;
return *xaccGUIDNULL ();
}
GncOwner * gncOwnerGetEndOwner (GncOwner *owner)
{
if (!owner) return NULL;

1
src/business/business-core/gncOwner.h
View File

@@ -54,6 +54,7 @@ gnc_commodity * gncOwnerGetCommodity (GncOwner *owner);
/* Get the GUID of the immediate owner */
const GUID * gncOwnerGetGUID (GncOwner *owner);
GUID gncOwnerRetGUID (GncOwner *owner);
/*
* Get the "parent" Owner or GUID thereof. The "parent" owner

65
src/business/business-core/gw-business-core-spec.scm
View File

@@ -53,7 +53,6 @@
(gw:inline-scheme '(use-modules (gnucash business-core))))))
;; The core Business Object Types
;; XXX: Need to add lists of all of these!
(gw:wrap-as-wct ws '<gnc:GncAddress*> "GncAddress*" "const GncAddress*")
(gw:wrap-as-wct ws '<gnc:GncBillTerm*> "GncBillTerm*" "const GncBillTerm*")
@@ -75,6 +74,22 @@
(gw:enum-add-value! wt "GNC_OWNER_VENDOR" 'gnc-owner-vendor)
#t)
(let ((wt (gw:wrap-enumeration ws '<gnc:GncAmountType> "GncAmountType")))
(gw:enum-add-value! wt "GNC_AMT_TYPE_VALUE" 'gnc-amount-type-value)
(gw:enum-add-value! wt "GNC_AMT_TYPE_PERCENT" 'gnc-amount-type-percent)
#t)
(let ((wt (gw:wrap-enumeration ws '<gnc:GncTaxIncluded> "GncTaxIncluded")))
(gw:enum-add-value! wt "GNC_TAXINCLUDED_YES" 'gnc-tax-included-yes)
(gw:enum-add-value! wt "GNC_TAXINCLUDED_NO" 'gnc-tax-included-no)
(gw:enum-add-value! wt "GNC_TAXINCLUDED_USEGLOBAL" 'gnc-tax-included-useglobal)
#t)
(let ((wt (gw:wrap-enumeration ws '<gnc:GncBillTermType> "GncBillTermType")))
(gw:enum-add-value! wt "GNC_TERM_TYPE_DAYS" 'gnc-term-type-days)
(gw:enum-add-value! wt "GNC_TERM_TYPE_PROXIMO" 'gnc-term-type-proximo)
#t)
;;
;; gncAddress.h
;;
@@ -575,6 +590,14 @@
'((<gnc:GncInvoice*> invoice))
"Return the invoice's list of Entries")
(gw:wrap-function
ws
'gnc:invoice-get-invoice-from-lot
'<gnc:GncInvoice*>
"gncInvoiceGetInvoiceFromLot"
'((<gnc:Lot*> lot))
"Return the Invoice attached to a Lot.")
;;
;; gncJob.h
;;
@@ -655,6 +678,22 @@
'((<gnc:GncJob*> job))
"Return the Job's Owner")
(gw:wrap-function
ws
'gnc:job-get-guid
'<gnc:guid-scm>
"gncJobRetGUID"
'((<gnc:GncJob*> job))
"Return the guid of the job")
(gw:wrap-function
ws
'gnc:job-lookup
'<gnc:GncJob*>
"gncJobLookupDirect"
'((<gnc:guid-scm> guid) (<gnc:Book*> book))
"Lookup the job with GUID guid.")
;;
;; gncOrder.h
;;
@@ -843,6 +882,30 @@
'((<gnc:GncOwner*> owner1) (<gnc:GncOwner*> owner2))
"Compare owner1 and owner2 and return if they are equal")
(gw:wrap-function
ws
'gnc:owner-get-end-owner
'<gnc:GncOwner*>
"gncOwnerGetEndOwner"
'((<gnc:GncOwner*> owner))
"Returns the End Owner of this owner")
(gw:wrap-function
ws
'gnc:owner-get-owner-from-lot
'<gw:bool>
"gncOwnerGetOwnerFromLot"
'((<gnc:Lot*> lot) (<gnc:GncOwner*> owner))
"Compute the owner from the Lot, and fills in owner. Returns TRUE if successful.")
(gw:wrap-function
ws
'gnc:owner-get-guid
'<gnc:guid-scm>
"gncOwnerRetGUID"
'((<gnc:GncOwner*> owner))
"Return the GUID of this owner")
;;
;; gncVendor.h
;;

35
src/business/business-gnome/business-gnome.scm
View File

@@ -8,6 +8,9 @@
(gnc:module-load "gnucash/business-core-file" 0)
(gnc:module-load "gnucash/dialog-tax-table" 0)
(gnc:module-load "gnucash/report/report-gnome" 0)
(use-modules (gnucash report business-reports))
(define top-level "_Business")
(define new-label "New")
(define find-label "Find")
@@ -225,6 +228,25 @@
(define (add-business-test)
(define test-report
(gnc:make-menu-item (N_ "Test Owner Report")
(N_ "Test Owner Report")
(list "Extensions" "")
(lambda ()
(let* ((book (gnc:get-current-book))
(group (gnc:book-get-group book))
(sep (string-ref (gnc:account-separator-char)
0))
(acc (gnc:get-account-from-full-name
group "A/R" sep))
(query (gnc:malloc-query)))
(gnc:query-add-single-account-match
query acc 'query-and)
(gnc:report-window
(gnc:owner-report-create #f query acc))))))
(define test-search
(gnc:make-menu-item (N_ "Test Search Dialog")
(N_ "Test Search Dialog")
@@ -235,13 +257,22 @@
(define reload-invoice
(gnc:make-menu-item (N_ "Reload invoice report")
(N_ "Reload invoice report")
(N_ "Reload invoice report scheme file")
(list "Extensions" "")
(lambda ()
(let ((m (current-module)))
(load-from-path "gnucash/report/invoice.scm")
(set-current-module m)))))
(define reload-owner
(gnc:make-menu-item (N_ "Reload owner report")
(N_ "Reload owner report scheme file")
(list "Extensions" "")
(lambda ()
(let ((m (current-module)))
(load-from-path "gnucash/report/owner-report.scm")
(set-current-module m)))))
(define init-data
(gnc:make-menu-item (N_ "Initialize Test Data")
(N_ "Initialize Test Data")
@@ -326,7 +357,9 @@
(gnc:add-extension init-data)
(gnc:add-extension reload-invoice)
(gnc:add-extension reload-owner)
(gnc:add-extension test-search)
(gnc:add-extension test-report)
(add-employee-extensions)
)

79
src/business/business-gnome/business-options.scm
View File

@@ -182,6 +182,85 @@
validator
#f #f #f #f)))
;; Internally, values are always a type/guid pair. Externally, both
;; type/guid pairs and owner pointers may be used to set the value of
;; the option. The option always returns a single owner pointer.
(define (gnc:make-owner-option
section
name
sort-tag
documentation-string
default-getter
value-validator)
(let ((option-value (gnc:owner-create)))
(define (convert-to-pair item)
(if (pair? item)
item
(cons (gnc:owner-get-type item) (gnc:owner-get-guid item))))
(define (convert-to-owner pair)
(if (pair? pair)
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym (car pair) #f)))
(case type
((gnc-owner-customer)
(gnc:owner-init-customer
option-value
(gnc:customer-lookup (cdr pair) (gnc:get-current-book)))
option-value)
((gnc-owner-vendor)
(gnc:owner-init-vendor
option-value
(gnc:vendor-lookup (cdr pair) (gnc:get-current-book)))
option-value)
((gnc-owner-job)
(gnc:owner-init-job
option-value
(gnc:job-lookup (cdr pair) (gnc:get-current-book)))
option-value)
(else #f)))
pair))
(let* ((option (convert-to-pair (default-getter)))
(option-set #f)
(getter (lambda () (convert-to-owner
(if option-set
option
(default-getter)))))
(value->string (lambda ()
(string-append
"'" (gnc:value->string
(if option-set option #f)))))
(validator
(if (not value-validator)
(lambda (owner) (list #t owner))
(lambda (owner)
(value-validator (convert-to-owner owner))))))
(gnc:make-option
section name sort-tag 'owner documentation-string getter
(lambda (owner)
(if (not owner) (set! owner (default-getter)))
(set! owner (convert-to-owner owner))
(let* ((result (validator owner))
(valid (car result))
(value (cadr result)))
(if valid
(begin
(set! option (convert-to-pair value))
(set! option-set #t))
(gnc:error "Illegal owner value set"))))
(lambda () (convert-to-owner (default-getter)))
(gnc:restore-form-generator value->string)
validator
#f #f #f #f))))
(export gnc:make-invoice-option)
(export gnc:make-customer-option)
(export gnc:make-vendor-option)
(export gnc:make-owner-option)

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

@@ -9,7 +9,8 @@ noinst_DATA = .scm-links
gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report
gncscmmod_DATA = \
business-reports.scm \
invoice.scm
invoice.scm \
owner-report.scm
EXTRA_DIST = \
.cvsignore \

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

@@ -10,7 +10,10 @@
(gnc:module-load "gnucash/report/standard-reports" 0)
(export gnc:invoice-report-create)
(export gnc:owner-report-create)
(use-modules (gnucash report invoice))
(use-modules (gnucash report owner-report))
(define gnc:invoice-report-create gnc:invoice-report-create-internal)
(define gnc:owner-report-create gnc:owner-report-create-internal)

470
src/business/business-reports/owner-report.scm Normal file
View File

@@ -0,0 +1,470 @@
;; -*-scheme-*-
;; owner-report.scm -- Print out a detailed owner report, which is a
;; summary of invoices and payments for a particular
;; company (the owner) applied to an account.
;;
;; Created by: Derek Atkins <warlord@MIT.EDU>
;;
(define-module (gnucash report owner-report))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-19))
(use-modules (ice-9 slib))
(use-modules (gnucash gnc-module))
(use-modules (gnucash main)) ; for gnc:debug
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/business-gnome" 0)
(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 (num-col columns-used)
(vector-ref columns-used 1))
(define (type-col columns-used)
(vector-ref columns-used 2))
(define (memo-col columns-used)
(vector-ref columns-used 3))
(define (value-col columns-used)
(vector-ref columns-used 4))
(define columns-used-size 5)
(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" "Num") 1)
(set-col (opt-val "Display Columns" "Type") 2)
(set-col (opt-val "Display Columns" "Memo") 3)
(set-col (opt-val "Display Columns" "Value") 4)
col-vector))
(define (make-heading-list column-vector)
(let ((heading-list '()))
(if (date-col column-vector)
(addto! heading-list (_ "Date")))
(if (num-col column-vector)
(addto! heading-list (_ "Reference")))
(if (type-col column-vector)
(addto! heading-list (_ "Type")))
(if (memo-col column-vector)
(addto! heading-list (_ "Description")))
(if (value-col column-vector)
(addto! heading-list (_ "Amount")))
(reverse heading-list)))
(define num-buckets 4)
(define (new-bucket-vector)
(make-vector num-buckets (gnc:numeric-zero)))
(define (make-interval-list to-date)
(let ((begindate to-date))
(set! begindate (decdate begindate ThirtyDayDelta))
(set! begindate (decdate begindate ThirtyDayDelta))
(set! begindate (decdate begindate ThirtyDayDelta))
(gnc:make-date-list begindate to-date ThirtyDayDelta)))
(define (make-aging-table options query bucket-intervals)
(let ((lots (gnc:query-get-lots query 'query-txn-match-any))
(buckets (new-bucket-vector))
(payments (gnc:numeric-zero))
(currency (gnc:default-currency)) ;XXX
(table (gnc:make-html-table)))
(define (in-interval this-date current-bucket)
(gnc:timepair-lt this-date current-bucket))
(define (find-bucket current-bucket bucket-intervals date)
(begin
(if (>= current-bucket (vector-length bucket-intervals))
(gnc:error "sanity check failed in find-bucket")
(if (in-interval date (vector-ref bucket-intervals current-bucket))
current-bucket
(find-bucket (+ current-bucket 1) bucket-intervals date)))))
(define (apply-invoice date value)
(let* ((bucket-index (find-bucket 0 bucket-intervals date))
(new-value (gnc:numeric-add-fixed
value
(vector-ref buckets bucket-index))))
(vector-set! buckets bucket-index new-value)))
(define (apply-payment value)
(set! payments (gnc:numeric-add-fixed value payments)))
(for-each
(lambda (lot)
(let* ((bal (gnc:lot-get-balance lot))
(invoice (gnc:invoice-get-invoice-from-lot lot))
(post-date (gnc:invoice-get-date-posted invoice)))
(if (not (gnc:numeric-zero-p bal))
(if invoice
(begin
(apply-invoice post-date bal))
(apply-payment bal)))))
lots)
(gnc:html-table-set-col-headers!
table
(list (N_ "0-30 days")
(N_ "31-60 days")
(N_ "61-90 days")
(N_ "91+ days")))
(gnc:html-table-append-row!
table
(reverse (map (lambda (entry)
(gnc:make-gnc-monetary currency entry))
(vector->list buckets))))
table))
;;
;; Make sure the caller checks the type first and only calls us with
;; invoice and payment transactions. we don't verify it here.
;;
;; Return a pair of (date . value)
;;
(define (add-txn-row table txn acc column-vector row-style)
(let* ((type (gnc:transaction-get-txn-type txn))
(date (gnc:transaction-get-date-posted txn))
(value (gnc:transaction-get-account-value txn acc))
(split (gnc:transaction-get-split txn 0))
(currency (gnc:transaction-get-currency txn))
(type-str
(cond
((equal? type gnc:transaction-type-invoice) (N_ "Invoice"))
((equal? type gnc:transaction-type-payment) (N_ "Payment, thank you"))
(else (N_ "UNK"))))
(row-contents '()))
(if (date-col column-vector)
(addto! row-contents (gnc:print-date date)))
(if (num-col column-vector)
(addto! row-contents (gnc:transaction-get-num txn)))
(if (type-col column-vector)
(addto! row-contents type-str))
(if (memo-col column-vector)
(addto! row-contents (gnc:split-get-memo split)))
(if (value-col column-vector)
(addto! row-contents
(gnc:make-html-table-cell/markup "number-cell"
(gnc:make-gnc-monetary
currency value))))
(gnc:html-table-append-row/markup! table row-style
(reverse row-contents))
(cons date value)
))
(define (make-txn-table options query acc report-date)
(let ((txns (gnc:query-get-transactions query 'query-txn-match-any))
(used-columns (build-column-used options))
(odd-row? #t)
(total (gnc:numeric-zero))
(currency (gnc:default-currency)) ;XXX
(table (gnc:make-html-table)))
(gnc:html-table-set-col-headers!
table
(make-heading-list used-columns))
; Order the transactions properly
(set! txns (sort txns (lambda (a b) (> 0 (gnc:transaction-order a b)))))
(for-each
(lambda (txn)
(let ((type (gnc:transaction-get-txn-type txn))
(row-style (if odd-row? "normal-row" "alternate-row")))
(if
(or (equal? type gnc:transaction-type-invoice)
(equal? type gnc:transaction-type-payment))
(let ((dv (add-txn-row table txn acc used-columns row-style)))
(set! odd-row? (not odd-row?))
(set! total (gnc:numeric-add-fixed total (cdr dv)))
))))
txns)
(gnc:html-table-append-row/markup!
table
"grand-total"
(append (cons (gnc:make-html-table-cell/markup
"total-label-cell"
(if (gnc:numeric-negative-p total)
(N_ "Total Credit")
(N_ "Total Due")))
'())
(list (gnc:make-html-table-cell/size/markup
1 (value-col used-columns)
"total-number-cell"
(gnc:make-gnc-monetary currency total)))))
(let* ((interval-vec (list->vector (make-interval-list report-date))))
(gnc:html-table-append-row/markup!
table
"grand-total"
(list (gnc:make-html-table-cell/size/markup
0 (value-col used-columns)
"total-number-cell"
(make-aging-table options query interval-vec)))))
table))
(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-owner-option "__reg" "owner" "" ""
(lambda () #f) #f))
(gnc:register-inv-option
(gnc:make-query-option "__reg" "query" #f))
(gnc:register-inv-option
(gnc:make-account-list-option "__reg" "account" "" ""
(lambda () '()) #f #f))
(gnc:options-add-report-date!
gnc:*report-options* gnc:pagename-general
(N_ "To") "a")
(gnc:register-inv-option
(gnc:make-simple-boolean-option
(N_ "Display Columns") (N_ "Date")
"b" (N_ "Display the transaction date?") #t))
(gnc:register-inv-option
(gnc:make-simple-boolean-option
(N_ "Display Columns") (N_ "Num")
"d" (N_ "Display the transaction reference?") #t))
(gnc:register-inv-option
(gnc:make-simple-boolean-option
(N_ "Display Columns") (N_ "Type")
"g" (N_ "Display the transaction type?") #t))
(gnc:register-inv-option
(gnc:make-simple-boolean-option
(N_ "Display Columns") (N_ "Memo")
"ha" (N_ "Display the transaction description?") #t))
(gnc:register-inv-option
(gnc:make-simple-boolean-option
(N_ "Display Columns") (N_ "Value")
"hb" "Display the transaction amount?" #t))
(gnc:register-inv-option
(gnc:make-string-option
(N_ "Display") (N_ "Today Date Format")
"v" (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 (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-owner-table owner)
(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>"))
(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 date-format)
(let ((table (gnc:make-html-table)))
(gnc:html-table-set-style!
table "table"
'attribute (list "border" 0)
'attribute (list "align" "right")
'attribute (list "valign" "top")
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
(gnc:html-table-append-row!
table
(list
(gnc:option-value
(gnc:lookup-global-option "User Info" "User Name"))))
(gnc:html-table-append-row!
table
(list
(string-expand
(gnc:option-value
(gnc:lookup-global-option "User Info" "User Address"))
#\newline "<br>")))
(gnc:html-table-append-row!
table
(list (date->string (current-date) date-format)))
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)))
(let* ((document (gnc:make-html-document))
(table '())
(orders '())
(query-scm (opt-val "__reg" "query"))
(query (gnc:scm->query query-scm))
(account (car (opt-val "__reg" "account")))
(owner (opt-val "__reg" "owner"))
(report-date (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(opt-val gnc:pagename-general (N_ "To")))))
(title #f))
(define (add-order o)
(if (and references? (not (member o orders)))
(addto! orders o)))
(gnc:query-set-book query (gnc:get-current-book))
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
(gnc:owner-get-type owner) #f))
(type-str ""))
(case type
((gnc-owner-customer)
(set! type-str (N_ "Customer")))
((gnc-owner-vendor)
(set! type-str (N_ "Vendor")))
((gnc-owner-job)
(set! type-str (N_ "Job"))))
(set! title (string-append type-str " Report: "
(gnc:owner-get-name owner))))
(set! table (make-txn-table (gnc:report-options report-obj)
query account report-date))
(gnc:html-document-set-title! document title)
(gnc:html-table-set-style!
table "table"
'attribute (list "border" 1)
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 4))
(gnc:html-document-add-object!
document
(make-myname-table (opt-val "Display" "Today Date Format")))
(if owner
(gnc:html-document-add-object!
document
(make-owner-table owner)))
(make-break! document)
(make-break! document)
(gnc:html-document-add-object! document table)
document))
(gnc:define-report
'version 1
'name (N_ "Company Report")
'options-generator options-generator
'renderer reg-renderer
'in-menu? #f)
(define (gnc:owner-report-create-internal owner query account)
(let* ((options (gnc:make-report-options "Company Report"))
(owner-op (gnc:lookup-option options "__reg" "owner"))
(query-op (gnc:lookup-option options "__reg" "query"))
(account-op (gnc:lookup-option options "__reg" "account")))
(gnc:option-set-value owner-op owner)
(gnc:option-set-value query-op query)
(gnc:option-set-value account-op (list account))
(gnc:make-report "Company Report" options)))
(export gnc:owner-report-create-internal)