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

* app-utils/options.scm -- define new account-sel options that let you

Browse Source 
"select" an account.  You can only select one account using this option.
	* app-utils/app-utils.scm -- export new account-sel option types
	* gnome-utils/dialog-options.c -- use the GNCAccountSel to implement
	  the account-sel option.
	* business/business-reports/*.scm -- change to using the new account-sel
	  option type.  Fixes bug #96137


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7360 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins 2002-10-19 23:14:09 +00:00
parent 478cbcfdd0
commit 70828581b4
7 changed files with 207 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ChangeLog
View File

@ -22,6 +22,14 @@
* configure.in: remove src/account-dialog/Makefile
* move gnc-account-sel.[ch] from src/gnome to src/gnome-utils
* app-utils/options.scm -- define new account-sel options that let you
"select" an account. You can only select one account using this option.
* app-utils/app-utils.scm -- export new account-sel option types
* gnome-utils/dialog-options.c -- use the GNCAccountSel to implement
the account-sel option.
* business/business-reports/*.scm -- change to using the new account-sel
option type. Fixes bug #96137
2002-10-19 Christian Stimming <stimming@tuhh.de>

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

@ -62,6 +62,8 @@
(export gnc:date-option-relative-time)
(export gnc:make-account-list-option)
(export gnc:make-account-list-limited-option)
(export gnc:make-account-sel-option)
(export gnc:make-account-sel-limited-option)
(export gnc:multichoice-list-lookup)
(export gnc:make-multichoice-option)
(export gnc:make-multichoice-callback-option)

100
src/app-utils/options.scm
View File

@ -631,6 +631,106 @@
validator
(cons multiple-selection acct-type-list) #f #f #f)))
;; Just like gnc:make-account-sel-limited-option except it
;; does not limit the types of accounts that are available
;; to the user.
(define (gnc:make-account-sel-option
section
name
sort-tag
documentation-string
default-getter
value-validator)
(gnc:make-account-sel-limited-option
section name sort-tag documentation-string
default-getter value-validator '()))
;; account-sel options use the option-data as a pair; the car is
;; ignored, the cdr is a list of account-types. If the cdr is an empty
;; list, then all account types are shown. Internally, the value is
;; always a guid. Externally, both guids and account pointers may be
;; used to set the value of the option. The option always returns the
;; "current" account pointer.
(define (gnc:make-account-sel-limited-option
section
name
sort-tag
documentation-string
default-getter
value-validator
acct-type-list)
(define (convert-to-guid item)
(if (string? item)
item
(gnc:account-get-guid item)))
(define (convert-to-account item)
(if (string? item)
(gnc:account-lookup item (gnc:get-current-book))
item))
(define (find-first-account)
(define (find-first 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 (if (null? acct-type-list) #t (member account-type acct-type-list))
this-account
(find-first 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 current-group num-accounts 0)
#f)))
(define (get-default)
(if default-getter
(default-getter)
(find-first-account)))
(let* ((option (convert-to-guid (get-default)))
(option-set #f)
(getter (lambda () (convert-to-account
(if option-set
option
(get-default)))))
(value->string (lambda ()
(string-append
"'" (gnc:value->string (if option-set option #f)))))
(validator
(if (not value-validator)
(lambda (account) (list #t account))
(lambda (account)
(value-validator (convert-to-account account))))))
(gnc:make-option
section name sort-tag 'account-sel documentation-string getter
(lambda (account)
(if (not account) (set! account (get-default)))
(set! account (convert-to-account account))
(let* ((result (validator account))
(valid (car result))
(value (cadr result)))
(if valid
(begin
(set! option (convert-to-guid value))
(set! option-set #t))
(gnc:error "Illegal account value set"))))
(lambda () (convert-to-account (get-default)))
(gnc:restore-form-generator value->string)
(lambda (f p) (gnc:kvp-frame-set-slot-path f value p))
(lambda (f p)
(let ((v (gnc:kvp-frame-get-slot-path f p)))
(if (and v (string? v))
(set! value v))))
validator
(cons #f acct-type-list) #f #f #f)))
(define (gnc:multichoice-list-lookup list item )
(cond
((null? list) #f)

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

@ -295,8 +295,9 @@
(lambda () #f) #f owner-type))
(gnc:register-inv-option
(gnc:make-account-list-limited-option acct-string acct-string "" ""
(lambda () '()) #f #f acct-type-list))
(gnc:make-account-sel-limited-option owner-page acct-string "w"
(N_ "The account to search for transactions")
#f #f acct-type-list))
(gnc:options-add-report-date!
gnc:*report-options* gnc:pagename-general
@ -467,8 +468,7 @@
(table '())
(orders '())
(query (gnc:malloc-query))
(account-list (opt-val acct-string acct-string))
(account #f)
(account (opt-val owner-page acct-string))
(owner (opt-val owner-page owner-string))
(report-date (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
@ -476,9 +476,6 @@
(title #f)
(book (gnc:get-current-book))) ;XXX Grab this from elsewhere
(if (not (null? account-list))
(set! account (car account-list)))
(if (gnc:owner-is-valid? owner)
(begin
(setup-query query owner account)
@ -591,10 +588,10 @@
(define (owner-report-create-internal report-name owner account)
(let* ((options (gnc:make-report-options report-name))
(owner-op (gnc:lookup-option options owner-page owner-string))
(account-op (gnc:lookup-option options acct-string acct-string)))
(account-op (gnc:lookup-option options owner-page acct-string)))
(gnc:option-set-value owner-op owner)
(gnc:option-set-value account-op (list account))
(gnc:option-set-value account-op account)
(gnc:make-report report-name options)))
(define (owner-report-create owner account)

47
src/business/business-reports/payables.scm
View File

@ -34,7 +34,7 @@
(use-modules (gnucash report aging))
(use-modules (gnucash report standard-reports))
(define acc-page (N_ "Account"))
(define acc-page gnc:pagename-general)
(define this-acc (N_ "Payable Account"))
(define (options-generator)
@ -44,49 +44,20 @@
(gnc:register-option options new-option))))
(add-option
(gnc:make-account-list-limited-option
(gnc:make-account-sel-limited-option
acc-page this-acc
"" ""
(lambda () '())
#f
#f
'(payable)))
(N_ "The payable account you wish to examine") "zz"
#f #f '(payable)))
(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 (opt-val section name)
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
(define (get-op section name)
(gnc:lookup-option (gnc:report-options report-obj) section name))
(define (op-value section name)
(gnc:option-value (get-op section name)))
(let* ((payables-account (op-value acc-page this-acc)))
(let ((payables-account (opt-val acc-page this-acc)))
(gnc:debug "payables-account" payables-account)
(if (null? payables-account)
(set! payables-account (find-first-payable-account))
(set! payables-account (car payables-account)))
(aging-renderer report-obj payables-account #f)))
;; Here we define the actual report with gnc:define-report
@ -102,7 +73,7 @@
(let* ((options (gnc:make-report-options (N_ "Payable Aging")))
(acct-op (gnc:lookup-option options acc-page this-acc)))
(gnc:option-set-value acct-op (list acct))
(gnc:option-set-value acct-op acct)
(gnc:make-report "Payable Aging" options)))
(define (gnc:payables-report-create-internal

42
src/business/business-reports/receivables.scm
View File

@ -34,7 +34,7 @@
(use-modules (gnucash report aging))
(use-modules (gnucash report standard-reports))
(define acc-page (N_ "Account"))
(define acc-page gnc:pagename-general)
(define this-acc (N_ "Receivables Account"))
(define (options-generator)
@ -44,49 +44,21 @@
(gnc:register-option options new-option))))
(add-option
(gnc:make-account-list-limited-option
(gnc:make-account-sel-limited-option
acc-page this-acc
"" ""
(lambda () '())
#f
#f
'(receivable)))
(N_ "The receivables account you wish to examine") "w"
#f #f '(receivable)))
(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)
(gnc:lookup-option (gnc:report-options report-obj) section name))
(define (op-value section name)
(gnc:option-value (get-op section name)))
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
(let* ((receivables-account (op-value acc-page this-acc)))
(gnc:debug "receivables-account" receivables-account)
(if (null? receivables-account)
(set! receivables-account (find-first-receivable-account))
(set! receivables-account (car receivables-account)))
(aging-renderer report-obj receivables-account #t)))
;; Here we define the actual report with gnc:define-report
@ -102,7 +74,7 @@
(let* ((options (gnc:make-report-options (N_ "Receivable Aging")))
(acct-op (gnc:lookup-option options acc-page this-acc)))
(gnc:option-set-value acct-op (list acct))
(gnc:option-set-value acct-op acct)
(gnc:make-report "Receivable Aging" options)))
(define (gnc:receivables-report-create-internal

75
src/gnome-utils/dialog-options.c
View File

@ -23,12 +23,14 @@
#include "config.h"
#include <gnome.h>
#include <g-wrap-wct.h>
#include "dialog-options.h"
#include "dialog-utils.h"
#include "engine-helpers.h"
#include "glib-helpers.h"
#include "global-options.h"
#include "gnc-account-sel.h"
#include "gnc-account-tree.h"
#include "gnc-commodity-edit.h"
#include "gnc-general-select.h"
@ -42,6 +44,7 @@
#include "messages.h"
#include "option-util.h"
/* This static indicates the debugging module that this .o belongs to. */
static short module = MOD_GUI;
@ -1829,6 +1832,41 @@ gnc_option_set_ui_widget_account_list (GNCOption *option, GtkBox *page_box,
return value;
}
static GtkWidget *
gnc_option_set_ui_widget_account_sel (GNCOption *option, GtkBox *page_box,
GtkTooltips *tooltips,
char *name, char *documentation,
/* Return values */
GtkWidget **enclosing, gboolean *packed)
{
GtkWidget *value;
GtkWidget *label;
GList *acct_type_list;
char * colon_name;
colon_name = g_strconcat(name, ":", NULL);
label = gtk_label_new(colon_name);
gtk_misc_set_alignment(GTK_MISC(label), 1.0, 0.5);
g_free(colon_name);
acct_type_list = gnc_option_get_account_type_list(option);
value = gnc_account_sel_new();
gnc_account_sel_set_acct_filters(GNC_ACCOUNT_SEL(value), acct_type_list);
gtk_signal_connect(GTK_OBJECT(gnc_account_sel_gtk_entry(GNC_ACCOUNT_SEL(value))),
"changed",
GTK_SIGNAL_FUNC(gnc_option_changed_cb), option);
gnc_option_set_widget (option, value);
gnc_option_set_ui_value(option, TRUE);
*enclosing = gtk_hbox_new(FALSE, 5);
gtk_box_pack_start(GTK_BOX(*enclosing), label, FALSE, FALSE, 0);
gtk_box_pack_start(GTK_BOX(*enclosing), value, FALSE, FALSE, 0);
gtk_widget_show_all(*enclosing);
return value;
}
static GtkWidget *
gnc_option_set_ui_widget_list (GNCOption *option, GtkBox *page_box,
GtkTooltips *tooltips,
@ -2286,6 +2324,25 @@ gnc_option_set_ui_value_account_list (GNCOption *option, gboolean use_default,
return FALSE;
}
static gboolean
gnc_option_set_ui_value_account_sel (GNCOption *option, gboolean use_default,
GtkWidget *widget, SCM value)
{
Account *acc = NULL;
if (value != SCM_BOOL_F) {
if (!gw_wcp_p(value))
scm_misc_error("gnc_optoin_set_ui_value_account_sel",
"Option Value not a gw:wcp.", value);
acc = gw_wcp_get_ptr(value);
}
gnc_account_sel_set_account (GNC_ACCOUNT_SEL(widget), acc);
return FALSE;
}
static gboolean
gnc_option_set_ui_value_list (GNCOption *option, gboolean use_default,
GtkWidget *widget, SCM value)
@ -2579,6 +2636,22 @@ gnc_option_get_ui_value_account_list (GNCOption *option, GtkWidget *widget)
return result;
}
static SCM
gnc_option_get_ui_value_account_sel (GNCOption *option, GtkWidget *widget)
{
GNCAccountSel *gas;
Account* acc;
SCM result;
gas = GNC_ACCOUNT_SEL(widget);
acc = gnc_account_sel_get_account (gas);
if (!acc)
return SCM_BOOL_F;
return gw_wcp_assimilate_ptr(acc, gh_eval_str("<gnc:Account*>"));
}
static SCM
gnc_option_get_ui_value_list (GNCOption *option, GtkWidget *widget)
{
@ -2689,6 +2762,8 @@ static void gnc_options_initialize_options (void)
gnc_option_set_ui_value_date, gnc_option_get_ui_value_date },
{ "account-list", gnc_option_set_ui_widget_account_list,
gnc_option_set_ui_value_account_list, gnc_option_get_ui_value_account_list },
{ "account-sel", gnc_option_set_ui_widget_account_sel,
gnc_option_set_ui_value_account_sel, gnc_option_get_ui_value_account_sel },
{ "list", gnc_option_set_ui_widget_list,
gnc_option_set_ui_value_list, gnc_option_get_ui_value_list },
{ "number-range", gnc_option_set_ui_widget_number_range,