IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-16 18:25:11 -06:00
Code Issues Packages Projects Releases Wiki Activity

Rob Browning's update for the new g-wrap.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3307 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-12-14 01:49:10 +00:00
parent 2ff12ccada
commit ace1a275cc
24 changed files with 342 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
ChangeLog
View File

@ -1,3 +1,104 @@
2000-12-13 Rob Browning <rlb@cs.utexas.edu>
* src/scm/text-export.scm: kill pointer-token*
* src/scm/report/transaction-report.scm: minor formatting changes.
* src/scm/report/taxtxf.scm: kill pointer-token*
* src/scm/report/folio.scm: use new g-wrap enum support.
* src/scm/report/budget-report.scm:
disable report until we fix the enumeration usage.
* src/scm/report/balance-and-pnl.scm: kill pointer-token*
* src/scm/report/average-balance.scm: minor formatting changes.
* src/scm/report-utilities.scm: kill pointer-token*
(gnc:account-has-shares?): use new g-wrap enum support.
* src/scm/qif-import/qif-to-gnc.scm: kill pointer-token*
* src/scm/qif-import/qif-parse.scm:
delete unusd gif-parse:print-acct-type
* src/scm/qif-import/qif-guess-map.scm: kill pointer-token*
* src/scm/main.scm
(gnc:main): add handle-batch-mode-item so --evaluate works.
* src/scm/engine-interface.scm: kill pointer-token*.
* src/scm/c-interface.scm: kill pointer-token*.
* src/quotes/gnc-prices-2.in: various small fixes (big ones later).
* src/optional/swig/.cvsignore: add Makefile Makefile.in
* src/guile/option-util.c
(gnc_option_db_register_change_callback): update for new g-wrap.
* src/guile/guile-util.c
(gnc_copy_split): update for new g-wrap.
(gnc_copy_split_scm_onto_split): update for new g-wrap.
(gnc_copy_trans): update for new g-wrap.
(gnc_copy_trans_scm_onto_trans_swap_accounts): update for new g-wrap.
(gnc_glist_account_ptr_to_scm): use gnc_glist_to_scm_list.
(gnc_scm_to_glist_account_ptr): use gnc_scm_list_to_glist.
(gnc_scm_to_commodity): update for new g-wrap.
(gnc_commodity_to_scm): update for new g-wrap.
(gnc_glist_string_to_scm): double speed - use stack.
(gnc_scm_to_glist_string): don't reverse result.
(gnc_glist_commodity_ptr_to_scm): update for new g-wrap.
use gnc_glist_to_scm_list.
(gnc_scm_to_glist_commodity_ptr): use gnc_scm_list_to_glist.
* src/guile/gnucash.c.in
(gnucash_main_helper): add g-wrap module dir to %load-path.
(gnucash_main_helper): call init_g_wrapped_gnc, not init_gnc.
* src/guile/gnc.gwp: update for the new g-wrap.
* src/guile/gnc-helpers.h: add prototypes for new functions.
* src/guile/gnc-helpers.c
(glist_to_scm_list_helper): new (private) function.
(gnc_glist_to_scm_list): new public function.
(gnc_scm_list_to_glist): new public function.
(glist_map_helper): new (private) function.
(gnc_glist_scm_map): new public function.
(gnc_glist_scm_for_each): new public function.
(gnc_gettext_helper): always strdup result.
(gnc_timespec2timepair): use gint64, not long long.
(gnc_timepair2timespec): use gint64, not long long.
(gnc_timepair_p): use more accurate test (including range check).
(gnc_scm_traversal_adapter): use new g-wrap wcp code.
(gnc_gint64_to_scm): new public function.
(gnc_scm_to_gint64): new public function.
(gnc_gh_gint64_p): new public function.
(gnc_scm_to_numeric): use gint64, not long long.
(gnc_numeric_to_scm): use gint64, not long long.
(gnc_numeric_p): use gint64, not long long.
* src/guile/Makefile.am: update for new g-wrap.
* src/gnome/top-level.c (gnc_ui_main): use new g-wrap wcp code.
* src/gnome/druid-qif-import.c: use new g-wrap wcp code.
* src/engine/gnc-commodity.c: g_strdup the key.
(gnc_commodity_table_delete_namespace): g_free the key.
These fixes are probably not sufficient.
* src/engine/Account.c: make temp warnings more informative.
* configure.in: update for new g-wrap.
check for guile bug (sizeof long_long >= long long).
check that sizeof unsigned long >= guint32.
* acinclude.m4: update for new g-wrap.
2000-12-08 Dave Peticolas <dave@krondo.com>
* src/gnome/gnc-dateedit.c: use more care when using parsed

