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

* src/scm/report/*: update several reports to use

Browse Source 
the new date option api.

	* src/scm/options.scm: change date options to return
	the same values as they accept.

	* src/guile/option-util.c: update for new date option api.
	wrap scheme api for C.

	* src/gnome/dialog-options.c: update for new date option api.
	fix bugs.

	* src/gnome/query-user.c: fixes for no toplevel window

	* src/gnome/window-main.c (gnc_main_window_get_toplevel): check
	for NULL


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3960 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
2001-04-13 09:47:23 +00:00
parent d07f9e2041
commit cc68a034d0
15 changed files with 174 additions and 127 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
ChangeLog
View File

@@ -1,3 +1,22 @@
2001-04-13 Dave Peticolas <dave@krondo.com>
* src/scm/report/*: update several reports to use
the new date option api.
* src/scm/options.scm: change date options to return
the same values as they accept.
* src/guile/option-util.c: update for new date option api.
wrap scheme api for C.
* src/gnome/dialog-options.c: update for new date option api.
fix bugs.
* src/gnome/query-user.c: fixes for no toplevel window
* src/gnome/window-main.c (gnc_main_window_get_toplevel): check
for NULL
2001-04-13 Christian Stimming <stimming@tuhh.de>
* src/scm/report/balance-sheet.scm: Cleanup code. Use new funcs

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

@@ -271,27 +271,24 @@ gnc_option_set_ui_value(GNCOption *option, gboolean use_default)
}
else if (safe_strcmp(type, "date") == 0)
{
SCM symbol;
int index;
char *date_option_type;
char *symbol_str;
date_option_type = gnc_option_date_option_get_subtype(option);
if (gh_vector_p(value))
if (gh_pair_p(value))
{
symbol = gh_vector_ref(value, gh_int2scm(0));
if(gh_symbol_p(symbol))
symbol_str = gnc_date_option_value_get_type (value);
if (symbol_str)
{
symbol_str = gh_symbol2newstr(symbol, NULL);
if (safe_strcmp(symbol_str, "relative") == 0)
{
index =
gnc_option_permissible_value_index(option,
gh_vector_ref(value,
gh_int2scm(2)));
SCM relative = gnc_date_option_value_get_relative (value);
index = gnc_option_permissible_value_index(option, relative);
if (safe_strcmp(date_option_type, "relative") == 0)
{
{
gtk_object_set_data(GTK_OBJECT(option->widget),
"gnc_multichoice_index",
GINT_TO_POINTER(index));
@@ -321,49 +318,45 @@ gnc_option_set_ui_value(GNCOption *option, gboolean use_default)
else if (safe_strcmp(symbol_str, "absolute") == 0)
{
Timespec ts;
SCM tp;
tp = gh_vector_ref(value, gh_int2scm(1));
if (gnc_timepair_p(tp))
{
ts = gnc_timepair2timespec(tp);
if (safe_strcmp(date_option_type, "absolute") == 0)
{
gnc_date_edit_set_time(GNC_DATE_EDIT(option->widget), ts.tv_sec);
}
else if (safe_strcmp(date_option_type, "both") == 0)
{
GList *widget_list;
GtkWidget *ab_widget;
widget_list =
gtk_container_children(GTK_CONTAINER(option->widget));
ab_widget = g_list_nth_data(widget_list,
GNC_RD_WID_AB_WIDGET_POS);
gnc_date_option_set_select_method(option, TRUE, TRUE);
gnc_date_edit_set_time(GNC_DATE_EDIT(option->widget), ts.tv_sec);
}
else
{
bad_value = TRUE;
}
}
else
{
bad_value = TRUE;
}
ts = gnc_date_option_value_get_absolute (value);
if (safe_strcmp(date_option_type, "absolute") == 0)
{
gnc_date_edit_set_time(GNC_DATE_EDIT(option->widget), ts.tv_sec);
}
else if (safe_strcmp(date_option_type, "both") == 0)
{
GList *widget_list;
GtkWidget *ab_widget;
widget_list =
gtk_container_children(GTK_CONTAINER(option->widget));
ab_widget = g_list_nth_data(widget_list,
GNC_RD_WID_AB_WIDGET_POS);
gnc_date_option_set_select_method(option, TRUE, TRUE);
gnc_date_edit_set_time(GNC_DATE_EDIT(ab_widget), ts.tv_sec);
}
else
{
bad_value = TRUE;
}
}
else
{
bad_value = TRUE;
}
free(symbol_str);
if (symbol_str)
free(symbol_str);
}
}
else
{
bad_value = TRUE;
}
g_free(date_option_type);
if (date_option_type)
free(date_option_type);
}
else if (safe_strcmp(type, "account-list") == 0)
{

29
src/gnome/query-user.c
View File

@@ -104,10 +104,9 @@ gnc_ok_cancel_dialog_parented(gncUIWidget parent, const char *message,
GNCVerifyResult
gnc_verify_cancel_dialog(const char * message, GNCVerifyResult default_res)
{
gnc_verify_cancel_dialog_parented(gnc_ui_get_toplevel(), message,
default_res);
return gnc_verify_cancel_dialog_parented(gnc_ui_get_toplevel(), message,
default_res);
}
GNCVerifyResult
@@ -202,11 +201,11 @@ gnc_verify_dialog_parented(gncUIWidget parent, const char *message,
GNOME_STOCK_BUTTON_NO,
NULL);
if (parent == NULL)
parent = gnc_ui_get_toplevel ();
if (parent != NULL)
gnome_dialog_set_parent(GNOME_DIALOG(verify_box), GTK_WINDOW(parent));
else
gnome_dialog_set_parent(GNOME_DIALOG(verify_box),
GTK_WINDOW(gnc_ui_get_toplevel()));
gnome_dialog_set_default(GNOME_DIALOG(verify_box), yes_is_default ? 0 : 1);
@@ -223,7 +222,12 @@ gnc_verify_dialog_parented(gncUIWidget parent, const char *message,
void
gnc_info_dialog(const char *message)
{
gnc_info_dialog_parented(GTK_WINDOW(gnc_ui_get_toplevel()), message);
GtkWidget *top = gnc_ui_get_toplevel ();
if (top)
gnc_info_dialog_parented (GTK_WINDOW(top), message);
else
gnc_info_dialog_parented (NULL, message);
}
/********************************************************************\
@@ -238,7 +242,7 @@ void
gnc_info_dialog_parented(GtkWindow *parent, const char *message)
{
GtkWidget *info_box = NULL;
info_box = gnome_ok_dialog_parented(message, parent);
gnome_dialog_run_and_close(GNOME_DIALOG(info_box));
@@ -269,7 +273,7 @@ void
gnc_warning_dialog_parented(GtkWidget *parent, const char *message)
{
GtkWidget *warning_box = NULL;
warning_box = gnome_warning_dialog_parented(message, GTK_WINDOW(parent));
gnome_dialog_run_and_close(GNOME_DIALOG(warning_box));
@@ -285,7 +289,12 @@ gnc_warning_dialog_parented(GtkWidget *parent, const char *message)
void
gnc_error_dialog(const char *message)
{
gnc_error_dialog_parented(GTK_WINDOW(gnc_ui_get_toplevel()), message);
GtkWidget *top = gnc_ui_get_toplevel ();
if (top)
gnc_error_dialog_parented(GTK_WINDOW(top), message);
else
gnc_error_dialog_parented(NULL, message);
}
/********************************************************************\

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

@@ -358,7 +358,12 @@ gnc_main_window_child_refresh(gpointer data) {
GtkWidget *
gnc_main_window_get_toplevel(GNCMainInfo * wind) {
return GTK_WIDGET(gnome_mdi_get_active_window(GNOME_MDI(wind->mdi)));
GnomeApp *app = gnome_mdi_get_active_window(GNOME_MDI(wind->mdi));
if (app)
return GTK_WIDGET(app);
return NULL;
}

22
src/scm/options.scm
View File

@@ -149,7 +149,7 @@
(let* ((option-data-fns (gnc:option-data-fns option))
(name-fn (vector-ref option-data-fns 4)))
(name-fn value)))
(define (gnc:option-number-of-indices option)
(let* ((option-data-fns (gnc:option-data-fns option))
(name-fn (vector-ref option-data-fns 0)))
@@ -410,11 +410,7 @@
(string-append "'" (gnc:value->string value)))))
(gnc:make-option
section name sort-tag 'date documentation-string
(lambda ()
(if (eq? (car value) 'relative)
(vector 'relative (gnc:get-absolute-from-relative-date
(cdr value)) (cdr value))
(vector 'absolute (cdr value))))
(lambda () value)
(lambda (date)
(if (date-legal date)
(set! value date)
@@ -455,12 +451,18 @@
(gnc:get-rd-option-data-show-time (gnc:option-data option))
(gnc:error "Not a date option")))
(define (gnc:date-option-absolute-time option-value)
(vector-ref option-value 1))
(define (gnc:date-option-value-type option-value)
(vector-ref option-value 0))
(car option-value))
(define (gnc:date-option-absolute-time option-value)
(if (eq? (car option-value) 'absolute)
(cdr option-value)
(gnc:get-absolute-from-relative-date (cdr option-value))))
(define (gnc:date-option-relative-time option-value)
(vector-ref option-value 2))
(if (eq? (car option-value) 'absolute)
#f
(cdr option-value)))
;; account-list options use the option-data as a boolean value. If
;; true, the gui should allow the user to select multiple accounts.

12
src/scm/report/account-piecharts.scm
View File

@@ -152,13 +152,12 @@ balance at a given time"))
;; Get all options
(let ((to-date-tp (gnc:timepair-end-day-time
(vector-ref (op-value pagename-general
optname-to-date) 1)))
(gnc:date-option-absolute-time
(op-value pagename-general optname-to-date))))
(from-date-tp (if do-intervals?
(gnc:timepair-start-day-time
(vector-ref
(op-value pagename-general
optname-from-date) 1))
(gnc:date-option-absolute-time
(op-value pagename-general optname-from-date)))
'()))
(accounts (op-value pagename-accounts optname-accounts))
(account-levels (op-value pagename-accounts optname-levels))
@@ -195,7 +194,6 @@ balance at a given time"))
(gnc:account-get-comm-balance-at-date
account to-date-tp subaccts?)))
;; Define more helper variables.
(let* ((exchange-alist (gnc:make-exchange-alist
report-currency to-date-tp))
@@ -351,7 +349,7 @@ balance at a given time"))
(gnc:amount->string total print-info)))
"")))
(let ((urls
(map
(lambda (pair)

9
src/scm/report/account-summary.scm
View File

@@ -130,11 +130,12 @@
(report-currency (get-option pagename-general
optname-report-currency))
(date-tp (gnc:timepair-end-day-time
(vector-ref (get-option pagename-general
optname-date) 1)))
(gnc:date-option-absolute-time
(get-option pagename-general
optname-date))))
(doc (gnc:make-html-document))
(txt (gnc:make-html-text)))
(gnc:html-document-set-title! doc (_ "Account Summary"))
(if (not (null? accounts))
;; if no max. tree depth is given we have to find the
@@ -178,7 +179,7 @@
(_ "This report requires accounts to be selected.")))
(gnc:html-document-add-object! doc p)))
doc))
(gnc:define-report
'version 1
'name (N_ "Account Summary")

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

@@ -87,7 +87,8 @@
(list 'GLPlot (N_ "Gain/Loss") (N_ "Gain And Loss"))))))
(gnc:options-add-plot-size!
options pagename-display (N_ "Plot Width") (N_ "Plot Height") "d" 400 400)
options pagename-display (N_ "Plot Width") (N_ "Plot Height")
"d" 400 400)
;; Set the general page as default option tab
(gnc:options-set-default-section options pagename-general)
@@ -202,8 +203,9 @@
;; output a row of info
(output-row)
(set! interval-start (incdate interval-start interval))
(set! interval-end (decdate (incdate interval-start interval) SecDelta))
(set! interval-end
(decdate (incdate interval-start interval) SecDelta))
;; reset collectors
(minmax-accum 'reset #f)
(gain-loss-accum 'reset #f)
@@ -260,8 +262,8 @@
(gnc:timepair-previous-day begindate)))
;; startbal will be a commodity-collector
(startbal '()))
(define (collector->double commodity-collector )
(define (collector->double commodity-collector)
(gnc:numeric-to-double
(gnc:gnc-monetary-amount
(gnc:sum-collector-commodity commodity-collector
@@ -294,8 +296,9 @@
;; Beware: delete-duplicates is an O(n^2)
;; algorithm. More efficient method: sort the list,
;; then use a linear algorithm.
(set! accounts (delete-duplicates (append accounts subaccts)))))
(set! accounts
(delete-duplicates (append accounts subaccts)))))
(gnc:query-add-account-match
query (gnc:list->glist accounts)
'acct-match-any 'query-and)
@@ -405,7 +408,7 @@
'(2 3 4 5 6 7))
(gnc:html-document-add-object! document table))))
;; if there are no accounts selected...
(let ((p (gnc:make-html-text)))
(gnc:html-text-append!

12
src/scm/report/balance-sheet.scm
View File

@@ -32,9 +32,8 @@
;; in *one* place.
(let* ((pagename-general (N_ "General"))
(optname-from-date (N_ "From"))
(optname-to-date (N_ "To"))
(pagename-accounts (N_ "Accounts"))
(optname-display-depth (N_ "Account Display Depth"))
(optname-show-subaccounts (N_ "Always show sub-accounts"))
@@ -142,8 +141,9 @@
(report-currency (get-option pagename-currencies
optname-report-currency))
(to-date-tp (gnc:timepair-end-day-time
(vector-ref (get-option pagename-general
optname-to-date) 1)))
(gnc:date-option-absolute-time
(get-option pagename-general
optname-to-date))))
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
@@ -157,7 +157,6 @@
(append (assoc-ref split-up-accounts 'income)
(assoc-ref split-up-accounts 'expense)))
(doc (gnc:make-html-document))
(txt (gnc:make-html-text))
(tree-depth (if (equal? display-depth 'all)
@@ -255,7 +254,6 @@
total-equity-balance
#f)
;; Now concatenate the tables. This first prepend-row has
;; to be written out by hand -- we can't use the function
;; append-something because we have to prepend.
@@ -264,7 +262,7 @@
(list (gnc:html-acct-table-cell (* (if show-fcur? 3 2)
tree-depth)
(_ "Assets") #t)))
(add-subtotal-line
asset-table (_ "Assets") asset-balance)

10
src/scm/report/category-barchart.scm
View File

@@ -145,15 +145,15 @@
(gnc:report-options report-obj) section name)))
(let ((to-date-tp (gnc:timepair-end-day-time
(vector-ref (get-option pagename-general
optname-to-date) 1)))
(gnc:date-option-absolute-time
(get-option pagename-general optname-to-date))))
(from-date-tp (gnc:timepair-start-day-time
(vector-ref (get-option pagename-general
optname-from-date) 1)))
(gnc:date-option-absolute-time
(get-option pagename-general optname-from-date))))
(interval (get-option pagename-general optname-stepsize))
(report-currency (get-option pagename-general
optname-report-currency))
(accounts (get-option pagename-accounts optname-accounts))
(account-levels (get-option pagename-accounts optname-levels))

12
src/scm/report/income-expense-graph.scm
View File

@@ -117,11 +117,13 @@
exchange-fn)))))
(let* ((to-date-tp (gnc:timepair-end-day-time
(vector-ref (op-value pagename-general
optname-to-date) 1)))
(from-date-tp (gnc:timepair-start-day-time
(vector-ref (op-value pagename-general
optname-from-date) 1)))
(gnc:date-option-absolute-time
(op-value pagename-general
optname-to-date))))
(from-date-tp (gnc:timepair-start-day-time
(gnc:date-option-absolute-time
(op-value pagename-general
optname-from-date))))
(interval (op-value pagename-general optname-stepsize))
(accounts (op-value pagename-accounts optname-accounts))
(report-currency (op-value pagename-general

17
src/scm/report/net-worth-timeseries.scm
View File

@@ -123,11 +123,11 @@
(let* ((to-date-tp (gnc:timepair-end-day-time
(vector-ref (op-value pagename-general
optname-to-date) 1)))
(gnc:date-option-absolute-time
(op-value pagename-general optname-to-date))))
(from-date-tp (gnc:timepair-start-day-time
(vector-ref (op-value pagename-general
optname-from-date) 1)))
(gnc:date-option-absolute-time
(op-value pagename-general optname-from-date))))
(interval (op-value pagename-general optname-stepsize))
(accounts (op-value pagename-accounts optname-accounts))
(classified-accounts (gnc:decompose-accountlist accounts))
@@ -158,8 +158,11 @@
(eval interval)))
(dummy134 (gnc:debug "dates-list" dates-list))
(assets-collector-list (collector-fn asset-accounts dates-list))
(expense-collector-list (collector-fn liability-equity-accounts dates-list))
(net-collector-list (map collector-combine assets-collector-list expense-collector-list))
(expense-collector-list
(collector-fn liability-equity-accounts dates-list))
(net-collector-list
(map collector-combine assets-collector-list
expense-collector-list))
(assets-list
(map (collector-to-double-fn report-currency exchange-fn-internal)
assets-collector-list))
@@ -190,7 +193,7 @@
(gnc:html-barchart-set-row-labels-rotated?!
chart (< (/ (- width 200)
(length date-string-list)) 60))
(if show-sep?
(begin
(gnc:html-barchart-append-column! chart assets-list)

12
src/scm/report/pnl.scm
View File

@@ -126,11 +126,13 @@
(report-currency (get-option pagename-currencies
optname-report-currency))
(to-date-tp (gnc:timepair-end-day-time
(vector-ref (get-option pagename-general
optname-to-date) 1)))
(gnc:date-option-absolute-time
(get-option pagename-general
optname-to-date))))
(from-date-tp (gnc:timepair-start-day-time
(vector-ref (get-option pagename-general
optname-from-date) 1)))
(gnc:date-option-absolute-time
(get-option pagename-general
optname-from-date))))
(doc (gnc:make-html-document)))
(gnc:html-document-set-title!
@@ -176,7 +178,7 @@
(_ "This report requires accounts to be selected.")))
(gnc:html-document-add-object! doc p)))
doc))
(gnc:define-report
'version 1
'name (N_ "Profit And Loss")

3
src/scm/report/portfolio.scm
View File

@@ -105,7 +105,8 @@
;; The first thing we do is make local variables for all the specific
;; options in the set of options given to the function. This set will
;; be generated by the options generator above.
(let ((to-date (vector-ref (op-value "General" "Date") 1))
(let ((to-date (gnc:date-option-absolute-time
(op-value "General" "Date")))
(accounts (op-value "General" "Accounts"))
(currency (op-value "General" "Report Currency"))
(collector (gnc:make-commodity-collector))

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

@@ -50,9 +50,10 @@
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
(cons (- (gnc:html-table-num-rows table) 1) (cons tag rest)))))
(cons (- (gnc:html-table-num-rows table) 1)
(cons tag rest)))))
(apply gnc:html-table-set-row-style! arg-list)))
(define (add-subheading-row data table width subheading-style)
(let ((heading-cell (gnc:make-html-table-cell data)))
(gnc:html-table-cell-set-colspan! heading-cell width)
@@ -95,7 +96,7 @@
(gnc:transaction-get-date-posted
(gnc:split-get-parent split))))
table width subheading-style))
(let ()
(define account-types-to-reverse-assoc-list
@@ -235,17 +236,21 @@
(addto! heading-list (_ "Balance")))
(reverse heading-list)))
(define (add-split-row table split column-vector row-style account-types-to-reverse transaction-row?)
(define (add-split-row table split column-vector
row-style account-types-to-reverse transaction-row?)
(let* ((row-contents '())
(parent (gnc:split-get-parent split))
(account (gnc:split-get-account split))
(account-type (gw:enum-<gnc:AccountType>-val->sym (gnc:account-get-type account) #f))
(account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type account) #f))
(currency (gnc:account-get-commodity account))
(damount (gnc:split-get-share-amount split))
(dummy1 (begin
(gnc:debug "account-type" account-type)
(gnc:debug "account-types-to-reverse" account-types-to-reverse)
(gnc:debug "member result" (member account-type account-types-to-reverse))
(gnc:debug "account-types-to-reverse"
account-types-to-reverse)
(gnc:debug "member result"
(member account-type account-types-to-reverse))
#f))
(split-value (gnc:make-gnc-monetary
currency
@@ -452,7 +457,7 @@
(vector 'descend
(N_ "Descending")
(N_ "largest to smallest, latest to earliest")))))
(gnc:register-trep-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Date")
@@ -675,7 +680,8 @@ and Income accounts")))))
(gnc:lookup-option options (N_ "General") (N_ "Style")))
'multi-line))
(define (add-other-split-rows split table used-columns row-style account-types-to-reverse)
(define (add-other-split-rows split table used-columns
row-style account-types-to-reverse)
(define (other-rows-driver split parent table used-columns i)
(let ((current (gnc:transaction-get-split parent i)))
(gnc:debug "i" i)
@@ -684,7 +690,8 @@ and Income accounts")))))
((equal? current split)
(other-rows-driver split parent table used-columns (+ i 1)))
(else (begin
(add-split-row table current used-columns row-style account-types-to-reverse #f)
(add-split-row table current used-columns
row-style account-types-to-reverse #f)
(other-rows-driver split parent table used-columns
(+ i 1)))))))
@@ -758,7 +765,8 @@ and Income accounts")))))
secondary-subtotal-style)
(secondary-subtotal-collector 'reset #f #f)
(if next
(secondary-subheading-renderer next table width secondary-subtotal-style))))
(secondary-subheading-renderer
next table width secondary-subtotal-style))))
(if (and primary-subtotal-pred
(or (not next)
(and next
@@ -768,7 +776,8 @@ and Income accounts")))))
primary-subtotal-style)
(primary-subtotal-collector 'reset #f #f)
(if next
(primary-subheading-renderer next table width primary-subtotal-style))))
(primary-subheading-renderer
next table width primary-subtotal-style))))
(do-rows-with-subtotals rest
table
used-columns
@@ -819,17 +828,19 @@ and Income accounts")))))
; (gnc:warn "Splits:" splits)
(if (not (null? splits))
(if primary-subheading-renderer
(primary-subheading-renderer (car splits) table width primary-subtotal-style))
(primary-subheading-renderer
(car splits) table width primary-subtotal-style))
(if secondary-subheading-renderer
(secondary-subheading-renderer (car splits) table widthsecondary-subtotal-style)))
(secondary-subheading-renderer
(car splits) table widthsecondary-subtotal-style)))
(do-rows-with-subtotals splits table used-columns width
multi-rows? #t
account-types-to-reverse
primary-subtotal-pred
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
secondary-subheading-renderer
odd-row-style
even-row-style
primary-subtotal-style