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

Hook the payables and receivables reports into the window register

Browse Source 
call them when viewing the appropriate accounts


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@6897 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins 2002-05-23 17:05:47 +00:00
parent 0b360f29ea
commit 29b4ed62a0
5 changed files with 140 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
src/gnome/window-register.c
View File

@ -3208,6 +3208,7 @@ static int
report_helper (RegWindow *regData, Query *query)
{
SplitRegister *reg = gnc_ledger_display_get_split_register (regData->ledger);
Account *account;
char *str;
SCM qtype;
SCM args;
@ -3216,44 +3217,71 @@ report_helper (RegWindow *regData, Query *query)
args = SCM_EOL;
/* 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);
switch (reg->type) {
case PAYABLE_REGISTER:
case RECEIVABLE_REGISTER:
g_return_val_if_fail (query == NULL, -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);
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);
str = gnc_reg_get_name (regData, FALSE);
arg = gh_str02scm (str);
args = gh_cons (arg, args);
g_free (str);
qtype = gh_eval_str("<gnc:Account*>");
g_return_val_if_fail (qtype != SCM_UNDEFINED, -1);
arg = gh_bool2scm (reg->use_double_line);
args = gh_cons (arg, args);
account = gnc_ledger_display_leader (regData->ledger);
arg = gh_bool2scm (reg->style == REG_STYLE_JOURNAL);
args = gh_cons (arg, args);
arg = gw_wcp_assimilate_ptr (account, qtype);
args = gh_cons (arg, args);
g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
qtype = gh_eval_str("<gnc:Query*>");
g_return_val_if_fail (qtype != SCM_UNDEFINED, -1);
break;
if (!query)
{
query = gnc_ledger_display_get_query (regData->ledger);
g_return_val_if_fail (query != NULL, -1);
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;
}
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);
func = gh_eval_str ("gnc:register-report-create");
g_return_val_if_fail (gh_procedure_p (func), -1);
/* Apply the function to the args */
arg = gh_apply (func, args);
g_return_val_if_fail (gh_exact_p (arg), -1);

6
src/report/standard-reports/aging.scm
View File

@ -475,8 +475,10 @@ totals to report currency")
(let* ((companys (make-hash-table 23))
(report-title (op-value gnc:pagename-general
gnc:optname-reportname))
(report-title (string-append
(op-value gnc:pagename-general gnc:optname-reportname)
": "
(gnc:account-get-name account)))
;; document will be the HTML document that we return.
(report-date (gnc:timepair-end-day-time
(gnc:date-option-absolute-time

110
src/report/standard-reports/payables.scm
View File

@ -32,8 +32,7 @@
(use-modules (gnucash report aging))
(define opt-pay-acc (N_ "Payables Account"))
(define sect-acc (N_ "Accounts"))
(define this-acc "this-account")
(define (options-generator)
(let* ((options (gnc:new-options))
@ -42,62 +41,28 @@
(gnc:register-option options new-option))))
(add-option
(gnc:make-account-list-option
sect-acc opt-pay-acc
"a" (N_ "Account where payables are stored.")
;; FIXME: Have a global preference for the payables account??
;; default-getter
(lambda ()
(define (find-first-payable current-group num-accounts this-account-ind)
(if
(>= this-account-ind num-accounts)
#f
(let*
((this-account
(gnc:group-get-account current-group this-account-ind))
(account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type this-account) #f)))
(begin
(gnc:debug "this-account" this-account)
(gnc:debug "account-type" account-type)
(if (eq? account-type 'payable)
(begin
(gnc:debug "this-account selected" this-account)
this-account)
(find-first-payable
current-group num-accounts (+ this-account-ind 1)))))))
(let* ((current-group (gnc:get-current-group))
(num-accounts (gnc:group-get-num-accounts
current-group)))
(if (> num-accounts 0)
(let ((first-payable (find-first-payable
current-group
num-accounts
0)))
(gnc:debug "first-payable" first-payable)
(if first-payable
(list first-payable)
(list (gnc:group-get-account current-group 0))))
'())))
;; value-validator
(lambda (account-list)
(let ((first-account) (car account-list))
(gnc:debug "account-list" account-list)
(if first-account
(let ((account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type first-account))))
(if (eq? 'payable account-type)
(cons #t (list first-account))
(cons #f (_ "The payables account must be a payable account"))))
;; FIXME: until we can select a default account I need
;; to catch this at the report-writing stage
(#t '()))))
#f))
(gnc:make-internal-option "__reg" this-acc #f))
(aging-options-generator options)))
(define (find-first-payable-account)
(define (find-first-payable group num-accounts index)
(if (>= index num-accounts)
#f
(let* ((this-account (gnc:group-get-account (group index)))
(account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type this-account) #f)))
(if (eq? account-type 'payable)
this-account
(find-first-payable group num-accounts (+ index 1))))))
(let* ((current-group (gnc:get-current-group))
(num-accounts (gnc:group-get-num-accounts
current-group)))
(if (> num-accounts 0)
(find-first-payable current-group num-accounts 0)
#f)))
(define (payables-renderer report-obj)
(define (get-op section name)
@ -106,30 +71,27 @@
(define (op-value section name)
(gnc:option-value (get-op section name)))
(let* ((payables-account (car (op-value sect-acc opt-pay-acc))))
(let* ((payables-account (op-value "__reg" this-acc)))
(gnc:debug "payables-account" payables-account)
(if (not payables-account)
(set! payables-account (find-first-payables-account)))
(aging-renderer report-obj payables-account #f)))
;; Here we define the actual report with gnc:define-report
(gnc:define-report
;; The version of this report.
'version 1
;; The name of this report. This will be used, among other things,
;; for making its menu item in the main menu. You need to use the
;; untranslated value here!
'name (N_ "Payable Aging")
;; A tip that is used to provide additional information about the
;; report to the user.
'menu-tip (N_ "Amount owed, grouped by creditors and age.")
;; A path describing where to put the report in the menu system.
;; In this case, it's going under the utility menu.
'menu-path (list gnc:menuname-asset-liability)
;; The options generator function defined above.
'options-generator options-generator
'renderer payables-renderer
'in-menu? #f)
;; The rendering function defined above.
'renderer payables-renderer)
(define (gnc: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 acct)
(gnc:make-report "Payable Aging" options)))
(export gnc:payables-report-create-internal)

110
src/report/standard-reports/receivables.scm
View File

@ -32,8 +32,7 @@
(use-modules (gnucash report aging))
(define opt-rec-acc (N_ "Receivables Account"))
(define sect-acc (N_ "Accounts"))
(define this-acc "this-account")
(define (options-generator)
(let* ((options (gnc:new-options))
@ -42,62 +41,28 @@
(gnc:register-option options new-option))))
(add-option
(gnc:make-account-list-option
sect-acc opt-rec-acc
"a" (N_ "Account where receivables are stored.")
;; FIXME: Have a global preference for the receivables account??
;; default-getter
(lambda ()
(define (find-first-receivable current-group num-accounts this-account-ind)
(if
(>= this-account-ind num-accounts)
#f
(let*
((this-account
(gnc:group-get-account current-group this-account-ind))
(account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type this-account) #f)))
(begin
(gnc:debug "this-account" this-account)
(gnc:debug "account-type" account-type)
(if (eq? account-type 'receivable)
(begin
(gnc:debug "this-account selected" this-account)
this-account)
(find-first-receivable
current-group num-accounts (+ this-account-ind 1)))))))
(let* ((current-group (gnc:get-current-group))
(num-accounts (gnc:group-get-num-accounts
current-group)))
(if (> num-accounts 0)
(let ((first-receivable (find-first-receivable
current-group
num-accounts
0)))
(gnc:debug "first-receivable" first-receivable)
(if first-receivable
(list first-receivable)
(list (gnc:group-get-account current-group 0))))
'())))
;; value-validator
(lambda (account-list)
(let ((first-account) (car account-list))
(gnc:debug "account-list" account-list)
(if first-account
(let ((account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type first-account))))
(if (eq? 'receivable account-type)
(cons #t (list first-account))
(cons #f (_ "The receivables account must be a receivable account"))))
;; FIXME: until we can select a default account I need
;; to catch this at the report-writing stage
(#t '()))))
#f))
(gnc:make-internal-option "__reg" this-acc #f))
(aging-options-generator options)))
(define (find-first-receivable-account)
(define (find-first-receivable group num-accounts index)
(if (>= index num-accounts)
#f
(let* ((this-account (gnc:group-get-account (group index)))
(account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type this-account) #f)))
(if (eq? account-type 'receivable)
this-account
(find-first-receivable group num-accounts (+ index 1))))))
(let* ((current-group (gnc:get-current-group))
(num-accounts (gnc:group-get-num-accounts
current-group)))
(if (> num-accounts 0)
(find-first-receivable current-group num-accounts 0)
#f)))
(define (receivables-renderer report-obj)
(define (get-op section name)
@ -106,30 +71,27 @@
(define (op-value section name)
(gnc:option-value (get-op section name)))
(let* ((receivables-account (car (op-value sect-acc opt-rec-acc))))
(let* ((receivables-account (op-value "__reg" this-acc)))
(gnc:debug "receivables-account" receivables-account)
(if (not receivables-account)
(set! receivables-account (find-first-receivable-account)))
(aging-renderer report-obj receivables-account #t)))
;; Here we define the actual report with gnc:define-report
(gnc:define-report
;; The version of this report.
'version 1
;; The name of this report. This will be used, among other things,
;; for making its menu item in the main menu. You need to use the
;; untranslated value here!
'name (N_ "Receivable Aging")
;; A tip that is used to provide additional information about the
;; report to the user.
'menu-tip (N_ "Amount owed, grouped by creditors and age.")
;; A path describing where to put the report in the menu system.
;; In this case, it's going under the utility menu.
'menu-path (list gnc:menuname-asset-liability)
;; The options generator function defined above.
'options-generator options-generator
'renderer receivables-renderer
'in-menu? #f)
;; The rendering function defined above.
'renderer receivables-renderer)
(define (gnc: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 acct)
(gnc:make-report "Receivable Aging" options)))
(export gnc:receivables-report-create-internal)

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

@ -9,6 +9,8 @@
(export gnc:register-report-create)
(export gnc:invoice-report-create)
(export gnc:payables-report-create)
(export gnc:receivables-report-create)
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash report account-piecharts))
@ -28,3 +30,5 @@
(define gnc:register-report-create gnc:register-report-create-internal)
(define gnc:invoice-report-create gnc:invoice-report-create-internal)
(define gnc:payables-report-create gnc:payables-report-create-internal)
(define gnc:receivables-report-create gnc:receivables-report-create-internal)