25
acinclude.m4
View File

@ -32,8 +32,8 @@ AC_DEFUN(AC_GWRAP_CHECK_GUILE,
dnl AM_PATH_GWRAP ([MINIMUM-VERSION, [ACTION-IF-FOUND.
dnl [ACTION-IF-NOT-FOUND]]])
dnl tests for minimum versions of g-wrap and g-wrap-config.
dnl sets G_WRAP and G_WRAP_CONFIG
dnl tests for minimum version of g-wrap.
dnl sets G_WRAP_CONFIG and GWRAP_OLD_GUILE_SMOB if needed.
AC_DEFUN(AM_PATH_GWRAP,
[dnl
@ -50,16 +50,9 @@ fi
dnl if prefix set, then set them explicitly
if test x${gwrap_prefix} != x ; then
G_WRAP = ${gwrap_prefix}/bin/g-wrap
G_WRAP_CONFIG = ${gwrap_prefix}/bin/g-wrap-config
else
AC_PATH_PROG(G_WRAP, g-wrap, no)
if test x${G_WRAP} = xno ; then
CHECK_VERSION="no"
ifelse([$3], , true , [AC_MSG_WARN(g-wrap failed)
$3])
fi
AC_PATH_PROG(G_WRAP_CONFIG, g-wrap-config, no)
if test x${G_WRAP_CONFIG} = xno ; then
CHECK_VERSION="no"
@ -71,12 +64,12 @@ fi
if test x$CHECK_VERSION != xno ; then
AC_MSG_CHECKING(for g-wrap - version >= ${min_gwrap_version})
gwrap_major_version=`${G_WRAP} --version | \
sed 's/g-wrap \([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\1/'`
gwrap_minor_version=`${G_WRAP} --version | \
sed 's/g-wrap \([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\2/'`
gwrap_micro_version=`${G_WRAP} --version | \
sed 's/g-wrap \([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\3/'`
gwrap_major_version=`${G_WRAP_CONFIG} --version | \
sed 's/g-wrap-config \([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\1/'`
gwrap_minor_version=`${G_WRAP_CONFIG} --version | \
sed 's/g-wrap-config \([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\2/'`
gwrap_micro_version=`${G_WRAP_CONFIG} --version | \
sed 's/g-wrap-config \([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\3/'`
major_required=`echo ${min_gwrap_version} |\
@ -100,4 +93,4 @@ else
$3])
fi
dnl check version
fi])#### End of Patch data ####
fi])

53
configure.in
View File

@ -253,10 +253,12 @@ AC_DEFINE(GNOME)
G_WRAP_COMPILE_ARGS=""
G_WRAP_LINK_ARGS=""
AM_PATH_GWRAP(0.9.11, , [AC_MSG_ERROR([
AM_PATH_GWRAP(1.1.1, , [AC_MSG_ERROR([
g-wrap does not appear to be installed correctly. If you need to
install g-wrap, you can find it at ftp://ftp.gnucash.org/pub/g-wrap.
g-wrap does not appear to be installed correctly, or is not new
enough. Right now gnucash requires at least version 1.1.1 to build.
If you need to install g-wrap, you can find it at
ftp://ftp.gnucash.org/pub/g-wrap.
])])
# Find out what the g-wrap compile and link flags are.
@ -265,16 +267,57 @@ G_WRAP_COMPILE_ARGS=`${G_WRAP_CONFIG} --c-compile-args guile`
AC_MSG_RESULT($G_WRAP_COMPILE_ARGS)
AC_MSG_CHECKING(for g-wrap link args)
G_WRAP_LINK_ARGS=`${G_WRAP_CONFIG} --c-static-link-args guile`
G_WRAP_LINK_ARGS=`${G_WRAP_CONFIG} --c-link-args guile`
AC_MSG_RESULT($G_WRAP_LINK_ARGS)
AC_MSG_CHECKING(for g-wrap module directory)
G_WRAP_MODULE_DIR=`${G_WRAP_CONFIG} --guile-module-directory`
AC_MSG_RESULT($G_WRAP_MODULE_DIR)
AC_GWRAP_CHECK_GUILE
AC_SUBST(G_WRAP)
AC_SUBST(G_WRAP_CONFIG)
AC_SUBST(G_WRAP_COMPILE_ARGS)
AC_SUBST(G_WRAP_LINK_ARGS)
AC_SUBST(G_WRAP_MODULE_DIR)
### --------------------------------------------------------------------------
### Check size of long_long - some guile's are broken.
AC_MSG_CHECKING(if guile long_long is at least as big as gint64)
GNC_OLDCFLAGS="$CFLAGS"
CFLAGS="${GNOME_INCLUDEDIR} ${GUILE_INCS} ${CFLAGS}"
AC_TRY_RUN([
#include <glib.h>
#include <libguile/__scm.h>
int main(int argc, char *argv[]) {
return(!(sizeof(long_long) >= sizeof(gint64)));
}
],[
AC_MSG_RESULT(yes)
AC_DEFINE(GUILE_LONG_LONG_OK,1,is sizeof(long_long) >= sizeof(gint64))
],[
AC_MSG_RESULT(no)
])
CFLAGS="$GNC_OLDCFLAGS"
# One of the places this is critical is in gnc_scm_to_gint64 and inverse.
# However, I'm sure we require this elsewhere, so don't remove this test
# unless you've done sufficient code review/testing.
AC_MSG_CHECKING(if unsigned long is at least as big as guint32)
GNC_OLDCFLAGS="$CFLAGS"
CFLAGS="${GNOME_INCLUDEDIR} ${GUILE_INCS} ${CFLAGS}"
AC_TRY_RUN([
#include <glib.h>
int main(int argc, char *argv[]) {
return(!(sizeof(unsigned long) >= sizeof(guint32)));
}
],[
AC_MSG_RESULT(yes)
],[
AC_MSG_RESULT(no)
AC_MSG_ERROR(cannot continue, size of unsigned long too small.)
])
CFLAGS="$GNC_OLDCFLAGS"
### --------------------------------------------------------------------------
### Makefile creation

8
src/engine/Account.c
View File

@ -1281,7 +1281,10 @@ xaccAccountGetShareReconciledBalance (Account *acc)
Split *
xaccAccountGetSplit(Account *acc, int i) {
GList *result;
/* we'll take out these warnings once we've checked to see that the uses
are really appropriate */
PWARN ("welcome to pokeyland");
PWARN (" try to avoid this function, it's O(splits)");
if (!acc) return(NULL);
result = g_list_nth(acc->splits, i);
@ -1297,7 +1300,10 @@ xaccAccountGetSplitList (Account *acc) {
int
xaccAccountGetNumSplits (Account *acc) {
PWARN ("welcome to pokeyland");
/* we'll take out these warnings once we've checked to see that the uses
are really appropriate */
PWARN ("welcome to pokeyland - try to avoid this function.");
PWARN (" try to avoid this function, it's O(splits)");
if (!acc) return 0;
return g_list_length(acc->splits);
}

22
src/engine/gnc-commodity.c
View File

@ -455,8 +455,9 @@ gnc_commodity_table_add_namespace(gnc_commodity_table * table,
if(!ns) {
ns = g_new0(gnc_commodity_namespace, 1);
ns->table = g_hash_table_new(g_str_hash, g_str_equal);
g_hash_table_insert(table->table, (gpointer)(namespace),
(gpointer)ns);
g_hash_table_insert(table->table,
(gpointer) g_strdup(namespace),
(gpointer) ns);
}
}
@ -468,13 +469,16 @@ gnc_commodity_table_add_namespace(gnc_commodity_table * table,
void
gnc_commodity_table_delete_namespace(gnc_commodity_table * table,
const char * namespace) {
gnc_commodity_namespace * ns = NULL;
gpointer orig_key;
gpointer value;
if(table) {
ns = g_hash_table_lookup(table->table, (gpointer)namespace);
}
if(ns) {
g_hash_table_remove(table->table, namespace);
if(g_hash_table_lookup_extended(table->table,
(gpointer) namespace,
&orig_key,
&value)) {
g_hash_table_remove(table->table, namespace);
g_free(orig_key);
}
}
}

4
src/gnome/druid-qif-import.c
View File

@ -31,7 +31,6 @@
#include <unistd.h>
#include <guile/gh.h>
#include <g-wrap.h>
#include "druid-qif-import.h"
#include "dialog-account-picker.h"
#include "dialog-commodity.h"
@ -46,6 +45,7 @@
#include "query-user.h"
#include "gnc-ui-util.h"
#include <g-wrap-runtime-guile.h>
struct _qifimportwindow {
GtkWidget * window;
@ -1046,7 +1046,7 @@ gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
/* insert new pages, one for each stock */
while(!gh_null_p(stock_names)) {
comm_ptr_token = gh_call2(hash_ref, wind->stock_hash, gh_car(stock_names));
commodity = ((POINTER_TOKEN)(SCM_CDR(comm_ptr_token)))->pdata;
commodity = gw_wcp_get_ptr(comm_ptr_token);
new_page = make_qif_druid_page(commodity);

4
src/gnome/top-level.c
View File

@ -46,7 +46,6 @@
#include "dialog-transfer.h"
#include "dialog-utils.h"
#include "extensions.h"
#include "g-wrap.h"
#include "global-options.h"
#include "gnc-component-manager.h"
#include "gnc-engine-util.h"
@ -64,6 +63,7 @@
#include "window-main.h"
#include "window-report.h"
#include <g-wrap-runtime-guile.h>
/** PROTOTYPES ******************************************************/
static void gnc_configure_date_format_cb(void *);
@ -361,7 +361,7 @@ gnc_ui_main(void)
{
SCM run_danglers = gh_eval_str("gnc:hook-run-danglers");
SCM hook = gh_eval_str("gnc:*main-window-opened-hook*");
SCM window = POINTER_TOKEN_to_SCM(make_POINTER_TOKEN("gncUIWidget", app));
SCM window = gw_wcp_assimilate_ptr(app, gh_lookup("<gw:wt-gncUIWidget>"));
gh_call2(run_danglers, hook, window);
}

1
src/gnome/window-main.c
View File

@ -60,7 +60,6 @@
#include "window-register.h"
/* FIXME get rid of these */
#include <g-wrap.h>
#include "gnc.h"
/* Main Window information structure */

41
src/quotes/gnc-prices-2.in
View File

@ -9,23 +9,25 @@ use Finance::Quote;
## Modified by Paul Fenwick <pjf@cpan.org>, June 2000, to take
## advantage of new Finance::Quote features.
## Input (on standard input - one line per entry)
## Input (on standard input - one entry per line and one line per entry)
##
## ("IBM" "YAHOO")
## ("NT" "ASX")
## ...
## (fetch "NYSE" "IBM")
## (fetch "nyse" "ibm" "axp")
## (fetch "nasdaq" "jdsu")
## (fetch "nasdaq" "CSCO" "jdsu")
## Output (on standard output, one output form per input line)
##
## on success:
## (quote (name . <security-name>) (date . <date>) (price . <price>))
##
## on failure:
## (error bad-input-line "some details")
## (error bad-quote-source "some details")
## (error quote-lookup-failed "some details")
## (error price-not-found "some details")
## (error misc "some details")
## Schemified version of finance-quote's output, so basically an alist
## of alists, as in the example below. Only fields that this script
## knows about (and knows how to convert to scheme) are returned, so
## the conversion function will have to be updated whenever
## Finance::Quote changes.
## On error, result may be just #f, or errors may be stored with each
## quote as indicated in Finance::Quote.
## Exit status
##
@ -34,10 +36,7 @@ use Finance::Quote;
# TODO:
# Right now schemify_str is a hack. It just supresses double quotes
# in the output by replacing them with single quotes. We should do
# better, but that'll work for now. I haven't thought it through
# carefully, but can we just double all backslashes and backslash
# Is this safe? Can we just double all backslashes and backslash
# escape all double quotes and get the right answer?
# Right now this is more inefficient than it needs to be. We ask for
@ -70,11 +69,11 @@ my @lookup_items = ();
while(<>) {
# This big ugly nasty thing just matches something like this
#
# ("FOO" "BAR")
#
# where, rougly speaking, whitespace is allowed almost everywhere,
# this text constitute the entire line, and the double-quotes and
# this text constitutes the entire line, and the double-quotes and
# parens shown are the only occurences of those characters allowed
# in the line.

6
src/scm/c-interface.scm
View File

@ -17,12 +17,6 @@
(require 'hash-table)
;; Provides pointer-token-null? if needed (g-wrap >= 0.9.4 doesn't provide)
(if (not (defined? 'pointer-token-null?))
(define (pointer-token-null? ptr)
(eq? ptr #f)))
(define (gnc:error->string tag args)
(define (write-error port)
(if (and (list? args) (not (null? args)))

8
src/scm/engine-interface.scm
View File

@ -111,7 +111,7 @@
;; status and date are not copied. The C split's guid is,
;; of course, unchanged.
(define (gnc:split-scm-onto-split split-scm split)
(if (pointer-token-null? split)
(if (not split)
#f
(begin
(let ((memo (gnc:split-scm-get-memo split-scm))
@ -223,7 +223,7 @@
(define (gnc:transaction->transaction-scm trans use-cut-semantics?)
(define (trans-splits i)
(let ((split (gnc:transaction-get-split trans i)))
(if (pointer-token-null? split)
(if (not split)
'()
(cons (gnc:split->split-scm split use-cut-semantics?)
(trans-splits (+ i 1))))))
@ -245,7 +245,7 @@
;; used to use alternate account guids when creating splits.
(define (gnc:transaction-scm-onto-transaction trans-scm trans guid-mapping
commit?)
(if (pointer-token-null? trans)
(if (not trans)
#f
(begin
;; open the transaction for editing
@ -265,7 +265,7 @@
;; strip off the old splits
(let loop ((split (gnc:transaction-get-split trans 0)))
(if (not (pointer-token-null? split))
(if split
(begin
(gnc:split-destroy split)
(loop (gnc:transaction-get-split trans 0)))))

4
src/scm/engine-utilities.scm
View File

@ -97,7 +97,7 @@ list. Return '() for a null group."
;; Pull a scheme list of accounts (including subaccounts) from group grp
(define (gnc:group-get-account-list grp)
"Return a flat list of all the accounts in grp, or #f if there's a problem."
(if (pointer-token-null? grp)
(if (not grp)
#f
(let ((account-array (gnc:get-accounts grp)))
;; FIXME: Need to check for account-array being null, but we can't
@ -105,7 +105,7 @@ list. Return '() for a null group."
(let loop ((account (gnc:account-nth-account account-array 0))
(index 1))
(if (pointer-token-null? account)
(if (not account)
'()
(cons account
(loop (gnc:account-nth-account account-array index)

16
src/scm/main.scm
View File

@ -110,6 +110,22 @@
(define (gnc:main)
(define (handle-batch-mode-item item)
(cond
((procedure? item) (item))
((string? item)
(call-with-input-string
item
(lambda (port)
(let loop ((next-form (read port)))
(if (not (eof-object? next-form))
(begin
(eval next-form)
(loop (read port))))))))
(else
(display "gnucash: unknown batch-mode item - ignoring.")
(newline))))
;; Now the fun begins.
(gnc:startup)

2
src/scm/qif-import/qif-guess-map.scm
View File

@ -29,7 +29,7 @@
(define (qif-import:load-map-prefs)
(define (extract-all-account-info agroup root-name)
(if (pointer-token-null? agroup)
(if (not agroup)
'()
(let ((children (gnc:get-accounts agroup))
(children-list '())

3
src/scm/qif-import/qif-parse.scm
View File

@ -538,6 +538,3 @@
(with-output-to-string
(lambda ()
(write num))))
(define (qif-parse:print-acct-type t)
(symbol->string (gnc:account-type->symbol t)))

6
src/scm/qif-import/qif-to-gnc.scm
View File

@ -29,8 +29,8 @@
(gnc:get-account-from-full-name acct-group gnc-name separator))
(make-new-acct #f))
(if (or (pointer-token-null? same-gnc-account)
(and (not (pointer-token-null? same-gnc-account))
(if (or (not same-gnc-account)
(and same-gnc-account
(not (string=?
(gnc:account-get-full-name same-gnc-account)
gnc-name))))
@ -955,7 +955,7 @@
(let loop ((i 0)
(last-split #f))
(let ((ith-split (gnc:account-get-split account i)))
(if (pointer-token-eq? ith-split split)
(if (gw:wcp=? ith-split split)
(if last-split
(d-gnc:split-set-share-price
split (d-gnc:split-get-share-price last-split)))

14
src/scm/report-utilities.scm
View File

@ -24,8 +24,10 @@
(gnc:amount->string-helper (exact->inexact amount) info))
(define (gnc:account-has-shares? account)
(let ((type (gnc:account-type->symbol (gnc:account-get-type account))))
(member type '(STOCK MUTUAL CURRENCY))))
(let ((type (gw:enum-GNCAccountType-val->sym
(gnc:account-get-type account)
#f)))
(member type '(stock mutual-fund currency))))
(define (gnc:account-separator-char)
(let ((option (gnc:lookup-option gnc:*options-entries*
@ -43,7 +45,7 @@
;; get a full account name
(define (gnc:account-get-full-name account)
(let ((separator (gnc:account-separator-char)))
(if (pointer-token-null? account)
(if (not account)
""
(let ((parent-name
(gnc:account-get-full-name
@ -110,7 +112,7 @@
(let loop ((index 0)
(split (gnc:ith-split split-array 0))
(slist '()))
(if (pointer-token-null? split)
(if (not split)
(reverse slist)
(loop (+ index 1)
(gnc:ith-split split-array (+ index 1))
@ -366,7 +368,7 @@
(let loop ((index 0)
(balance 0)
(split (gnc:account-get-split account 0)))
(if (pointer-token-null? split)
(if (not split)
(+ children-balance balance)
(if (gnc:timepair-lt date (gnc:split-get-transaction-date split))
(+ children-balance balance)
@ -386,7 +388,7 @@
(let loop ((index 0)
(balance 0)
(split (gnc:account-get-split account 0)))
(if (pointer-token-null? split)
(if (not split)
(balance-collector 'add (gnc:account-get-currency account)
balance)
(if (gnc:timepair-lt date (gnc:split-get-transaction-date split))

20
src/scm/report/average-balance.scm
View File

@ -17,9 +17,21 @@
(gnc:depend "date-utilities.scm")
;; Plot strings
(define AvgBalPlot "using 2:3:4:5 t 'Average Balance' with errorbars, '' using 2:3 smooth sbezier t '' with lines")
(define GainPlot "using 2:6 t 'Net Gain' with linespoints, '' using 2:6 smooth sbezier t '' with lines" )
(define GLPlot "using 2:8 t 'Losses' with lp, '' using 2:7 t 'Gains' with lp")
(define AvgBalPlot
(string-append
"using 2:3:4:5 t 'Average Balance' with errorbars, "
"'' using 2:3 smooth sbezier t '' with lines"))
(define GainPlot
(string-append
"using 2:6 t 'Net Gain' with linespoints, "
"'' using 2:6 smooth sbezier t '' with lines" ))
(define GLPlot
(string-append "using 2:8 t 'Losses' with lp, "
"'' using 2:7 t 'Gains' with lp"))
(define NoPlot "")
(let ()
@ -427,7 +439,7 @@
"<p>\n"))
(list rept-text)
suffix))))
;; Define the strings
(string-db 'store 'beginning "Beginning")
(string-db 'store 'ending "Ending")

14
src/scm/report/balance-and-pnl.scm
View File

@ -284,7 +284,7 @@
(define (is-it-on-balance-sheet? type balance?)
(eq?
(not (member type '(INCOME EXPENSE)))
(not (member type '(income expense)))
(not balance?)))
(define (generate-balance-sheet-or-pnl report-name
@ -365,7 +365,9 @@
#f))))
(define (handle-level-1-account account options)
(let ((type (gnc:account-type->symbol (gnc:account-get-type account))))
(let ((type (gw:enum-GNCAccountType-val->sym
(gnc:account-get-type account)
#f)))
(if (is-it-on-balance-sheet? type balance-sheet?)
;; Ignore
'()
@ -411,7 +413,9 @@
(define (handle-level-2-account account options)
(let
((type (gnc:account-type->symbol (gnc:account-get-type account)))
((type (gw:enum-GNCAccountType-val->sym
(gnc:account-get-type account)
#f))
(this-balance (make-currency-collector))
(balance (make-currency-collector))
(rawbal
@ -432,7 +436,7 @@
'()
;; add in balances for any sub-sub groups
(let ((grandchildren (gnc:account-get-children account)))
(if (not (pointer-token-null? grandchildren))
(if grandchildren
(handle-collector-merging
balance (if balance-sheet? 'merge 'minusmerge)
(if balance-sheet?
@ -472,7 +476,7 @@
(gnc:commodity-get-mnemonic report-currency)
")"))))
(if (not (pointer-token-null? current-group))
(if current-group
(set! output
(list
(gnc:group-map-accounts

20
src/scm/report/budget-report.scm
View File

@ -1,5 +1,5 @@
;; -*-scheme-*-
;; $ID$
;;
;; budget-report.scm
;; Report on budget
;; Bryan Larsen (blarsen@ada-works.com)
@ -658,7 +658,7 @@
(define (budget-calculate-actual! budget-hash others begin-date-secs end-date-secs)
(let loop ((group (gnc:get-current-group)))
(cond
((not (pointer-token-null? group))
(group
(gnc:group-map-accounts
(lambda (account)
(let* ((line
@ -1239,10 +1239,20 @@
"Budget (Testing, Unfinished)"
"Test the budget dialog"
(list "_Tools" "")
;; FIXME: need update.
(lambda ()
(gnc:budget-dialog-create
gnc:budget-entries
(lambda () (display "Applied the budget.\n"))))))
(display
(string-append
"FIXME: Please update calls to gnc:account-type->symbol.\n"
"FIXME: If you need a string, use gnc:account-type-string,\n"
"FIXME: otherwise use (gw:enum-GNCAccountType-val->sym\n"
"FIXME: (gnc:account-get-type acct)\n"
"FIXME: #f)\n")))))
; (lambda ()
; (gnc:budget-dialog-create
; gnc:budget-entries
; (lambda () (display "Applied the budget.\n"))))));
(gnc:hook-add-dangler gnc:*main-window-opened-hook*
(lambda (win) (gnc:add-extension budget-item))))

7
src/scm/report/folio.scm
View File

@ -83,9 +83,10 @@
(define (report-rows-main)
(gnc:group-map-all-accounts
(lambda (account)
(let ((type (gnc:account-type->symbol
(gnc:account-get-type account))))
(if (member type '(STOCK MUTUAL))
(let ((type (gw:enum-GNCAccountType-val->sym
(gnc:account-get-type account)
#f)))
(if (member type '(stock mutual-fund))
(report-row account)
#f)))
(gnc:get-current-group)))

4
src/scm/report/taxtxf.scm
View File

@ -78,7 +78,7 @@
;; make a list of accounts from a group pointer
(define (gnc:group-ptr->list group-prt)
(if (pointer-token-null? group-prt)
(if (not group-prt)
'()
(gnc:group-map-accounts (lambda (x) x) group-prt)))
@ -735,7 +735,7 @@
;; the number of account generations: children, grandchildren etc.
(define (num-generations account gen)
(let ((children (gnc:account-get-children account)))
(if (pointer-token-null? children)
(if (not children)
(if (and (gnc:account-get-txf account)
(equal? "N521" (gnc:account-get-txf-code account)))
(+ gen 1) ; Est Fed Tax has a extra generation

113
src/scm/report/transaction-report.scm
View File

@ -645,25 +645,28 @@
(define (gnc:trep-renderer options)
(let* ((begindate (gnc:date-option-absolute-time (gnc:option-value (gnc:lookup-option options "Report Options" "From"))))
(enddate (gnc:date-option-absolute-time (gnc:option-value (gnc:lookup-option options "Report Options" "To"))))
(tr-report-account-op (gnc:lookup-option
options "Report Options" "Account"))
(tr-report-primary-key-op (gnc:lookup-option options
"Sorting"
"Primary Key"))
(tr-report-primary-order-op (gnc:lookup-option
options "Sorting"
"Primary Sort Order"))
(tr-report-secondary-key-op (gnc:lookup-option options
"Sorting"
"Secondary Key"))
(tr-report-secondary-order-op
(gnc:lookup-option options "Sorting" "Secondary Sort Order"))
(tr-report-style-op (gnc:lookup-option options
"Report Options"
"Style"))
(accounts (gnc:option-value tr-report-account-op))
(let* ((begindate
(gnc:date-option-absolute-time
(gnc:option-value
(gnc:lookup-option options "Report Options" "From"))))
(enddate
(gnc:date-option-absolute-time
(gnc:option-value
(gnc:lookup-option options "Report Options" "To"))))
(tr-report-account-op
(gnc:lookup-option options "Report Options" "Account"))
(tr-report-primary-key-op
(gnc:lookup-option options "Sorting" "Primary Key"))
(tr-report-primary-order-op
(gnc:lookup-option options "Sorting" "Primary Sort Order"))
(tr-report-secondary-key-op
(gnc:lookup-option options "Sorting" "Secondary Key"))
(tr-report-secondary-order-op
(gnc:lookup-option options "Sorting" "Secondary Sort Order"))
(tr-report-style-op
(gnc:lookup-option options "Report Options" "Style"))
(accounts (gnc:option-value tr-report-account-op))
(date-filter-pred (split-report-make-date-filter-predicate
begindate
(gnc:timepair-end-day-time
@ -686,43 +689,41 @@
begindate))
(s2b (if s2 (list s2) '()))
(sort-specs (if s1 (cons s1 s2b) s2b))
(split-list
(apply
append
(map
(lambda (account)
(make-split-list account filter-pred))
accounts)))
(split-report-specs (make-split-report-spec options)))
(list
(html-start-document-title (string-db 'lookup 'title) #f)
(html-start-table)
(if
(gnc:option-value
(gnc:lookup-option options "Display" "Headers"))
(html-table-headers split-report-specs)
'())
(html-table-render-entries split-list
split-report-specs
sort-specs
(case (gnc:option-value tr-report-style-op)
((multi-line)
html-table-entry-render-entries-first)
((merged)
html-table-entry-render-subentries-merged)
((single)
html-table-entry-render-entries-only))
(lambda (split)
(length
(gnc:split-get-other-splits split))))
(if
(gnc:option-value
(gnc:lookup-option options "Display" "Totals"))
(html-table-totals split-list split-report-specs)
'())
(html-end-table)
(html-end-document))))
(split-list
(apply
append
(map
(lambda (account)
(make-split-list account filter-pred))
accounts)))
(split-report-specs (make-split-report-spec options)))
(list
(html-start-document-title (string-db 'lookup 'title) #f)
(html-start-table)
(if (gnc:option-value (gnc:lookup-option options "Display" "Headers"))
(html-table-headers split-report-specs)
'())
(html-table-render-entries
split-list
split-report-specs
sort-specs
(case (gnc:option-value tr-report-style-op)
((multi-line)
html-table-entry-render-entries-first)
((merged)
html-table-entry-render-subentries-merged)
((single)
html-table-entry-render-entries-only))
(lambda (split)
(length
(gnc:split-get-other-splits split))))
(if (gnc:option-value (gnc:lookup-option options "Display" "Totals"))
(html-table-totals split-list split-report-specs)
'())
(html-end-table)
(html-end-document))))
(string-db 'store 'title "Transaction Report")

6
src/scm/text-export.scm
View File

@ -111,7 +111,7 @@
(list 'account
(let ((xfer-account (gnc:split-get-account split))
(xfer-account-id #f))
(if (not (pointer-token-null? xfer-account))
(if xfer-account
(set! xfer-account-id (gnc:account-get-id xfer-account)))
xfer-account-id))))
@ -133,7 +133,7 @@
(define (account-info->output-form a)
(let* ((accinfo (gnc:account-get-acc-info a))
(invacct (gnc:cast-to-inv-acct accinfo)))
(if (not (pointer-token-null? invacct))
(if invacct
(gnc:inv-acct-get-price-src invacct)
#f)))
@ -142,7 +142,7 @@
'account
(list 'guid (gnc:account-get-guid a))
(list 'name (gnc:account-get-name a))
(list 'type (gnc:account-type->symbol (gnc:account-get-type a)))
(list 'type (gnc:account-get-type-string a))
(list 'code (gnc:account-get-code a))
(list 'description (gnc:account-get-description a))
(list 'notes (gnc:account-get-notes a))