More module refactoring.

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@5361 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-09-11 07:41:26 +00:00
parent 4450f4a025
commit 4a757d9396
8 changed files with 193 additions and 30 deletions

View File

@ -775,6 +775,14 @@ gnc_account_create_opening_balance (Account *account,
return TRUE; return TRUE;
} }
char *
gnc_account_get_full_name (Account *account)
{
if (!account) return NULL;
return xaccAccountGetFullName (account, gnc_get_account_separator ());
}
static void static void
gnc_lconv_set (char **p_value, char *default_value) gnc_lconv_set (char **p_value, char *default_value)
{ {

View File

@ -88,6 +88,8 @@ gboolean gnc_account_create_opening_balance (Account *account,
gnc_numeric balance, gnc_numeric balance,
time_t date); time_t date);
char * gnc_account_get_full_name (Account *account);
/* Price source functions *******************************************/ /* Price source functions *******************************************/

View File

@ -203,6 +203,14 @@ determines formatting details.")
'() '()
"Resume gui refresh events.") "Resume gui refresh events.")
(gw:wrap-function
mod
'gnc:account-get-full-name
'(<gw:m-chars-caller-owned>)
"gnc_account_get_full_name"
'((<gnc:Account*> account))
"Return the fully-qualified name of the account.")
(gw:wrap-function (gw:wrap-function
mod mod
'gnc:default-print-info 'gnc:default-print-info

View File

@ -1297,6 +1297,7 @@ gnc_numeric_p(SCM arg)
return TRUE; return TRUE;
} }
} }
static SCM static SCM
gnc_glist_account_ptr_to_scm_internal (GList *account_list, gboolean free_list) gnc_glist_account_ptr_to_scm_internal (GList *account_list, gboolean free_list)
{ {
@ -1369,6 +1370,98 @@ gnc_glist_account_ptr_p(SCM list)
return gh_list_p(list); return gh_list_p(list);
} }
static SCM
gnc_glist_transaction_ptr_to_scm_internal (GList *trans_list,
gboolean free_list)
{
static SCM trans_type = SCM_UNDEFINED;
SCM result;
if (trans_type == SCM_UNDEFINED)
{
trans_type = gh_eval_str("<gnc:Transaction*>");
/* don't really need this - types are bound globally anyway. */
if(trans_type != SCM_UNDEFINED) scm_protect_object(trans_type);
}
result = gnc_glist_to_scm_list(trans_list, trans_type);
if (free_list)
g_list_free (trans_list);
return result;
}
SCM
gnc_glist_transaction_ptr_to_scm (GList *transaction_list)
{
return gnc_glist_transaction_ptr_to_scm_internal (transaction_list, TRUE);
}
SCM
gnc_glist_transaction_ptr_to_scm_no_free (GList *transaction_list)
{
return gnc_glist_transaction_ptr_to_scm_internal (transaction_list, FALSE);
}
GList *
gnc_scm_to_glist_transaction_ptr (SCM scm_list)
{
return gnc_scm_list_to_glist (scm_list);
}
int
gnc_glist_transaction_ptr_p (SCM list)
{
return gh_list_p (list);
}
static SCM
gnc_glist_split_ptr_to_scm_internal (GList *trans_list,
gboolean free_list)
{
static SCM trans_type = SCM_UNDEFINED;
SCM result;
if (trans_type == SCM_UNDEFINED)
{
trans_type = gh_eval_str("<gnc:Split*>");
/* don't really need this - types are bound globally anyway. */
if(trans_type != SCM_UNDEFINED) scm_protect_object(trans_type);
}
result = gnc_glist_to_scm_list(trans_list, trans_type);
if (free_list)
g_list_free (trans_list);
return result;
}
SCM
gnc_glist_split_ptr_to_scm (GList *split_list)
{
return gnc_glist_split_ptr_to_scm_internal (split_list, TRUE);
}
SCM
gnc_glist_split_ptr_to_scm_no_free (GList *split_list)
{
return gnc_glist_split_ptr_to_scm_internal (split_list, FALSE);
}
GList *
gnc_scm_to_glist_split_ptr (SCM scm_list)
{
return gnc_scm_list_to_glist (scm_list);
}
int
gnc_glist_split_ptr_p (SCM list)
{
return gh_list_p (list);
}
/******************************************************************** /********************************************************************
* gnc_scm_to_commodity * gnc_scm_to_commodity
********************************************************************/ ********************************************************************/

