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

* moved receivable and payable aging reports to business-reports;

Browse Source 
added "links" to the company, invoices, and company-report.
	Create a "Business Reports" menu item under "Reports" and put the
	business reports there.  This required a new startup hook to allow
	dynamic creation of the Report Menu.  Change the aging reports to
	use Invoices and Lots instead of the transaction description to
	differentiate actual companies.

	* dialog-invoice: publish the function to open a company-report

	* business-urls: hooks into gnc-html for business objects.
	Initialize at module load-time.  wrap the business url types.

	* business-core: create gnc:owner-from-split which is used by a
	bunch of the business reports.  wrap gncOwnerCopy().

	* fix the "Create Test Data" extension


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7080 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins 2002-07-04 02:39:19 +00:00
parent f6e2119afa
commit 7347c8c378
22 changed files with 742 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
ChangeLog
View File

@ -1,3 +1,23 @@
2002-07-03 Derek Atkins <derek@ihtfp.com>
* moved receivable and payable aging reports to business-reports;
added "links" to the company, invoices, and company-report.
Create a "Business Reports" menu item under "Reports" and put the
business reports there. This required a new startup hook to allow
dynamic creation of the Report Menu. Change the aging reports to
use Invoices and Lots instead of the transaction description to
differentiate actual companies.
* dialog-invoice: publish the function to open a company-report
* business-urls: hooks into gnc-html for business objects.
Initialize at module load-time. wrap the business url types.
* business-core: create gnc:owner-from-split which is used by a
bunch of the business reports. wrap gncOwnerCopy().
* fix the "Create Test Data" extension
2002-07-03 Christian Stimming <stimming@tuhh.de>
* src/gnome/druid-hierarchy.c (gnc_get_ea_locale_dir): If current

1
src/app-utils/app-utils.scm
View File

@ -233,6 +233,7 @@
(export gnc:*book-opened-hook*)
(export gnc:*new-book-hook*)
(export gnc:*book-closed-hook*)
(export gnc:*report-hook*)
;; simple-obj
(export make-simple-class)

5
src/app-utils/hooks.scm
View File

