mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
* Change the "Owner Report" to a "Customer Report" and "Vendor
Report" Create a plug-in system to plug reports into the Register Window, keyed off of the account type and whether a split exists (for a "Transaction" report). This required changes to the payables and receivables (aging) reports. * Tie the Customer and Vendor reports in, so you can bring up a Customer Report by selecting a transaction in an A/R account and clicking on Reports -> Transaction Report. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7040 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
parent
bceb36bd12
commit
6470316116
10
ChangeLog
10
ChangeLog
@ -1,5 +1,15 @@
|
||||
2002-06-27 Derek Atkins <derek@ihtfp.com>
|
||||
|
||||
* Change the "Owner Report" to a "Customer Report" and "Vendor
|
||||
Report" Create a plug-in system to plug reports into the Register
|
||||
Window, keyed off of the account type and whether a split exists
|
||||
(for a "Transaction" report). This required changes to the
|
||||
payables and receivables (aging) reports.
|
||||
|
||||
* Tie the Customer and Vendor reports in, so you can bring up a
|
||||
Customer Report by selecting a transaction in an A/R account and
|
||||
clicking on Reports -> Transaction Report.
|
||||
|
||||
* 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
|
||||
|
||||
@ -10,10 +10,8 @@
|
||||
(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)
|
||||
|
||||
@ -16,6 +16,7 @@
|
||||
|
||||
(gnc:module-load "gnucash/report/report-system" 0)
|
||||
(gnc:module-load "gnucash/business-gnome" 0)
|
||||
(use-modules (gnucash report standard-reports))
|
||||
|
||||
(define-macro (addto! alist element)
|
||||
`(set! ,alist (cons ,element ,alist)))
|
||||
@ -406,17 +407,14 @@
|
||||
(gnc:query-set-book query (gnc:get-current-book))
|
||||
|
||||
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
|
||||
(gnc:owner-get-type owner) #f))
|
||||
(gnc:owner-get-type (gnc:owner-get-end-owner 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! type-str (N_ "Vendor"))))
|
||||
|
||||
(set! title (string-append type-str " Report: "
|
||||
(gnc:owner-get-name owner))))
|
||||
@ -451,20 +449,79 @@
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name (N_ "Company Report")
|
||||
'name (N_ "Customer 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"))
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name (N_ "Vendor Report")
|
||||
'options-generator options-generator
|
||||
'renderer reg-renderer
|
||||
'in-menu? #f)
|
||||
|
||||
(define (owner-report-create-internal report-name owner query account)
|
||||
(let* ((options (gnc:make-report-options report-name))
|
||||
(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)))
|
||||
(gnc:make-report report-name options)))
|
||||
|
||||
(export gnc:owner-report-create-internal)
|
||||
(define (owner-report-create owner query account)
|
||||
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
|
||||
(gnc:owner-get-type (gnc:owner-get-end-owner owner)) #f)))
|
||||
(case type
|
||||
((gnc-owner-customer)
|
||||
(owner-report-create-internal "Customer Report" owner query account))
|
||||
|
||||
((gnc-owner-vendor)
|
||||
(owner-report-create-internal "Vendor Reprt" owner query account)))
|
||||
))
|
||||
|
||||
(define (gnc:owner-report-create-internal
|
||||
account split query journal? double? title
|
||||
debit-string credit-string)
|
||||
|
||||
(let* ((trans (gnc:split-get-parent split))
|
||||
(invoice (gnc:invoice-get-invoice-from-txn trans))
|
||||
(q (gnc:malloc-query))
|
||||
(temp-owner (gnc:owner-create))
|
||||
(owner #f))
|
||||
|
||||
(if invoice
|
||||
(set! owner (gnc:invoice-get-owner invoice))
|
||||
(let ((split-list (gnc:transaction-get-splits trans)))
|
||||
(define (check-splits splits)
|
||||
(let* ((split (car splits))
|
||||
(lot (gnc:split-get-lot split)))
|
||||
(if lot
|
||||
(let* ((invoice (gnc:invoice-get-invoice-from-lot lot))
|
||||
(owner? (gnc:owner-get-owner-from-lot
|
||||
lot temp-owner)))
|
||||
(if invoice
|
||||
(set! owner (gnc:invoice-get-owner invoice))
|
||||
(if owner?
|
||||
(set! owner temp-owner)
|
||||
(check-splits (cdr splits)))))
|
||||
(check-splits (cdr splits)))))
|
||||
(check-splits split-list)))
|
||||
|
||||
;; XXX: Need to add checks for the ownership...
|
||||
(gnc:query-add-single-account-match q account 'query-and)
|
||||
(gnc:query-set-book q (gnc:get-current-book))
|
||||
|
||||
(let ((res (owner-report-create owner q account)))
|
||||
(gnc:owner-destroy temp-owner)
|
||||
(gnc:free-query q)
|
||||
res)))
|
||||
|
||||
(gnc:register-report-hook 'receivable #t
|
||||
gnc:owner-report-create-internal)
|
||||
|
||||
(gnc:register-report-hook 'payable #t
|
||||
gnc:owner-report-create-internal)
|
||||
|
||||
@ -2588,7 +2588,7 @@ gnc_register_close_cb (GtkWidget *widget, gpointer data)
|
||||
}
|
||||
|
||||
static int
|
||||
report_helper (RegWindow *regData, Query *query)
|
||||
report_helper (RegWindow *regData, Split *split, Query *query)
|
||||
{
|
||||
SplitRegister *reg = gnc_ledger_display_get_split_register (regData->ledger);
|
||||
Account *account;
|
||||
@ -2600,70 +2600,65 @@ report_helper (RegWindow *regData, Query *query)
|
||||
|
||||
args = SCM_EOL;
|
||||
|
||||
switch (reg->type) {
|
||||
case PAYABLE_REGISTER:
|
||||
case RECEIVABLE_REGISTER:
|
||||
g_return_val_if_fail (query == NULL, -1);
|
||||
func = gh_eval_str ("gnc:register-report-create");
|
||||
g_return_val_if_fail (gh_procedure_p (func), -1);
|
||||
|
||||
if (reg->type == PAYABLE_REGISTER)
|
||||
func = gh_eval_str ("gnc:payables-report-create");
|
||||
else
|
||||
func = gh_eval_str ("gnc:receivables-report-create");
|
||||
g_return_val_if_fail (gh_procedure_p (func), -1);
|
||||
/* FIXME: when we drop support older guiles, drop the (char *) coercion. */
|
||||
arg = gh_str02scm ((char *) gnc_split_register_get_credit_string (reg));
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
qtype = gh_eval_str("<gnc:Account*>");
|
||||
g_return_val_if_fail (qtype != SCM_UNDEFINED, -1);
|
||||
/* FIXME: when we drop support older guiles, drop the (char *) coercion. */
|
||||
arg = gh_str02scm ((char *) gnc_split_register_get_debit_string (reg));
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
account = gnc_ledger_display_leader (regData->ledger);
|
||||
str = gnc_reg_get_name (regData, FALSE);
|
||||
arg = gh_str02scm (str);
|
||||
args = gh_cons (arg, args);
|
||||
g_free (str);
|
||||
|
||||
arg = gw_wcp_assimilate_ptr (account, qtype);
|
||||
args = gh_cons (arg, args);
|
||||
g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
|
||||
arg = gh_bool2scm (reg->use_double_line);
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
break;
|
||||
arg = gh_bool2scm (reg->style == REG_STYLE_JOURNAL);
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
default:
|
||||
if (!query)
|
||||
{
|
||||
query = gnc_ledger_display_get_query (regData->ledger);
|
||||
g_return_val_if_fail (query != NULL, -1);
|
||||
}
|
||||
|
||||
func = gh_eval_str ("gnc:register-report-create");
|
||||
g_return_val_if_fail (gh_procedure_p (func), -1);
|
||||
|
||||
/* FIXME: when we drop support older guiles, drop the (char *) coercion. */
|
||||
arg = gh_str02scm ((char *) gnc_split_register_get_credit_string (reg));
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
/* FIXME: when we drop support older guiles, drop the (char *) coercion. */
|
||||
arg = gh_str02scm ((char *) gnc_split_register_get_debit_string (reg));
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
str = gnc_reg_get_name (regData, FALSE);
|
||||
arg = gh_str02scm (str);
|
||||
args = gh_cons (arg, args);
|
||||
g_free (str);
|
||||
|
||||
arg = gh_bool2scm (reg->use_double_line);
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
arg = gh_bool2scm (reg->style == REG_STYLE_JOURNAL);
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
qtype = gh_eval_str("<gnc:Query*>");
|
||||
g_return_val_if_fail (qtype != SCM_UNDEFINED, -1);
|
||||
|
||||
arg = gw_wcp_assimilate_ptr (query, qtype);
|
||||
args = gh_cons (arg, args);
|
||||
g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
|
||||
|
||||
arg = gh_bool2scm (FALSE);
|
||||
args = gh_cons (arg, args);
|
||||
|
||||
break;
|
||||
if (!query)
|
||||
{
|
||||
query = gnc_ledger_display_get_query (regData->ledger);
|
||||
g_return_val_if_fail (query != NULL, -1);
|
||||
}
|
||||
|
||||
qtype = gh_eval_str("<gnc:Query*>");
|
||||
g_return_val_if_fail (qtype != SCM_UNDEFINED, -1);
|
||||
|
||||
arg = gw_wcp_assimilate_ptr (query, qtype);
|
||||
args = gh_cons (arg, args);
|
||||
g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
|
||||
|
||||
|
||||
if (split)
|
||||
{
|
||||
qtype = gh_eval_str("<gnc:Split*>");
|
||||
g_return_val_if_fail (qtype != SCM_UNDEFINED, -1);
|
||||
arg = gw_wcp_assimilate_ptr (split, qtype);
|
||||
}
|
||||
else
|
||||
{
|
||||
arg = SCM_BOOL_F;
|
||||
}
|
||||
args = gh_cons (arg, args);
|
||||
g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
|
||||
|
||||
|
||||
qtype = gh_eval_str("<gnc:Account*>");
|
||||
g_return_val_if_fail (qtype != SCM_UNDEFINED, -1);
|
||||
|
||||
account = gnc_ledger_display_leader (regData->ledger);
|
||||
arg = gw_wcp_assimilate_ptr (account, qtype);
|
||||
args = gh_cons (arg, args);
|
||||
g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
|
||||
|
||||
|
||||
/* Apply the function to the args */
|
||||
arg = gh_apply (func, args);
|
||||
g_return_val_if_fail (gh_exact_p (arg), -1);
|
||||
@ -2684,7 +2679,7 @@ gnc_register_report_account_cb (GtkWidget *widget, gpointer data)
|
||||
RegWindow *regData = data;
|
||||
int id;
|
||||
|
||||
id = report_helper (regData, NULL);
|
||||
id = report_helper (regData, NULL, NULL);
|
||||
if (id >= 0)
|
||||
reportWindow (id);
|
||||
}
|
||||
@ -2718,7 +2713,7 @@ gnc_register_report_trans_cb (GtkWidget *widget, gpointer data)
|
||||
xaccQueryAddGUIDMatch (query, xaccSplitGetGUID (split),
|
||||
GNC_ID_SPLIT, QUERY_AND);
|
||||
|
||||
id = report_helper (regData, query);
|
||||
id = report_helper (regData, split, query);
|
||||
if (id >= 0)
|
||||
reportWindow (id);
|
||||
}
|
||||
@ -2736,7 +2731,7 @@ gnc_register_print_cb (GtkWidget *widget, gpointer data)
|
||||
RegWindow *regData = data;
|
||||
int id;
|
||||
|
||||
id = report_helper (regData, NULL);
|
||||
id = report_helper (regData, NULL, NULL);
|
||||
if (id >= 0)
|
||||
gnc_print_report (id);
|
||||
}
|
||||
|
||||
@ -31,6 +31,7 @@
|
||||
(gnc:module-load "gnucash/report/report-system" 0)
|
||||
|
||||
(use-modules (gnucash report aging))
|
||||
(use-modules (gnucash report standard-reports))
|
||||
|
||||
(define this-acc "this-account")
|
||||
|
||||
@ -93,11 +94,17 @@
|
||||
'renderer payables-renderer
|
||||
'in-menu? #f)
|
||||
|
||||
(define (gnc:payables-report-create-internal acct)
|
||||
(define (payables-report-create-internal acct)
|
||||
(let* ((options (gnc:make-report-options "Payable Aging"))
|
||||
(acct-op (gnc:lookup-option options "__reg" this-acc)))
|
||||
|
||||
(gnc:option-set-value acct-op (list acct))
|
||||
(gnc:make-report "Payable Aging" options)))
|
||||
|
||||
(export gnc:payables-report-create-internal)
|
||||
(define (gnc:payables-report-create-internal
|
||||
account split query journal? double? title
|
||||
debit-string credit-string)
|
||||
(payables-report-create-internal account))
|
||||
|
||||
(gnc:register-report-hook 'payable #f
|
||||
gnc:payables-report-create-internal)
|
||||
|
||||
@ -31,6 +31,7 @@
|
||||
(gnc:module-load "gnucash/report/report-system" 0)
|
||||
|
||||
(use-modules (gnucash report aging))
|
||||
(use-modules (gnucash report standard-reports))
|
||||
|
||||
(define this-acc "this-account")
|
||||
|
||||
@ -96,11 +97,17 @@
|
||||
'renderer receivables-renderer
|
||||
'in-menu? #f)
|
||||
|
||||
(define (gnc:receivables-report-create-internal acct)
|
||||
(define (receivables-report-create-internal acct)
|
||||
(let* ((options (gnc:make-report-options "Receivable Aging"))
|
||||
(acct-op (gnc:lookup-option options "__reg" this-acc)))
|
||||
|
||||
(gnc:option-set-value acct-op (list acct))
|
||||
(gnc:make-report "Receivable Aging" options)))
|
||||
|
||||
(export gnc:receivables-report-create-internal)
|
||||
(define (gnc:receivables-report-create-internal
|
||||
account split query journal? double? title
|
||||
debit-string credit-string)
|
||||
(receivables-report-create-internal account))
|
||||
|
||||
(gnc:register-report-hook 'receivable #f
|
||||
gnc:receivables-report-create-internal)
|
||||
|
||||
@ -6,12 +6,66 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-module (gnucash report standard-reports))
|
||||
(use-modules (ice-9 slib))
|
||||
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
|
||||
|
||||
(export gnc:register-report-create)
|
||||
(export gnc:payables-report-create)
|
||||
(export gnc:receivables-report-create)
|
||||
(export gnc:register-report-hook)
|
||||
|
||||
(require 'hash-table)
|
||||
(require 'record)
|
||||
|
||||
(define gnc:*register-report-hash* (make-hash-table 23))
|
||||
|
||||
;; Keep a hash-table of records, keyed off the account type. Each
|
||||
;; record contains a function pointer for that account-type with split
|
||||
;; or without split. If no function is found, then run the 'default'
|
||||
;; function
|
||||
|
||||
(define acct-type-info (make-record-type "AcctTypeInfo" '(split non-split)))
|
||||
|
||||
(define make-acct-type-private
|
||||
(record-constructor acct-type-info '(split non-split)))
|
||||
|
||||
(define (make-acct-type)
|
||||
(make-acct-type-private #f #f))
|
||||
|
||||
(define get-split
|
||||
(record-accessor acct-type-info 'split))
|
||||
|
||||
(define set-split
|
||||
(record-modifier acct-type-info 'split))
|
||||
|
||||
(define get-non-split
|
||||
(record-accessor acct-type-info 'non-split))
|
||||
|
||||
(define set-non-split
|
||||
(record-modifier acct-type-info 'non-split))
|
||||
|
||||
(define (gnc:register-report-hook acct-type split? create-fcn)
|
||||
(let ((type-info (hash-ref gnc:*register-report-hash* acct-type)))
|
||||
|
||||
(if (not type-info)
|
||||
(set! type-info (make-acct-type)))
|
||||
|
||||
(if split?
|
||||
(set-split type-info create-fcn)
|
||||
(set-non-split type-info create-fcn))
|
||||
|
||||
(hash-set! gnc:*register-report-hash* acct-type type-info)))
|
||||
|
||||
(define (lookup-register-report acct-type split)
|
||||
(let ((type-info (hash-ref gnc:*register-report-hash* acct-type)))
|
||||
(gnc:debug "acct-type: " acct-type)
|
||||
(gnc:debug "ref: " type-info)
|
||||
(gnc:debug "hash: " gnc:*register-report-hash*)
|
||||
(gnc:debug "split: " split)
|
||||
(if type-info
|
||||
(if split
|
||||
(begin (gnc:debug "get-split...") (get-split type-info))
|
||||
(begin (gnc:debug "get-non-split...") (get-non-split type-info)))
|
||||
#f)))
|
||||
|
||||
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
|
||||
(use-modules (gnucash report account-piecharts))
|
||||
(use-modules (gnucash report account-summary))
|
||||
(use-modules (gnucash report average-balance))
|
||||
@ -26,6 +80,17 @@
|
||||
(use-modules (gnucash report register))
|
||||
(use-modules (gnucash report transaction))
|
||||
|
||||
(define gnc:register-report-create gnc:register-report-create-internal)
|
||||
(define gnc:payables-report-create gnc:payables-report-create-internal)
|
||||
(define gnc:receivables-report-create gnc:receivables-report-create-internal)
|
||||
(use-modules (gnucash gnc-module))
|
||||
(gnc:module-load "gnucash/engine" 0)
|
||||
|
||||
(define (gnc:register-report-create account split query journal? double?
|
||||
title debit-string credit-string)
|
||||
(let* ((acct-type-code (gnc:account-get-type account))
|
||||
(acct-type (gw:enum-<gnc:AccountType>-val->sym acct-type-code #f))
|
||||
(create-fcn (lookup-register-report acct-type split)))
|
||||
(gnc:debug "create-fcn: " create-fcn)
|
||||
(if create-fcn
|
||||
(create-fcn account split query journal? double? title
|
||||
debit-string credit-string)
|
||||
(gnc:register-report-create-internal #f query journal? double? title
|
||||
debit-string credit-string))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user