View File

@ -87,6 +87,20 @@ SCM gnc_glist_account_ptr_to_scm_no_free (GList *account_list);
GList * gnc_scm_to_glist_account_ptr(SCM scm_list); GList * gnc_scm_to_glist_account_ptr(SCM scm_list);
int gnc_glist_account_ptr_p(SCM scm_list); int gnc_glist_account_ptr_p(SCM scm_list);
/* The GList is freed */
SCM gnc_glist_transaction_ptr_to_scm(GList *transaction_list);
/* The GList is not freed */
SCM gnc_glist_transaction_ptr_to_scm_no_free (GList *transaction_list);
GList * gnc_scm_to_glist_transaction_ptr(SCM scm_list);
int gnc_glist_transaction_ptr_p(SCM scm_list);
/* The GList is freed */
SCM gnc_glist_split_ptr_to_scm(GList *split_list);
/* The GList is not freed */
SCM gnc_glist_split_ptr_to_scm_no_free (GList *split_list);
GList * gnc_scm_to_glist_split_ptr(SCM scm_list);
int gnc_glist_split_ptr_p(SCM scm_list);
/* The GList is freed */ /* The GList is freed */
SCM gnc_glist_commodity_ptr_to_scm(GList * list); SCM gnc_glist_commodity_ptr_to_scm(GList * list);
GList * gnc_scm_to_glist_commodity_ptr(SCM list); GList * gnc_scm_to_glist_commodity_ptr(SCM list);

View File