@ -108,6 +108,11 @@
'book-closed-hook
"Run before file close. Hook args: book URL"))
(define gnc:*report-hook*
(gnc:hook-define
'report-hook
"Run just before the reports are pushed into the menus. Hook args: ()"))
;;(let ((hook (gnc:hook-lookup 'startup-hook)))
;; (display (gnc:hook-name-get hook))
;; (newline)

38
src/business/business-core/business-core.scm
View File

@ -1,5 +1,7 @@
(define-module (gnucash business-core))
(use-modules (g-wrapped gw-business-core))
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/engine" 0)
; return a string which is basically:
; name \n Attn: contact \n addr1 \n addr2 \n addr3 \n addr4
@ -93,12 +95,42 @@
(gnc:owner-get-id (gnc:job-get-owner (gnc:owner-get-job owner))))
(else ""))))
;; This MUST match the definitions in gncEntry.h or you'll be in trouble!
(define (gnc:entry-type-percent-p type)
(or (= type 1) (= type 3)))
(define (gnc:entry-type-percent-p type-val)
(let ((type (gw:enum-<gnc:GncAmountType>-val->sym type #f)))
(equal? type 'gnc-amount-type-percent)))
(define (gnc:owner-from-split split result-owner)
(let* ((trans (gnc:split-get-parent split))
(invoice (gnc:invoice-get-invoice-from-txn trans))
(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)))
(gnc:owner-copy-into-owner (gnc:owner-get-end-owner owner) result-owner)
(gnc:owner-destroy temp-owner)
result-owner))
(export gnc:owner-get-name)
(export gnc:owner-get-address)
(export gnc:owner-get-address-dep)
(export gnc:owner-get-owner-id)
(export gnc:entry-type-percent-p)
(export gnc:owner-from-split)

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

@ -925,6 +925,14 @@
'((<gnc:GncOwner*> owner))
"Return the GUID of this owner")
(gw:wrap-function
ws
'gnc:owner-copy-into-owner
'<gw:void>
"gncOwnerCopy"
'((<gnc:GncOwner*> src-owner) (<gnc:GncOwner*> dest-owner))
"Copy the src-owner to the dest-owner")
;;
;; gncVendor.h
;;

2
src/business/business-gnome/Makefile.am
View File

@ -28,6 +28,7 @@ AM_CFLAGS = \
libgncmod_business_gnome_la_SOURCES = \
businessmod-gnome.c \
business-urls.c \
business-utils.c \
dialog-billterms.c \
dialog-customer.c \
@ -42,6 +43,7 @@ libgncmod_business_gnome_la_SOURCES = \
gnc-business-utils.c
noinst_HEADERS = \
business-urls.h \
business-utils.h \
dialog-billterms.h \
dialog-customer.h \

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

@ -193,12 +193,18 @@
(list top-level "")
(lambda ()
(gnc:tax-table-new (gnc:get-current-book)))))
(add-vendor-items)
(add-customer-items)
)
(define (business-report-function)
(gnc:add-extension
(gnc:make-menu gnc:menuname-business-reports
(list gnc:menuname-reports gnc:menuname-income-expense))))
(define (add-employee-extensions)
(let ((last-employee #f))
@ -228,25 +234,6 @@
(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")
@ -273,6 +260,17 @@
(load-from-path "gnucash/report/owner-report.scm")
(set-current-module m)))))
(define reload-receivable
(gnc:make-menu-item (N_ "Reload receivable report")
(N_ "Reload receivable report scheme file")
(list "Extensions" "")
(lambda ()
(let ((m (current-module)))
(load-from-path "gnucash/report/aging.scm")
(set-current-module m)
(load-from-path "gnucash/report/receivables.scm")
(set-current-module m)))))
(define init-data
(gnc:make-menu-item (N_ "Initialize Test Data")
(N_ "Initialize Test Data")
@ -307,7 +305,6 @@
;; Create the Invoice
(gnc:invoice-set-id invoice "000012")
(gnc:invoice-set-owner invoice owner)
(gnc:invoice-set-terms invoice "Net-30")
(gnc:invoice-set-date-opened
invoice (cons (current-time) 0))
(gnc:invoice-set-common-commodity
@ -356,14 +353,15 @@
(gnc:add-extension init-data)
(gnc:add-extension reload-receivable)
(gnc:add-extension reload-invoice)
(gnc:add-extension reload-owner)
(gnc:add-extension test-search)
(gnc:add-extension test-report)
(add-employee-extensions)
)
(gnc:hook-add-dangler gnc:*report-hook* business-report-function)
(gnc:hook-add-dangler gnc:*ui-startup-hook* add-business-items)
(gnc:hook-add-dangler gnc:*add-extension-hook* add-business-test)

321
src/business/business-gnome/business-urls.c Normal file
View File

@ -0,0 +1,321 @@
/*
* business-urls.c -- Initialize HTML for business code
*
* Written By: Derek Atkins <warlord@MIT.EDU>
* Copyright (C) 2001, 2002 Derek Atkins
*/
#include "config.h"
#include <gnome.h>
#include "gnc-html.h"
#include "gnc-ui-util.h"
#include "gnc-engine-util.h"
#include "gncCustomer.h"
#include "gncVendor.h"
#include "gncInvoice.h"
#include "business-urls.h"
#include "dialog-customer.h"
#include "dialog-vendor.h"
#include "dialog-invoice.h"
static gboolean
customerCB (const char *location, const char *label,
gboolean new_window, GNCURLResult * result)
{
g_return_val_if_fail (location != NULL, FALSE);
g_return_val_if_fail (result != NULL, FALSE);
result->load_to_stream = FALSE;
/* href="...:guid=<guid>" */
if (strncmp ("guid=", location, 5) == 0) {
GUID guid;
GNCIdType id_type;
GncCustomer *customer;
if (!string_to_guid (location + 5, &guid)) {
result->error_message = g_strdup_printf (_("Bad URL: %s"), location);
return FALSE;
}
id_type = xaccGUIDType (&guid, gnc_get_current_book ());
if (id_type == GNC_ID_NONE || !safe_strcmp (id_type, GNC_ID_NULL))
{
result->error_message = g_strdup_printf (_("No such entity: %s"),
location);
return FALSE;
}
else if (!safe_strcmp (id_type, GNC_CUSTOMER_MODULE_NAME))
{
customer = gncCustomerLookup (gnc_get_current_book (), &guid);
gnc_ui_customer_edit (customer);
}
else
{
result->error_message =
g_strdup_printf (_("Entity type does not match Customer: %s"),
location);
return FALSE;
}
}
else
{
result->error_message = g_strdup_printf (_("Badly formed URL %s"),
location);
return FALSE;
}
return TRUE;
}
static gboolean
vendorCB (const char *location, const char *label,
gboolean new_window, GNCURLResult * result)
{
g_return_val_if_fail (location != NULL, FALSE);
g_return_val_if_fail (result != NULL, FALSE);
result->load_to_stream = FALSE;
/* href="...:guid=<guid>" */
if (strncmp ("guid=", location, 5) == 0) {
GUID guid;
GNCIdType id_type;
GncVendor *vendor;
if (!string_to_guid (location + 5, &guid)) {
result->error_message = g_strdup_printf (_("Bad URL: %s"), location);
return FALSE;
}
id_type = xaccGUIDType (&guid, gnc_get_current_book ());
if (id_type == GNC_ID_NONE || !safe_strcmp (id_type, GNC_ID_NULL))
{
result->error_message = g_strdup_printf (_("No such entity: %s"),
location);
return FALSE;
}
else if (!safe_strcmp (id_type, GNC_VENDOR_MODULE_NAME))
{
vendor = gncVendorLookup (gnc_get_current_book (), &guid);
gnc_ui_vendor_edit (vendor);
}
else
{
result->error_message =
g_strdup_printf (_("Entity type does not match Vendor: %s"),
location);
return FALSE;
}
}
else
{
result->error_message = g_strdup_printf (_("Badly formed URL %s"),
location);
return FALSE;
}
return TRUE;
}
static gboolean
invoiceCB (const char *location, const char *label,
gboolean new_window, GNCURLResult * result)
{
g_return_val_if_fail (location != NULL, FALSE);
g_return_val_if_fail (result != NULL, FALSE);
result->load_to_stream = FALSE;
/* href="...:guid=<guid>" */
if (strncmp ("guid=", location, 5) == 0) {
GUID guid;
GNCIdType id_type;
GncInvoice *invoice;
if (!string_to_guid (location + 5, &guid)) {
result->error_message = g_strdup_printf (_("Bad URL: %s"), location);
return FALSE;
}
id_type = xaccGUIDType (&guid, gnc_get_current_book ());
if (id_type == GNC_ID_NONE || !safe_strcmp (id_type, GNC_ID_NULL))
{
result->error_message = g_strdup_printf (_("No such entity: %s"),
location);
return FALSE;
}
else if (!safe_strcmp (id_type, GNC_INVOICE_MODULE_NAME))
{
invoice = gncInvoiceLookup (gnc_get_current_book (), &guid);
gnc_ui_invoice_edit (invoice);
}
else
{
result->error_message =
g_strdup_printf (_("Entity type does not match Invoice: %s"),
location);
return FALSE;
}
}
else
{
result->error_message = g_strdup_printf (_("Badly formed URL %s"),
location);
return FALSE;
}
return TRUE;
}
static gboolean
ownerreportCB (const char *location, const char *label,
gboolean new_window, GNCURLResult * result)
{
const char *ownerptr;
const char *acctptr;
GUID guid;
GncOwner owner;
GNCIdType id_type;
GncOwnerType type;
char *etype = NULL;
Account *acc = NULL;
g_return_val_if_fail (location != NULL, FALSE);
g_return_val_if_fail (result != NULL, FALSE);
result->load_to_stream = FALSE;
/* href="...:owner=<owner-type>:guid=<guid>[&acct=<guid>]" */
acctptr = index (location, '&');
if (acctptr)
acctptr++;
if (strncmp ("owner=", location, 6) != 0) {
result->error_message = g_strdup_printf (_("Badly formed URL %s"),
location);
return FALSE;
}
memset (&owner, 0, sizeof (owner));
ownerptr = location+6;
switch (*ownerptr) {
case 'c':
type = GNC_OWNER_CUSTOMER;
break;
case 'v':
type = GNC_OWNER_VENDOR;
break;
default:
result->error_message = g_strdup_printf (_("Bad URL: %s"), location);
return FALSE;
}
if (!string_to_guid (ownerptr+2, &guid)) {
result->error_message = g_strdup_printf (_("Bad URL: %s"), location);
return FALSE;
}
id_type = xaccGUIDType (&guid, gnc_get_current_book ());
if (id_type == GNC_ID_NONE || !safe_strcmp (id_type, GNC_ID_NULL))
{
result->error_message = g_strdup_printf (_("No such owner entity: %s"),
location);
return FALSE;
}
switch (type) {
case GNC_OWNER_CUSTOMER:
if (!safe_strcmp (id_type, GNC_CUSTOMER_MODULE_NAME))
gncOwnerInitCustomer (&owner,
gncCustomerLookup (gnc_get_current_book (),
&guid));
etype = "Customer";
break;
case GNC_OWNER_VENDOR:
if (!safe_strcmp (id_type, GNC_VENDOR_MODULE_NAME))
gncOwnerInitVendor (&owner,
gncVendorLookup (gnc_get_current_book (),
&guid));
etype = "Vendor";
break;
default:
etype = "OTHER";
}
if (owner.owner.undefined == NULL)
{
result->error_message =
g_strdup_printf (_("Entity type does not match %s: %s"),
etype, location);
return FALSE;
}
/* Deal with acctptr, if it exists */
if (acctptr)
{
if (strncmp ("acct=", acctptr, 5) != 0)
{
result->error_message = g_strdup_printf (_("Bad URL %s"), location);
return FALSE;
}
if (!string_to_guid (acctptr+5, &guid)) {
result->error_message = g_strdup_printf (_("Bad URL: %s"), location);
return FALSE;
}
id_type = xaccGUIDType (&guid, gnc_get_current_book ());
if (id_type == GNC_ID_NONE || !safe_strcmp (id_type, GNC_ID_NULL))
{
result->error_message = g_strdup_printf (_("No such Account entity: %s"),
location);
return FALSE;
}
if (safe_strcmp (id_type, GNC_ID_ACCOUNT) != 0)
{
result->error_message =
g_strdup_printf (_("Entity is not Account entity: %s"), location);
return FALSE;
}
acc = xaccAccountLookup (&guid, gnc_get_current_book ());
}
/* Ok, let's run this report */
gnc_business_call_owner_report (&owner, acc);
return TRUE;
}
void
gnc_business_urls_initialize (void)
{
int i;
static struct {
URLType urltype;
char * protocol;
GncHTMLUrlCB handler;
} types[] = {
{ GNC_CUSTOMER_MODULE_NAME, GNC_CUSTOMER_MODULE_NAME, customerCB },
{ GNC_VENDOR_MODULE_NAME, GNC_VENDOR_MODULE_NAME, vendorCB },
{ GNC_INVOICE_MODULE_NAME, GNC_INVOICE_MODULE_NAME, invoiceCB },
{ URL_TYPE_OWNERREPORT, "gnc-ownerreport", ownerreportCB },
{ NULL, NULL }
};
for (i = 0; types[i].urltype; i++)
gnc_html_register_urltype (types[i].urltype, types[i].protocol);
for (i = 0; types[i].urltype; i++)
if (types[i].handler)
gnc_html_register_url_handler (types[i].urltype, types[i].handler);
}

15
src/business/business-gnome/business-urls.h Normal file
View File

@ -0,0 +1,15 @@
/*
* business-urls.h -- Initialize HTML for business code
*
* Written By: Derek Atkins <warlord@MIT.EDU>
* Copyright (C) 2001
*/
#ifndef GNC_BUSINESS_URLS_H_
#define GNC_BUSINESS_URLS_H_
#define URL_TYPE_OWNERREPORT "owner-report"
void gnc_business_urls_initialize (void);
#endif /* GNC_BUSINESS_URLS_H_ */

2
src/business/business-gnome/businessmod-gnome.c
View File

@ -16,6 +16,7 @@
#include "search-core-type.h"
#include "search-owner.h"
#include "gncOwner.h"
#include "business-urls.h"
/* version of the gnc module system interface we require */
int libgncmod_business_gnome_LTX_gnc_module_system_interface = 0;
@ -76,6 +77,7 @@ libgncmod_business_gnome_LTX_gnc_module_init(int refcount)
/* Register the Owner search type */
gnc_search_core_register_type (GNC_OWNER_MODULE_NAME,
(GNCSearchCoreNew) gnc_search_owner_new);
gnc_business_urls_initialize ();
}
return TRUE;

26
src/business/business-gnome/dialog-invoice.c
View File

@ -577,27 +577,37 @@ void gnc_invoice_window_new_invoice_cb (GtkWidget *widget, gpointer data)
}
}
void gnc_invoice_window_report_owner_cb (GtkWidget *widget, gpointer data)
void gnc_business_call_owner_report (GncOwner *owner, Account *acc)
{
InvoiceWindow *iw = data;
int id;
SCM qtype;
SCM args;
SCM func;
SCM arg;
g_return_if_fail (owner);
args = SCM_EOL;
func = gh_eval_str ("gnc:owner-report-create");
g_return_if_fail (gh_procedure_p (func));
if (acc) {
qtype = gh_eval_str("<gnc:Account*>");
g_return_if_fail (qtype != SCM_UNDEFINED);
arg = gw_wcp_assimilate_ptr (acc, qtype);
g_return_if_fail (arg != SCM_UNDEFINED);
args = gh_cons (arg, args);
} else {
args = gh_cons (SCM_BOOL_F, args);
}
qtype = gh_eval_str("<gnc:GncOwner*>");
g_return_if_fail (qtype != SCM_UNDEFINED);
arg = gw_wcp_assimilate_ptr (&iw->owner, qtype);
arg = gw_wcp_assimilate_ptr (owner, qtype);
g_return_if_fail (arg != SCM_UNDEFINED);
args = gh_cons (SCM_BOOL_F, args);
args = gh_cons (arg, args);
/* Apply the function to the args */
@ -609,6 +619,12 @@ void gnc_invoice_window_report_owner_cb (GtkWidget *widget, gpointer data)
reportWindow (id);
}
void gnc_invoice_window_report_owner_cb (GtkWidget *widget, gpointer data)
{
InvoiceWindow *iw = data;
gnc_business_call_owner_report (&iw->owner, NULL);
}
void gnc_invoice_window_taxtable_cb (GtkWidget *widget, gpointer data)
{
InvoiceWindow *iw = data;

2
src/business/business-gnome/dialog-invoice.h
View File

@ -30,4 +30,6 @@ GNCSearchWindow * gnc_invoice_search (GncInvoice *start, GncOwner *owner, GNCBoo
GNCSearchWindow * gnc_invoice_search_select (gpointer start, gpointer book);
GNCSearchWindow * gnc_invoice_search_edit (gpointer start, gpointer book);
void gnc_business_call_owner_report (GncOwner *owner, Account *acc);
#endif /* GNC_DIALOG_INVOICE_H_ */

14
src/business/business-gnome/gw-business-gnome-spec.scm
View File

@ -32,6 +32,7 @@
ws
(lambda (wrapset client-wrapset)
(list
"#include <business-urls.h>\n"
"#include <dialog-billterms.h>\n"
"#include <dialog-customer.h>\n"
"#include <dialog-employee.h>\n"
@ -49,6 +50,19 @@
'()
(gw:inline-scheme '(use-modules (gnucash business-gnome))))))
;;
;; Business URL Types
;;
(gw:wrap-value ws 'gnc:url-type-customer '<gnc:url-type>
"GNC_CUSTOMER_MODULE_NAME")
(gw:wrap-value ws 'gnc:url-type-vendor '<gnc:url-type>
"GNC_VENDOR_MODULE_NAME")
(gw:wrap-value ws 'gnc:url-type-invoice '<gnc:url-type>
"GNC_INVOICE_MODULE_NAME")
(gw:wrap-value ws 'gnc:url-type-ownerreport '<gnc:url-type>
"URL_TYPE_OWNERREPORT")
;;
;; dialog-billterms.h
;;

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

@ -9,6 +9,9 @@ noinst_DATA = .scm-links
gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report
gncscmmod_DATA = \
business-reports.scm \
aging.scm \
payables.scm \
receivables.scm \
invoice.scm \
owner-report.scm

145
src/report/standard-reports/aging.scm → src/business/business-reports/aging.scm
View File

@ -33,10 +33,11 @@
(require 'record)
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/business-core" 0)
(use-modules (gnucash report business-reports))
(define sect-acc (N_ "Accounts"))
(define optname-to-date (N_ "To"))
(define optname-use-description (N_ "Use Description?"))
(define optname-sort-by (N_ "Sort By"))
(define optname-sort-order (N_ "Sort Order"))
(define optname-report-currency (N_ "Report's currency"))
@ -58,21 +59,25 @@
(define company-info (make-record-type "ComanyInfo"
'(currency
bucket-vector
overpayment)))
overpayment
owner-obj)))
(define num-buckets 4)
(define (new-bucket-vector)
(make-vector num-buckets (gnc:numeric-zero)))
(define make-company-private
(record-constructor company-info '(currency bucket-vector overpayment)))
(record-constructor company-info '(currency bucket-vector overpayment owner-obj)))
(define (make-company currency)
(make-company-private currency (new-bucket-vector) (gnc:numeric-zero)))
(define (make-company currency owner-obj)
(make-company-private currency (new-bucket-vector) (gnc:numeric-zero) owner-obj))
(define company-get-currency
(record-accessor company-info 'currency))
(define company-get-owner-obj
(record-accessor company-info 'owner-obj))
(define company-get-buckets
(record-accessor company-info 'bucket-vector))
@ -159,33 +164,36 @@
;; a new company record in the hash
(define (update-company-hash hash split bucket-intervals
use-description? reverse?)
reverse?)
(let* ((transaction (gnc:split-get-parent split))
(company-name (if use-description?
(gnc:transaction-get-description transaction)
(gnc:split-get-memo split)))
(temp-owner (gnc:owner-create))
(owner (gnc:owner-from-split split temp-owner))
(guid (gnc:owner-get-guid owner))
(this-currency (gnc:transaction-get-currency transaction))
(value (gnc:split-get-value split))
(this-date (gnc:transaction-get-date-posted transaction))
(company-info (hash-ref hash company-name)))
(company-info (hash-ref hash guid)))
(gnc:debug "update-company-hash called")
(gnc:debug "company-name" company-name)
(gnc:debug "guid" guid)
(gnc:debug "split-value" value)
(if reverse? (set! value (gnc:numeric-neg value)))
(if company-info
;; if it's an existing company, first check currencies match
(if (not (gnc:commodity-equiv? this-currency
(company-get-currency company-info)))
(cons #f (sprintf (_ "Transactions relating to company %d contain \
;; if it's an existing company, destroy the temp owner and
;; then make sure the currencies match
(begin
(gnc:owner-destroy temp-owner)
(if (not (gnc:commodity-equiv? this-currency
(company-get-currency company-info)))
(cons #f (sprintf (_ "Transactions relating to company %d contain \
more than one currency. This report is not designed to cope with this possibility.")))
(begin
(gnc:debug "it's an old company")
(if (gnc:numeric-negative-p value)
(process-invoice company-info (gnc:numeric-neg value) bucket-intervals this-date)
(process-payment company-info value))
(hash-set! hash company-name company-info)
(cons #t company-name)))
(begin
(gnc:debug "it's an old company")
(if (gnc:numeric-negative-p value)
(process-invoice company-info (gnc:numeric-neg value) bucket-intervals this-date)
(process-payment company-info value))
(hash-set! hash guid company-info)
(cons #t guid))))
;; if it's a new company
(begin
@ -193,10 +201,11 @@ more than one currency. This report is not designed to cope with this possibili
(if (gnc:numeric-negative-p value) ;; if it's a new debt
;; if not ignore it
;;; XXX: is this right ?
(let ((new-company (make-company this-currency)))
(let ((new-company (make-company this-currency owner)))
(process-invoice new-company (gnc:numeric-neg value) bucket-intervals this-date)
(hash-set! hash company-name new-company)))
(cons #t company-name)))))
(hash-set! hash guid new-company))
(gnc:owner-destroy temp-owner))
(cons #t guid)))))
;; get the total debt from the buckets
@ -319,24 +328,15 @@ more than one currency. This report is not designed to cope with this possibili
(vector 'increasing (N_ "Increasing") (N_ "0 -> $999,999.99, A->Z"))
(vector 'decreasing (N_ "Decreasing") (N_ "$999,999.99 -> $0, Z->A")))))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-general
optname-use-description
"h"
(N_ "Use the description to identify individual companies.\
If false, use split memo")
#t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-general
optname-multicurrency-totals
"i"
(N_ "Show multi-currency totals. If not selected, convert all\
optname-multicurrency-totals
"i"
(N_ "Show multi-currency totals. If not selected, convert all\
totals to report currency")
#f))
#f))
(gnc:options-set-default-section options "General")
options))
@ -349,15 +349,19 @@ totals to report currency")
(define (aging-renderer report-obj account reverse?)
(define (get-name a)
(let* ((owner (company-get-owner-obj (cdr a))))
(gnc:owner-get-name owner)))
;; Predicates for sorting the companys once the data has been collected
;; Format: (cons 'sort-key (cons 'increasing-pred 'decreasing-pred))
(define sort-preds
(list
(cons 'name (cons (lambda (a b)
(string<? (car a) (car b)))
(string<? (get-name a) (get-name b)))
(lambda (a b)
(string>? (car a) (car b)))))
(string>? (get-name a) (get-name b)))))
(cons 'total (cons (lambda (a b)
(< (compare-total a b) 0))
(lambda (a b)
@ -444,7 +448,6 @@ totals to report currency")
(append (reverse monetised-buckets)
(list (gnc:make-gnc-monetary currency running-total)))))
;; convert the collectors to the right output format
(define (convert-collectors collector-list report-currency
@ -477,15 +480,11 @@ totals to report currency")
(let* ((companys (make-hash-table 23))
(report-title (string-append
(op-value gnc:pagename-general gnc:optname-reportname)
": "
(gnc:account-get-name account)))
(report-title (op-value gnc:pagename-general gnc:optname-reportname))
;; document will be the HTML document that we return.
(report-date (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(op-value gnc:pagename-general (N_ "To")))))
(use-description? (op-value gnc:pagename-general optname-use-description))
(interval-vec (list->vector (make-interval-list report-date)))
(sort-pred (get-sort-pred
(op-value gnc:pagename-general optname-sort-by)
@ -501,6 +500,16 @@ totals to report currency")
(company-list '())
(document (gnc:make-html-document)))
; (gnc:debug "Account: " account)
(if account
(set! report-title (gnc:html-markup
"!"
report-title
": "
(gnc:html-markup-anchor
(gnc:account-anchor-text account)
(gnc:account-get-name account)))))
(gnc:html-document-set-title! document report-title)
(gnc:html-table-set-col-headers! table heading-list)
@ -516,7 +525,6 @@ totals to report currency")
(update-company-hash companys
split
interval-vec
use-description?
reverse?))
splits)
; (gnc:debug "companys" companys)
@ -532,14 +540,39 @@ totals to report currency")
;; build the table
(for-each (lambda (company-list-entry)
(let ((monetary-list (convert-to-monetary-list
(company-get-buckets
(cdr company-list-entry))
(company-get-currency
(cdr company-list-entry)))))
(add-to-column-totals total-collector-list monetary-list)
(let* ((monetary-list (convert-to-monetary-list
(company-get-buckets
(cdr company-list-entry))
(company-get-currency
(cdr company-list-entry))))
(owner (company-get-owner-obj
(cdr company-list-entry)))
(company-name (gnc:owner-get-name owner)))
(add-to-column-totals total-collector-list
monetary-list)
(let* ((ml (reverse monetary-list))
(total (car ml))
(rest (cdr ml)))
(set! monetary-list
(reverse
(cons
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:owner-report-text owner account)
total))
rest))))
(gnc:html-table-append-row!
table (cons (car company-list-entry) monetary-list))))
table (cons
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:owner-anchor-text owner)
company-name))
monetary-list))
(gnc:owner-destroy owner)))
company-list)
;; add the totals

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

@ -8,12 +8,72 @@
(define-module (gnucash report business-reports))
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/report/standard-reports" 0)
(gnc:module-load "gnucash/business-gnome" 0)
(export gnc:invoice-report-create)
(define gnc:menuname-business-reports (N_ "Business Reports"))
(define (guid-ref type guid)
(gnc:html-build-url type (string-append "guid=" guid) #f))
(define (gnc:customer-anchor-text customer)
(guid-ref gnc:url-type-customer (gnc:customer-get-guid customer)))
(define (gnc:job-anchor-text job)
(guid-ref gnc:url-type-job (gnc:job-get-guid job)))
(define (gnc:vendor-anchor-text vendor)
(guid-ref gnc:url-type-vendor (gnc:vendor-get-guid vendor)))
(define (gnc:invoice-anchor-text invoice)
(guid-ref gnc:url-type-invoice (gnc:invoice-get-guid invoice)))
(define (gnc:owner-anchor-text owner)
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
(gnc:owner-get-type (gnc:owner-get-end-owner owner)) #f)))
(case type
((gnc-owner-customer)
(gnc:customer-anchor-text (gnc:owner-get-customer owner)))
((gnc-owner-vendor)
(gnc:vendor-anchor-text (gnc:owner-get-vendor owner)))
((gnc-owner-job)
(gnc:job-anchor-text (gnc:owner-get-job owner)))
(else
""))))
(define (gnc:owner-report-text owner acc)
(let* ((end-owner (gnc:owner-get-end-owner owner))
(type (gw:enum-<gnc:GncOwnerType>-val->sym
(gnc:owner-get-type end-owner) #f))
(ref #f))
(case type
((gnc-owner-customer)
(set! ref "owner=c:"))
((gnc-owner-vendor)
(set! ref "owner=v:")))
(if ref
(begin
(set! ref (string-append ref (gnc:owner-get-guid end-owner)))
(if acc
(set! ref (string-append ref "&acct="
(gnc:account-get-guid acc))))
(gnc:html-build-url gnc:url-type-ownerreport ref #f))
ref)))
(export gnc:menuname-business-reports)
(use-modules (gnucash report invoice))
(use-modules (gnucash report owner-report))
(use-modules (gnucash report payables))
(use-modules (gnucash report receivables))
(define gnc:invoice-report-create gnc:invoice-report-create-internal)
(export gnc:owner-report-create)
(export gnc:invoice-report-create gnc:owner-report-create
gnc:customer-anchor-text gnc:job-anchor-text gnc:vendor-anchor-text
gnc:invoice-anchor-text gnc:owner-anchor-text gnc:owner-report-text)

228
src/business/business-reports/owner-report.scm
View File

@ -157,10 +157,17 @@
(date (gnc:transaction-get-date-posted txn))
(value (gnc:transaction-get-account-value txn acc))
(split (gnc:transaction-get-split txn 0))
(invoice (gnc:invoice-get-invoice-from-txn txn))
(currency (gnc:transaction-get-currency txn))
(type-str
(cond
((equal? type gnc:transaction-type-invoice) (N_ "Invoice"))
((equal? type gnc:transaction-type-invoice)
(if invoice
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:invoice-anchor-text invoice)
(N_ "Invoice")))
(N_ "Invoice")))
((equal? type gnc:transaction-type-payment) (N_ "Payment, thank you"))
(else (N_ "UNK"))))
(row-contents '()))
@ -239,7 +246,7 @@
table))
(define (options-generator)
(define (options-generator acct-type-list)
(define gnc:*report-options* (gnc:new-options))
@ -251,11 +258,8 @@
(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:make-account-list-limited-option "Account" "Account" "" ""
(lambda () '()) #f #f acct-type-list))
(gnc:options-add-report-date!
gnc:*report-options* gnc:pagename-general
@ -296,6 +300,12 @@
gnc:*report-options*)
(define (customer-options-generator)
(options-generator '(receivable)))
(define (vendor-options-generator)
(options-generator '(payable)))
(define (string-expand string character replace-string)
(define (car-line chars)
(take-while (lambda (c) (not (eqv? c character))) chars))
@ -314,6 +324,28 @@
(line-helper rest)))))
(line-helper (string->list string)))
(define (setup-query q owner account)
(let* ((guid (gnc:owner-get-guid (gnc:owner-get-end-owner owner))))
(gnc:query-add-guid-match
q
(list gnc:split-trans gnc:invoice-from-txn gnc:invoice-owner
gnc:owner-parentg)
guid 'query-or)
(gnc:query-add-guid-match
q
(list gnc:split-lot gnc:owner-from-lot gnc:owner-parentg)
guid 'query-or)
(gnc:query-add-guid-match
q
(list gnc:split-lot gnc:invoice-from-lot gnc:invoice-owner
gnc:owner-parentg)
guid 'query-or)
(gnc:query-add-single-account-match q account 'query-and)
(gnc:query-set-book q (gnc:get-current-book))
q))
(define (make-owner-table owner)
(let ((table (gnc:make-html-table)))
(gnc:html-table-set-style!
@ -391,59 +423,75 @@
(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")))
(query (gnc:malloc-query))
(account-list (opt-val "Account" "Account"))
(account #f)
(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 (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"))))
(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 (not (null? account-list))
(set! account (car account-list)))
(if owner
(begin
(setup-query query owner account)
(let ((type (gw:enum-<gnc:GncOwnerType>-val->sym
(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"))))
(set! title (gnc:html-markup
"!"
type-str
(N_ " Report: ")
(gnc:html-markup-anchor
(gnc:owner-anchor-text owner)
(gnc:owner-get-name owner)))))
(if account
(begin
(set! table (make-txn-table (gnc:report-options report-obj)
query account report-date))
(gnc:html-table-set-style!
table "table"
'attribute (list "border" 1)
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 4)))
(set! table (gnc:make-html-text "No Valid Account Selected")))
(gnc:html-document-set-title! document title)
(gnc:html-document-add-object!
document
(make-myname-table (opt-val "Display" "Today Date Format")))
(gnc:html-document-add-object!
document
(make-owner-table owner))
(make-break! document)
(make-break! document)
(gnc:html-document-add-object! document table))
;; else....
(gnc:html-document-add-object!
document
(make-owner-table owner)))
(make-break! document)
(make-break! document)
(gnc:html-document-add-object! document table)
(gnc:make-html-text
"No Valid Company Selected")))
(gnc:free-query query)
document))
(define (find-first-account type)
@ -483,101 +531,55 @@
(gnc:define-report
'version 1
'name (N_ "Customer Report")
'options-generator options-generator
'options-generator customer-options-generator
'renderer reg-renderer
'in-menu? #f)
(gnc:define-report
'version 1
'name (N_ "Vendor Report")
'options-generator options-generator
'options-generator vendor-options-generator
'renderer reg-renderer
'in-menu? #f)
(define (owner-report-create-internal report-name owner query account)
(define (owner-report-create-internal report-name owner 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")))
(account-op (gnc:lookup-option options "Account" "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 report-name options)))
(define (owner-report-create owner query account)
(define (owner-report-create owner 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))
(owner-report-create-internal "Customer Report" owner account))
((gnc-owner-vendor)
(owner-report-create-internal "Vendor Report" owner query account)))
))
(owner-report-create-internal "Vendor Report" owner account))
(else #f))))
(define (gnc:owner-report-create owner account)
(let* ((q (gnc:malloc-query))
(guid (gnc:owner-get-guid (gnc:owner-get-end-owner owner))))
; Figure out an account to use if nothing exists here.
(if (not account)
(set! account (find-first-account-for-owner owner)))
(gnc:query-add-guid-match
q
(list gnc:split-trans gnc:invoice-from-txn gnc:invoice-owner
gnc:owner-parentg)
guid 'query-or)
(gnc:query-add-guid-match
q
(list gnc:split-lot gnc:owner-from-lot gnc:owner-parentg)
guid 'query-or)
(gnc:query-add-guid-match
q
(list gnc:split-lot gnc:invoice-from-lot gnc:invoice-owner
gnc:owner-parentg)
guid 'query-or)
(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:free-query q)
res)))
; Figure out an account to use if nothing exists here.
(if (not account)
(set! account (find-first-account-for-owner owner)))
(owner-report-create owner 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))
(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)))
(let ((res (gnc:owner-report-create owner account)))
(gnc:owner-destroy temp-owner)
res)))
(let* ((temp-owner (gnc:owner-create))
(owner (gnc:owner-from-split split temp-owner))
(res (gnc:owner-report-create owner account)))
(gnc:owner-destroy temp-owner)
res))
(gnc:register-report-hook 'receivable #t
gnc:owner-report-create-internal)

2
src/report/standard-reports/payables.scm → src/business/business-reports/payables.scm
View File

@ -29,6 +29,7 @@
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/business-gnome" 0)
(use-modules (gnucash report aging))
(use-modules (gnucash report standard-reports))
@ -91,6 +92,7 @@
(gnc:define-report
'version 1
'name (N_ "Payable Aging")
'menu-path (list gnc:menuname-business-reports)
'options-generator options-generator
'renderer payables-renderer
'in-menu? #t)

2
src/report/standard-reports/receivables.scm → src/business/business-reports/receivables.scm
View File

@ -29,6 +29,7 @@
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/business-gnome" 0)
(use-modules (gnucash report aging))
(use-modules (gnucash report standard-reports))
@ -94,6 +95,7 @@
(gnc:define-report
'version 1
'name (N_ "Receivable Aging")
'menu-path (list gnc:menuname-business-reports)
'options-generator options-generator
'renderer receivables-renderer
'in-menu? #t)

3
src/report/report-gnome/report-gnome.scm
View File

@ -101,5 +101,8 @@
(gnc:add-extension asset-liability-menu)
(gnc:add-extension utility-menu)
;; run report-hook danglers
(gnc:hook-run-danglers gnc:*report-hook*)
;; push reports (new items added on top of menu)
(gnc:add-report-template-menu-items))

3
src/report/standard-reports/Makefile.am
View File

@ -21,16 +21,13 @@ gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report/
gncscmmod_DATA = \
account-piecharts.scm \
account-summary.scm \
aging.scm \
average-balance.scm \
balance-sheet.scm \
category-barchart.scm \
net-barchart.scm \
payables.scm \
pnl.scm \
portfolio.scm \
price-scatter.scm \
receivables.scm \
register.scm \
standard-reports.scm \
transaction.scm

2
src/report/standard-reports/standard-reports.scm
View File

@ -75,8 +75,6 @@
(use-modules (gnucash report pnl))
(use-modules (gnucash report portfolio))
(use-modules (gnucash report price-scatter))
(use-modules (gnucash report payables))
(use-modules (gnucash report receivables))
(use-modules (gnucash report register))
(use-modules (gnucash report transaction))