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/gnome/gnc-dialogs.glade: tweak stylesheet dialog

Browse Source 
* src/gnome/dialog-style-sheet.c: tweak looks

	* src/scm/report/register.scm: new report

	* src/guile/gnc.gwp: g-wrap new query api

	* src/gnome/window-register.c: add report menu and toolbar items

	* src/engine/Query.c: handle NULL pointers, add api to get list
	of splits with unique transactions


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3784 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
2001-03-15 12:43:01 +00:00
parent b151a7d9a4
commit 20e123a0ea
12 changed files with 625 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
ChangeLog
View File

@@ -1,3 +1,18 @@
2001-03-15 Dave Peticolas <dave@krondo.com>
* src/gnome/gnc-dialogs.glade: tweak stylesheet dialog
* src/gnome/dialog-style-sheet.c: tweak looks
* src/scm/report/register.scm: new report
* src/guile/gnc.gwp: g-wrap new query api
* src/gnome/window-register.c: add report menu and toolbar items
* src/engine/Query.c: handle NULL pointers, add api to get list
of splits with unique transactions
2001-03-14 Dave Peticolas <dave@krondo.com>
* rpm/gnucash.spec.in: simplify

42
src/engine/Query.c
View File

@@ -1102,6 +1102,36 @@ xaccQueryGetSplits(Query * q) {
return matching_splits;
}
/********************************************************************
* xaccQueryGetSplitsUniqueTrans
* Get splits but no more than one from a given transaction.
********************************************************************/
GList *
xaccQueryGetSplitsUniqueTrans(Query *q)
{
GList * splits = xaccQueryGetSplits(q);
GList * current;
GList * result = NULL;
GHashTable * trans_hash = g_hash_table_new(g_direct_hash, g_direct_equal);
for (current = splits; current; current = current->next)
{
Split *split = current->data;
if (!g_hash_table_lookup (trans_hash, split))
{
g_hash_table_insert (trans_hash, split, split);
result = g_list_prepend (result, split);
}
}
g_list_free (splits);
g_hash_table_destroy (trans_hash);
return g_list_reverse (result);
}
/********************************************************************
* xaccQueryGetTransactions
* Get transactions matching the query terms, specifying whether
@@ -2225,6 +2255,7 @@ xaccBalanceMatchPredicate(Split * s, PredicateData * pd) {
void
xaccQuerySetSortOrder(Query * q, sort_type_t primary,
sort_type_t secondary, sort_type_t tertiary) {
if (!q) return;
q->primary_sort = primary;
q->secondary_sort = secondary;
q->tertiary_sort = tertiary;
@@ -2240,6 +2271,7 @@ xaccQuerySetSortIncreasing(Query * q, gboolean prim_increasing,
gboolean sec_increasing,
gboolean tert_increasing)
{
if (!q) return;
q->primary_increasing = prim_increasing;
q->secondary_increasing = sec_increasing;
q->tertiary_increasing = tert_increasing;
@@ -2251,11 +2283,13 @@ xaccQuerySetSortIncreasing(Query * q, gboolean prim_increasing,
*******************************************************************/
void
xaccQuerySetMaxSplits(Query * q, int n) {
if (!q) return;
q->max_splits = n;
}
int
xaccQueryGetMaxSplits(Query * q) {
if (!q) return 0;
return q->max_splits;
}
@@ -2265,6 +2299,7 @@ xaccQueryGetMaxSplits(Query * q) {
*******************************************************************/
void
xaccQuerySetGroup(Query * q, AccountGroup * g) {
if (!q) return;
q->acct_group = g;
}
@@ -2274,6 +2309,7 @@ xaccQuerySetGroup(Query * q, AccountGroup * g) {
*******************************************************************/
AccountGroup *
xaccQueryGetGroup(Query * q) {
if (!q) return NULL;
return (q->acct_group);
}
@@ -2287,7 +2323,8 @@ xaccQueryGetEarliestDateFound(Query * q) {
Split * sp;
time_t earliest = LONG_MAX;
if(!q->split_list) { return 0; }
if (!q) return 0;
if (!q->split_list) return 0;
for(spl = q->split_list; spl; spl=spl->next) {
sp = spl->data;
@@ -2307,7 +2344,8 @@ xaccQueryGetLatestDateFound(Query * q) {
GList * spl;
time_t latest = 0;
if(!q->split_list) { return 0; }
if(!q) return 0;
if(!q->split_list) return 0;
for(spl = q->split_list; spl; spl=spl->next) {
sp = spl->data;

1
src/engine/Query.h
View File

@@ -236,6 +236,7 @@ GList * xaccQueryGetTerms(Query * q);
/* after the query has been set up, call this to run the query */
GList * xaccQueryGetSplits(Query * q);
GList * xaccQueryGetSplitsUniqueTrans(Query *q);
GList * xaccQueryGetTransactions(Query * q, query_run_t type);
/* handy for debugging */

11
src/gnome/dialog-style-sheet.c
View File

@@ -1,6 +1,6 @@
/********************************************************************
* dialog-style-sheet.c -- window for configuring HTML style *
* sheets in GnuCash *
* dialog-style-sheet.c -- window for configuring HTML style *
* sheets in GnuCash *
* Copyright (C) 2000 Bill Gribble <grib@billgribble.com> *
* *
* This program is free software; you can redistribute it and/or *
@@ -233,10 +233,13 @@ gnc_style_sheet_dialog_create() {
GTK_SIGNAL_FUNC(gnc_style_sheet_dialog_close_cb), ss);
gnc_style_sheet_dialog_fill(ss, SCM_BOOL_F);
gtk_window_set_policy(GTK_WINDOW(ss->toplevel), FALSE, TRUE, FALSE);
gtk_widget_set_usize(GTK_WIDGET(ss->toplevel), 400, 250);
gtk_window_set_policy(GTK_WINDOW(ss->toplevel), TRUE, TRUE, FALSE);
gtk_clist_columns_autosize (GTK_CLIST (ss->list));
gtk_widget_show(ss->toplevel);
return ss;
}

19
src/gnome/glade-gnc-dialogs.c
View File

@@ -6016,7 +6016,7 @@ GtkWidget*
create_HTML_Style_Sheet_Dialog (void)
{
GtkWidget *HTML_Style_Sheet_Dialog;
GtkWidget *hpaned1;
GtkWidget *hbox96;
GtkWidget *frame39;
GtkWidget *vbox92;
GtkWidget *scrolledwindow17;
@@ -6031,21 +6031,20 @@ create_HTML_Style_Sheet_Dialog (void)
gtk_object_set_data (GTK_OBJECT (HTML_Style_Sheet_Dialog), "HTML_Style_Sheet_Dialog", HTML_Style_Sheet_Dialog);
gtk_window_set_title (GTK_WINDOW (HTML_Style_Sheet_Dialog), _("HTML Style Sheets"));
hpaned1 = gtk_hpaned_new ();
gtk_widget_ref (hpaned1);
gtk_object_set_data_full (GTK_OBJECT (HTML_Style_Sheet_Dialog), "hpaned1", hpaned1,
hbox96 = gtk_hbox_new (FALSE, 2);
gtk_widget_ref (hbox96);
gtk_object_set_data_full (GTK_OBJECT (HTML_Style_Sheet_Dialog), "hbox96", hbox96,
(GtkDestroyNotify) gtk_widget_unref);
gtk_widget_show (hpaned1);
gtk_container_add (GTK_CONTAINER (HTML_Style_Sheet_Dialog), hpaned1);
gtk_paned_set_gutter_size (GTK_PANED (hpaned1), 15);
gtk_paned_set_position (GTK_PANED (hpaned1), 175);
gtk_widget_show (hbox96);
gtk_container_add (GTK_CONTAINER (HTML_Style_Sheet_Dialog), hbox96);
gtk_container_set_border_width (GTK_CONTAINER (hbox96), 5);
frame39 = gtk_frame_new (_("Style sheets"));
gtk_widget_ref (frame39);
gtk_object_set_data_full (GTK_OBJECT (HTML_Style_Sheet_Dialog), "frame39", frame39,
(GtkDestroyNotify) gtk_widget_unref);
gtk_widget_show (frame39);
gtk_paned_pack1 (GTK_PANED (hpaned1), frame39, TRUE, FALSE);
gtk_box_pack_start (GTK_BOX (hbox96), frame39, FALSE, FALSE, 0);
vbox92 = gtk_vbox_new (FALSE, 0);
gtk_widget_ref (vbox92);
@@ -6104,7 +6103,7 @@ create_HTML_Style_Sheet_Dialog (void)
gtk_object_set_data_full (GTK_OBJECT (HTML_Style_Sheet_Dialog), "style_sheet_options", style_sheet_options,
(GtkDestroyNotify) gtk_widget_unref);
gtk_widget_show (style_sheet_options);
gtk_paned_pack2 (GTK_PANED (hpaned1), style_sheet_options, TRUE, FALSE);
gtk_box_pack_start (GTK_BOX (hbox96), style_sheet_options, TRUE, TRUE, 0);
return HTML_Style_Sheet_Dialog;
}

20
src/gnome/gnc-dialogs.glade
View File

@@ -8904,11 +8904,11 @@ words.
<auto_shrink>False</auto_shrink>
<widget>
<class>GtkHPaned</class>
<name>hpaned1</name>
<handle_size>10</handle_size>
<gutter_size>15</gutter_size>
<position>175</position>
<class>GtkHBox</class>
<name>hbox96</name>
<border_width>5</border_width>
<homogeneous>False</homogeneous>
<spacing>2</spacing>
<widget>
<class>GtkFrame</class>
@@ -8917,8 +8917,9 @@ words.
<label_xalign>0</label_xalign>
<shadow_type>GTK_SHADOW_ETCHED_IN</shadow_type>
<child>
<shrink>False</shrink>
<resize>True</resize>
<padding>0</padding>
<expand>False</expand>
<fill>False</fill>
</child>
<widget>
@@ -9012,8 +9013,9 @@ words.
<label_xalign>0</label_xalign>
<shadow_type>GTK_SHADOW_ETCHED_IN</shadow_type>
<child>
<shrink>False</shrink>
<resize>True</resize>
<padding>0</padding>
<expand>True</expand>
<fill>True</fill>
</child>
<widget>

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

@@ -4,6 +4,7 @@
* Copyright (C) 1997-1998 Linas Vepstas <linas@linas.org> *
* Copyright (C) 1998 Rob Browning <rlb@cs.utexas.edu> *
* Copyright (C) 1999-2000 Dave Peticolas <dave@krondo.com> *
* Copyright (C) 2001 Gnumatic, Inc. *
* *
* This program is free software; you can redistribute it and/or *
* modify it under the terms of the GNU General Public License as *
@@ -29,6 +30,7 @@
#include "config.h"
#include <gnome.h>
#include <g-wrap-runtime-guile.h>
#include <time.h>
#include "AccWindow.h"
@@ -134,6 +136,7 @@ static void duplicateCB(GtkWidget *w, gpointer data);
static void recordCB(GtkWidget *w, gpointer data);
static void cancelCB(GtkWidget *w, gpointer data);
static void closeCB(GtkWidget *w, gpointer data);
static void reportCB(GtkWidget *w, gpointer data);
static void dateCB(GtkWidget *w, gpointer data);
static void expand_trans_cb(GtkWidget *widget, gpointer data);
static void new_trans_cb(GtkWidget *widget, gpointer data);
@@ -897,6 +900,15 @@ gnc_register_create_tool_bar (RegWindow *regData)
GNOME_APP_PIXMAP_STOCK, GNOME_STOCK_PIXMAP_SEARCH,
0, 0, NULL
},
{
GNOME_APP_UI_ITEM,
N_("Report"),
N_("Open a report window for this register"),
reportCB,
NULL, NULL,
GNOME_APP_PIXMAP_STOCK, GNOME_STOCK_PIXMAP_ATTACH,
0, 0, NULL
},
GNOMEUIINFO_SEPARATOR,
{
GNOME_APP_UI_ITEM,
@@ -1311,6 +1323,15 @@ gnc_register_create_menu_bar(RegWindow *regData, GtkWidget *statusbar)
GNOMEUIINFO_SUBTREE(N_("Sort _Order"), sort_menu),
GNOMEUIINFO_SUBTREE(N_("_Date Range"), date_menu),
GNOMEUIINFO_SEPARATOR,
{
GNOME_APP_UI_ITEM,
N_("Report"),
N_("Open a report window for this register"),
reportCB, NULL, NULL,
GNOME_APP_PIXMAP_NONE, NULL,
0, 0, NULL
},
GNOMEUIINFO_SEPARATOR,
{
GNOME_APP_UI_ITEM,
N_("Close"),
@@ -2867,6 +2888,43 @@ closeCB (GtkWidget *widget, gpointer data)
xaccLedgerDisplayClose (regData->ledger);
}
/********************************************************************\
* reportCB *
* *
* Args: widget - the widget that called us *
* data - regData - the data struct for this register *
* Return: none *
\********************************************************************/
static void
reportCB (GtkWidget *widget, gpointer data)
{
RegWindow *regData = data;
SplitRegister *reg = xaccLedgerDisplayGetSR (regData->ledger);
Query *query;
SCM query_type;
SCM query_scm;
SCM journal_scm;
SCM func;
query_type = gh_eval_str("<gnc:Query*>");
g_return_if_fail (query_type != SCM_UNDEFINED);
query = xaccLedgerDisplayGetQuery (regData->ledger);
g_return_if_fail (query != NULL);
query = xaccQueryCopy (query);
query_scm = gw_wcp_assimilate_ptr (query, query_type);
g_return_if_fail (query_scm != SCM_UNDEFINED);
journal_scm = gh_bool2scm (reg->style == REG_STYLE_JOURNAL);
func = gh_eval_str ("gnc:show-register-report");
g_return_if_fail (gh_procedure_p (func));
gh_call2 (func, query_scm, journal_scm);
}
/********************************************************************\
* dateCB *
* *

50
src/scm/report.scm
View File

@@ -41,22 +41,23 @@
(define (gnc:report-menu-setup win)
(define menu (gnc:make-menu "_Reports" (list "_Accounts")))
(define menu-namer (gnc:new-menu-namer))
(define (add-report-menu-item name report)
(let* ((title (string-append (_ "Report") ": " (_ name)))
(item #f))
(set! item
(gnc:make-menu-item
((menu-namer 'add-name) name)
(sprintf #f (_ "Display the %s report") name)
(list "_Reports" "")
(lambda ()
(let ((rept
(gnc:make-report (gnc:report-template-name report))))
(gnc:report-window rept)))))
(gnc:add-extension item)))
(if (gnc:report-in-menu? report)
(let* ((title (string-append (_ "Report") ": " (_ name)))
(item #f))
(set! item
(gnc:make-menu-item
((menu-namer 'add-name) name)
(sprintf #f (_ "Display the %s report") name)
(list "_Reports" "")
(lambda ()
(let ((rept (gnc:make-report
(gnc:report-template-name report))))
(gnc:report-window rept)))))
(gnc:add-extension item))))
;; add the menu option to edit style sheets
(gnc:add-extension menu)
(gnc:add-extension
@@ -66,17 +67,17 @@
(list "_Reports" "")
(lambda ()
(gnc:style-sheet-dialog-open))))
(gnc:add-extension
(gnc:make-separator (list "_Reports" "")))
;; push reports (new items added on top of menu)
(hash-for-each add-report-menu-item *gnc:_report-templates_*))
(define <report-template>
(make-record-type "<report-template>"
;; The data items in a report record
'(version name options-generator renderer)))
'(version name options-generator renderer in-menu?)))
(define (gnc:define-report . args)
;; For now the version is ignored, but in the future it'll let us
@@ -88,11 +89,11 @@
;; This code must return as its final value a string representing
;; the contents of the HTML document. preferably this should be
;; generated via the <html-document> class, but it's not required.
(define (blank-report)
;; Number of #f's == Number of data members
((record-constructor <report-template>) #f #f #f #f))
((record-constructor <report-template>) #f #f #f #f #t))
(define (args-to-defn in-report-rec args)
(let ((report-rec (if in-report-rec
in-report-rec
@@ -104,7 +105,7 @@
(remainder (cddr args)))
((record-modifier <report-template> id) report-rec value)
(args-to-defn report-rec remainder)))))
(let ((report-rec (args-to-defn #f args)))
(if (and report-rec
(gnc:report-template-name report-rec))
@@ -120,6 +121,8 @@
(record-accessor <report-template> 'options-generator))
(define gnc:report-template-renderer
(record-accessor <report-template> 'renderer))
(define gnc:report-in-menu?
(record-accessor <report-template> 'in-menu?))
(define (gnc:report-template-new-options report-template)
(let ((generator (gnc:report-template-options-generator report-template))
@@ -198,7 +201,7 @@
(car rest)
(gnc:report-template-new-options template))))
(gnc:report-set-options! r options))
(hash-set! *gnc:_reports_* (gnc:report-id r) r)
id))
@@ -230,7 +233,6 @@
(do-list tree)
retval))
(define (gnc:backtrace-if-exception proc . args)
(define (dumper key . args)
(let ((stack (make-stack #t dumper)))

1
src/scm/report/Makefile.am
View File

@@ -6,6 +6,7 @@ gncscm_DATA = \
average-balance.scm \
pnl.scm \
hello-world.scm \
register.scm \
report-list.scm \
stylesheet-plain.scm \
stylesheet-fancy.scm \

455
src/scm/report/register.scm Normal file
View File

@@ -0,0 +1,455 @@
;; -*-scheme-*-
;; register.scm
(require 'record)
(gnc:support "report/register.scm")
(gnc:depend "report-html.scm")
(gnc:depend "date-utilities.scm")
(let ()
(define-syntax addto!
(syntax-rules ()
((_ alist element) (set! alist (cons element alist)))))
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
(cons (- (gnc:html-table-num-rows table) 1)
(cons tag rest)))))
(apply gnc:html-table-set-row-style! arg-list)))
(define (used-date columns-used)
(vector-ref columns-used 0))
(define (used-num columns-used)
(vector-ref columns-used 1))
(define (used-description columns-used)
(vector-ref columns-used 2))
(define (used-account columns-used)
(vector-ref columns-used 3))
(define (used-other-account columns-used)
(vector-ref columns-used 4))
(define (used-shares columns-used)
(vector-ref columns-used 5))
(define (used-price columns-used)
(vector-ref columns-used 6))
(define (used-amount-single columns-used)
(vector-ref columns-used 7))
(define (used-amount-double-positive columns-used)
(vector-ref columns-used 8))
(define (used-amount-double-negative columns-used)
(vector-ref columns-used 9))
(define (used-running-balance columns-used)
(vector-ref columns-used 10))
(define columns-used-size 11)
(define (num-columns-required columns-used)
(do ((i 0 (+ i 1))
(col-req 0 col-req))
((>= i columns-used-size) col-req)
(if (vector-ref columns-used i) (set! col-req (+ col-req 1)))))
(define (build-column-used options)
(define (opt-val section name)
(gnc:option-value
(gnc:lookup-option options section name)))
(let ((column-list (make-vector 11 #f)))
(define (opt-val section name)
(gnc:option-value
(gnc:lookup-option options section name)))
(if (opt-val (N_ "Display") (N_ "Date"))
(vector-set! column-list 0 #t))
(if (opt-val (N_ "Display") (N_ "Num"))
(vector-set! column-list 1 #t))
(if (opt-val (N_ "Display") (N_ "Description"))
(vector-set! column-list 2 #t))
(if (opt-val (N_ "Display") (N_ "Account"))
(vector-set! column-list 3 #t))
(if (opt-val (N_ "Display") (N_ "Other Account"))
(vector-set! column-list 4 #t))
(if (opt-val (N_ "Display") (N_ "Shares"))
(vector-set! column-list 5 #t))
(if (opt-val (N_ "Display") (N_ "Price"))
(vector-set! column-list 6 #t))
; (gnc:warn "Amount Display" (opt-val (N_ "Display") (N_ "Amount")))
(let ((amount-setting (opt-val (N_ "Display") (N_ "Amount"))))
(if (eq? amount-setting 'single)
(vector-set! column-list 7 #t))
(if (eq? amount-setting 'double)
(begin
(vector-set! column-list 8 #t)
(vector-set! column-list 9 #t))))
(if (opt-val (N_ "Display") (N_ "Running Balance"))
(vector-set! column-list 10 #t))
; (gnc:debug "Column list:" column-list)
column-list))
(define (make-heading-list column-vector)
(let ((heading-list '()))
(gnc:debug "Column-vector" column-vector)
(if (used-date column-vector)
(addto! heading-list (N_ "Date")))
(if (used-num column-vector)
(addto! heading-list (N_ "Num")))
(if (used-description column-vector)
(addto! heading-list (N_ "Description")))
(if (used-account column-vector)
(addto! heading-list (N_ "Account")))
(if (used-other-account column-vector)
(addto! heading-list (N_ "Transfer from/to")))
(if (used-shares column-vector)
(addto! heading-list (N_ "Shares")))
(if (used-price column-vector)
(addto! heading-list (N_ "Price")))
(if (used-amount-single column-vector)
(addto! heading-list (N_ "Amount")))
;; FIXME: Proper labels: what?
(if (used-amount-double-positive column-vector)
(addto! heading-list (N_ "Debit")))
(if (used-amount-double-negative column-vector)
(addto! heading-list (N_ "Credit")))
(if (used-running-balance column-vector)
(addto! heading-list (N_ "Balance")))
(reverse heading-list)))
(define (add-split-row table split column-vector row-style)
(let* ((row-contents '())
(parent (gnc:split-get-parent split))
(account (gnc:split-get-account split))
(currency (gnc:account-get-commodity account))
(damount (gnc:split-get-share-amount split))
(split-value (gnc:make-gnc-monetary currency damount)))
(if (used-date column-vector)
(addto! row-contents (gnc:timepair-to-datestring
(gnc:transaction-get-date-posted parent))))
(if (used-num column-vector)
(addto! row-contents (gnc:transaction-get-num parent)))
(if (used-description column-vector)
(addto! row-contents (gnc:transaction-get-description parent)))
(if (used-account column-vector)
(addto! row-contents (gnc:account-get-name account)))
(if (used-other-account column-vector)
(addto! row-contents (gnc:split-get-corr-account-name split)))
(if (used-shares column-vector)
(addto! row-contents (gnc:split-get-share-amount split)))
(if (used-price column-vector)
(addto!
row-contents
(gnc:make-gnc-monetary currency (gnc:split-get-share-price split))))
(if (used-amount-single column-vector)
(addto! row-contents split-value))
(if (used-amount-double-positive column-vector)
(if (gnc:numeric-positive-p (gnc:gnc-monetary-amount split-value))
(addto! row-contents split-value)
(addto! row-contents " ")))
(if (used-amount-double-negative column-vector)
(if (gnc:numeric-negative-p (gnc:gnc-monetary-amount split-value))
(addto! row-contents (gnc:monetary-neg split-value))
(addto! row-contents " ")))
(if (used-running-balance column-vector)
(addto! row-contents
(gnc:make-gnc-monetary currency
(gnc:split-get-balance split))))
(gnc:html-table-append-row! table (reverse row-contents))
(apply set-last-row-style! (cons table (cons "tr" row-style)))
split-value))
(define (lookup-sort-key sort-option)
(vector-ref (cdr (assq sort-option comp-funcs-assoc-list)) 0))
(define (lookup-subtotal-pred sort-option)
(vector-ref (cdr (assq sort-option comp-funcs-assoc-list)) 1))
(define (reg-options-generator)
(define gnc:*report-options* (gnc:new-options))
(define (gnc:register-reg-option new-option)
(gnc:register-option gnc:*report-options* new-option))
(gnc:register-reg-option
(gnc:make-internal-option "__reg" "query" #f))
(gnc:register-reg-option
(gnc:make-internal-option "__reg" "journal" #f))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Date")
"b" (N_ "Display the date?") #t))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Num")
"c" (N_ "Display the check number?") #t))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Description")
"d" (N_ "Display the description?") #t))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Memo")
"f" (N_ "Display the memo?") #t))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Account")
"g" (N_ "Display the account?") #t))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Other Account")
"h" (N_ "Display the other account?
(if this is a split transaction, this parameter is guessed).") #f))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Shares")
"ha" (N_ "Display the number of shares?") #f))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Price")
"hb" "Display the shares price?" #f))
(gnc:register-reg-option
(gnc:make-multichoice-option
(N_ "Display") (N_ "Amount")
"i" (N_ "Display the amount?")
'single
(list
(vector 'none (N_ "None") (N_ "No amount display"))
(vector 'single (N_ "Single") (N_ "Single Column Display"))
(vector 'double (N_ "Double") (N_ "Two Column Display")))))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Headers")
"j" (N_ "Display the headers?") #t))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Running Balance")
"k" (N_ "Display a running balance") #f))
(gnc:register-reg-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Totals")
"l" (N_ "Display the totals?") #t))
(gnc:register-reg-option
(gnc:make-color-option
(N_ "Colors") (N_ "Split Odd")
"c" (N_ "Background color for odd-numbered splits (or main splits in a
multi-line report)")
(list #xff #xff #xff 0)
255
#f))
(gnc:register-reg-option
(gnc:make-color-option
(N_ "Colors") (N_ "Split Even")
"d" (N_ "Background color for even-numbered splits
(or \"other\" splits in a multi-line report)")
(list #xff #xff #xff 0)
255
#f))
(gnc:register-reg-option
(gnc:make-color-option
(N_ "Colors") (N_ "Grand Total")
"e" (N_ "Background color for total")
(list #xff #xff #xff 0)
255
#f))
(gnc:options-set-default-section gnc:*report-options*
"Report Options")
gnc:*report-options*)
(define (display-date-interval begin end)
(let ((begin-string (strftime "%x" (localtime (car begin))))
(end-string (strftime "%x" (localtime (car end)))))
(sprintf #f (_ "From %s To %s") begin-string end-string)))
(define (get-grand-total-style options)
(let ((bgcolor (gnc:lookup-option options
(N_ "Colors")
(N_ "Grand Total"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
(define (get-odd-row-style options)
(let ((bgcolor (gnc:lookup-option options
(N_ "Colors")
(N_ "Split Odd"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
(define (get-even-row-style options)
(let ((bgcolor (gnc:lookup-option options
(N_ "Colors")
(N_ "Split Even"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
(define (make-split-table splits options)
(define (add-subtotal-row table width subtotal-collector
subtotal-style)
(let ((currency-totals (subtotal-collector
'format gnc:make-gnc-monetary #f))
(blanks (make-list (- width 1) #f)))
(for-each (lambda (currency)
(gnc:html-table-append-row!
table
(append blanks (list currency)))
(apply set-last-row-style!
(cons table (cons "tr" subtotal-style))))
currency-totals)))
(define (reg-report-journal? options)
(gnc:option-value
(gnc:lookup-option options "__reg" "journal")))
(define (add-other-split-rows split table used-columns row-style)
(define (other-rows-driver split parent table used-columns i)
(let ((current (gnc:transaction-get-split parent i)))
(gnc:debug "i" i)
(gnc:debug "current" current)
(cond ((not current) #f)
((equal? current split)
(other-rows-driver split parent table used-columns (+ i 1)))
(else (begin
(add-split-row table current used-columns row-style)
(other-rows-driver split parent table used-columns
(+ i 1)))))))
(other-rows-driver split (gnc:split-get-parent split)
table used-columns 0))
(define (do-rows-with-subtotals splits
table
used-columns
width
multi-rows?
odd-row?
main-row-style
alternate-row-style
grand-total-style
total-collector)
(if (null? splits)
(add-subtotal-row table width total-collector grand-total-style)
(let* ((current (car splits))
(current-row-style (if multi-rows? main-row-style
(if odd-row? main-row-style
alternate-row-style)))
(rest (cdr splits))
(next (if (null? rest) #f
(car rest)))
(split-value (add-split-row
table
current
used-columns
current-row-style)))
(if multi-rows?
(add-other-split-rows
current table used-columns alternate-row-style))
(total-collector 'add
(gnc:gnc-monetary-commodity split-value)
(gnc:gnc-monetary-amount split-value))
(do-rows-with-subtotals rest
table
used-columns
width
multi-rows?
(not odd-row?)
main-row-style
alternate-row-style
grand-total-style
total-collector))))
(let* ((table (gnc:make-html-table))
(used-columns (build-column-used options))
(width (num-columns-required used-columns))
(multi-rows? (reg-report-journal? options))
(grand-total-style
(get-grand-total-style options))
(odd-row-style
(get-odd-row-style options))
(even-row-style
(get-even-row-style options)))
(gnc:html-table-set-col-headers!
table
(make-heading-list used-columns))
(do-rows-with-subtotals splits
table
used-columns
width
multi-rows?
#t
odd-row-style
even-row-style
grand-total-style
(gnc:make-commodity-collector))
table))
(define (reg-renderer report-obj)
(define (opt-val section name)
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
(let ((document (gnc:make-html-document))
(splits '())
(table '())
(query (opt-val "__reg" "query"))
(journal? (opt-val "__reg" "journal")))
(gnc:query-set-group query (gnc:get-current-group))
(set! splits (gnc:glist->list
(if journal?
(gnc:query-get-splits-unique-trans query)
(gnc:query-get-splits query))
<gnc:Split*>))
(set! table (make-split-table splits (gnc:report-options report-obj)))
(gnc:html-document-set-title! document (_ "Register Report"))
; (gnc:html-document-add-object!
; document
; (gnc:make-html-text
; (gnc:html-markup-h3 (display-date-interval begindate enddate))))
(gnc:html-document-add-object!
document
table)
document))
(gnc:define-report
'version 1
'name (N_ "Register")
'options-generator reg-options-generator
'renderer reg-renderer
'in-menu? #f))
(define (gnc:show-register-report query journal?)
(let* ((template (hash-ref *gnc:_report-templates_* "Register"))
(options (gnc:report-template-new-options template))
(qo (gnc:lookup-option options "__reg" "query"))
(jo (gnc:lookup-option options "__reg" "journal")))
(gnc:option-set-value qo query)
(gnc:option-set-value jo journal?)
(gnc:report-window (gnc:make-report "Register" options))))

1
src/scm/report/report-list.scm
View File

@@ -10,6 +10,7 @@
(gnc:depend "report/average-balance.scm")
(gnc:depend "report/hello-world.scm")
(gnc:depend "report/pnl.scm")
(gnc:depend "report/register.scm")
(let ((locale (setlocale LC_MESSAGES)))
(if (or (equal? locale "C")
(equal? locale "en")

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

@@ -467,7 +467,7 @@ transferred from/to's code"))
(gnc:register-trep-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Num")
"c" (N_ "Display the cheque number?") #t))
"c" (N_ "Display the check number?") #t))
(gnc:register-trep-option
(gnc:make-simple-boolean-option
(N_ "Display") (N_ "Description")