@ -155,6 +155,66 @@
(old-func c-name) (old-func c-name)
";\n"))))) ";\n")))))
;; list of split *
(let ((wt (gw:wrap-type mod '<gnc:list-of-split*-callee-owned>
"GList *" "const GList *")))
(gw:type-set-scm-arg-type-test-ccodegen!
wt
(lambda (param)
(let ((old-func
(lambda (x)
(list "gnc_glist_split_ptr_p(" x ")"))))
(old-func (gw:param-get-scm-name param)))))
(gw:type-set-pre-call-arg-ccodegen!
wt
(lambda (param)
(let* ((scm-name (gw:param-get-scm-name param))
(c-name (gw:param-get-c-name param))
(old-func
(lambda (x)
(list "gnc_scm_to_glist_split_ptr(" x ")"))))
(list c-name " = " (old-func scm-name) ";\n"))))
(gw:type-set-call-ccodegen! wt standard-c-call-gen)
(add-standard-result-handlers!
wt
(lambda (scm-name c-name)
(let ((old-func
(lambda (x)
(list "gnc_glist_split_ptr_to_scm_no_free(" x ")"))))
(list scm-name " = " (old-func c-name) ";\n")))))
;; list of transaction *
(let ((wt (gw:wrap-type mod '<gnc:list-of-transaction*-callee-owned>
"GList *" "const GList *")))
(gw:type-set-scm-arg-type-test-ccodegen!
wt
(lambda (param)
(let ((old-func
(lambda (x)
(list "gnc_glist_transaction_ptr_p(" x ")"))))
(old-func (gw:param-get-scm-name param)))))
(gw:type-set-pre-call-arg-ccodegen!
wt
(lambda (param)
(let* ((scm-name (gw:param-get-scm-name param))
(c-name (gw:param-get-c-name param))
(old-func
(lambda (x)
(list "gnc_scm_to_glist_transaction_ptr(" x ")"))))
(list c-name " = " (old-func scm-name) ";\n"))))
(gw:type-set-call-ccodegen! wt standard-c-call-gen)
(add-standard-result-handlers!
wt
(lambda (scm-name c-name)
(let ((old-func
(lambda (x)
(list "gnc_glist_transaction_ptr_to_scm_no_free(" x ")"))))
(list scm-name " = " (old-func c-name) ";\n")))))
;; list of account * ;; list of account *
(let ((wt (gw:wrap-type mod '<gnc:list-of-account*-caller-owned> (let ((wt (gw:wrap-type mod '<gnc:list-of-account*-caller-owned>
"GList *" "const GList *"))) "GList *" "const GList *")))
@ -635,6 +695,14 @@ will cause NULL to be returned. A convenient way of cycling through
all splits is to start at zero, and kep incrementing until a null all splits is to start at zero, and kep incrementing until a null
pointer is returned.") pointer is returned.")
(gw:wrap-function
mod
'gnc:transaction-get-splits
'<gnc:list-of-split*-callee-owned>
"xaccTransGetSplitList"
'((<gnc:Transaction*> t))
"Returns a list of the splits in t.")
(gw:wrap-function (gw:wrap-function
mod mod
'gnc:transaction-get-num 'gnc:transaction-get-num

View File

@ -130,7 +130,6 @@
(export gnc:report-remove-by-id) (export gnc:report-remove-by-id)
(export gnc:find-report) (export gnc:find-report)
(export gnc:report-generate-restore-forms) (export gnc:report-generate-restore-forms)
(export gnc:backtrace-if-exception)
(export gnc:report-render-html) (export gnc:report-render-html)
(export gnc:report-run) (export gnc:report-run)
@ -503,8 +502,6 @@
(export gnc:account-get-type-string-plural) (export gnc:account-get-type-string-plural)
(export gnc:accounts-get-commodities) (export gnc:accounts-get-commodities)
(export gnc:get-current-group-depth) (export gnc:get-current-group-depth)
(export gnc:account-separator-char)
(export gnc:account-get-full-name)
(export gnc:split-get-corr-account-full-name) (export gnc:split-get-corr-account-full-name)
(export gnc:account-get-immediate-subaccounts) (export gnc:account-get-immediate-subaccounts)
(export gnc:account-get-all-subaccounts) (export gnc:account-get-all-subaccounts)
@ -526,7 +523,6 @@
(export gnc:account-get-balance-interval) (export gnc:account-get-balance-interval)
(export gnc:account-get-comm-balance-interval) (export gnc:account-get-comm-balance-interval)
(export gnc:group-get-comm-balance-interval) (export gnc:group-get-comm-balance-interval)
(export gnc:transaction-get-splits)
(load-from-path "commodity-utilities.scm") (load-from-path "commodity-utilities.scm")
(load-from-path "html-barchart.scm") (load-from-path "html-barchart.scm")

View File

@ -154,22 +154,6 @@
(accounts-get-children-depth (accounts-get-children-depth
(gnc:group-get-account-list (gnc:get-current-group)))) (gnc:group-get-account-list (gnc:get-current-group))))
;; get a full account name
(define (gnc:account-get-full-name account)
(let ((separator (gnc:account-separator-char)))
(if (not account)
""
(let ((parent-name
(gnc:account-get-full-name
(gnc:group-get-parent
(gnc:account-get-parent account)))))
(if (string=? parent-name "")
(gnc:account-get-name account)
(string-append
parent-name
separator
(gnc:account-get-name account)))))))
(define (gnc:split-get-corr-account-full-name split) (define (gnc:split-get-corr-account-full-name split)
(let ((separator (string-ref (gnc:account-separator-char) 0))) (let ((separator (string-ref (gnc:account-separator-char) 0)))
(gnc:split-get-corr-account-full-name-internal split separator))) (gnc:split-get-corr-account-full-name-internal split separator)))
@ -597,13 +581,3 @@
(gnc:account-get-comm-balance-interval (gnc:account-get-comm-balance-interval
account from to #t)) group)) account from to #t)) group))
this-collector)) this-collector))
;; FIXME redundant
(define (gnc:transaction-get-splits transaction)
(let* ((num-splits (gnc:transaction-get-split-count transaction)))
(let loop ((index 0))
(if (= index num-splits)
'()
(cons
(gnc:transaction-get-split transaction index)
(loop (+ index 1)))))))