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

Merge branch 'maint'

Browse Source
This commit is contained in:
John Ralls 2019-11-04 14:09:46 -08:00
commit ba5bd6b4d7
22 changed files with 1100 additions and 483 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gnucash/gnome-search/dialog-search.c
View File

@ -991,6 +991,16 @@ gnc_search_dialog_add_criterion (GNCSearchWindow *sw)
static void
add_criterion (GtkWidget *button, GNCSearchWindow *sw)
{
gint number_of_buttons = g_list_length (sw->crit_list) + 1;
gint button_height = gtk_widget_get_allocated_height (button);
gint min_height = MIN (number_of_buttons * button_height, 5 * button_height);
// this sets the minimum content height for the criteria scroll
// window, it is set to a max of 5 buttons visible without scrolling
gtk_scrolled_window_set_min_content_height (GTK_SCROLLED_WINDOW(
sw->criteria_scroll_window),
min_height + (button_height/2));
gnc_search_dialog_add_criterion (sw);
}

3
gnucash/gnome-utils/gnc-tree-model-account.c
View File

@ -1427,7 +1427,8 @@ gnc_tree_model_account_event_handler (QofInstance *entity,
account = GNC_ACCOUNT(entity);
/* clear the cached model values for account */
gnc_tree_model_account_clear_cached_values (model, account);
if (event_type != QOF_EVENT_ADD)
gnc_tree_model_account_clear_cached_values (model, account);
if (gnc_account_get_book (account) != priv->book)
{

75
gnucash/gnome/gnc-plugin-page-register.c
View File

@ -54,6 +54,7 @@
#include "dialog-find-account.h"
#include "dialog-find-transactions.h"
#include "dialog-print-check.h"
#include "dialog-invoice.h"
#include "dialog-transfer.h"
#include "dialog-utils.h"
#include "assistant-stock-split.h"
@ -184,6 +185,7 @@ static void gnc_plugin_page_register_cmd_transaction_report (GtkAction *action,
static void gnc_plugin_page_register_cmd_associate_file_transaction (GtkAction *action, GncPluginPageRegister *plugin_page);
static void gnc_plugin_page_register_cmd_associate_location_transaction (GtkAction *action, GncPluginPageRegister *plugin_page);
static void gnc_plugin_page_register_cmd_execassociated_transaction (GtkAction *action, GncPluginPageRegister *plugin_page);
static void gnc_plugin_page_register_cmd_jump_associated_invoice (GtkAction *action, GncPluginPageRegister *plugin_page);
static void gnc_plugin_page_help_changed_cb( GNCSplitReg *gsr, GncPluginPageRegister *register_page );
static void gnc_plugin_page_popup_menu_cb( GNCSplitReg *gsr, GncPluginPageRegister *register_page );
@ -197,6 +199,8 @@ static void gnc_plugin_page_register_event_handler (QofInstance *entity,
GncPluginPageRegister *page,
GncEventData *ed);
static GncInvoice * invoice_from_trans (Transaction *trans);
/************************************************************/
/* Actions */
/************************************************************/
@ -209,6 +213,7 @@ static void gnc_plugin_page_register_event_handler (QofInstance *entity,
#define ASSOCIATE_TRANSACTION_FILE_LABEL N_("_Associate File with Transaction")
#define ASSOCIATE_TRANSACTION_LOCATION_LABEL N_("_Associate Location with Transaction")
#define EXECASSOCIATED_TRANSACTION_LABEL N_("_Open Associated File/Location")
#define JUMP_ASSOCIATED_INVOICE_LABEL N_("Open Associated Invoice")
#define CUT_SPLIT_LABEL N_("Cu_t Split")
#define COPY_SPLIT_LABEL N_("_Copy Split")
#define PASTE_SPLIT_LABEL N_("_Paste Split")
@ -222,6 +227,7 @@ static void gnc_plugin_page_register_event_handler (QofInstance *entity,
#define ASSOCIATE_TRANSACTION_FILE_TIP N_("Associate a file with the current transaction")
#define ASSOCIATE_TRANSACTION_LOCATION_TIP N_("Associate a location with the current transaction")
#define EXECASSOCIATED_TRANSACTION_TIP N_("Open the associated file or location with the current transaction")
#define JUMP_ASSOCIATED_INVOICE_TIP N_("Open the associated invoice")
#define CUT_SPLIT_TIP N_("Cut the selected split into clipboard")
#define COPY_SPLIT_TIP N_("Copy the selected split into clipboard")
#define PASTE_SPLIT_TIP N_("Paste the split from the clipboard")
@ -339,6 +345,11 @@ static GtkActionEntry gnc_plugin_page_register_actions [] =
EXECASSOCIATED_TRANSACTION_TIP,
G_CALLBACK (gnc_plugin_page_register_cmd_execassociated_transaction)
},
{
"JumpAssociatedInvoiceAction", NULL, JUMP_ASSOCIATED_INVOICE_LABEL, NULL,
JUMP_ASSOCIATED_INVOICE_TIP,
G_CALLBACK (gnc_plugin_page_register_cmd_jump_associated_invoice)
},
/* View menu */
@ -513,6 +524,7 @@ static action_toolbar_labels toolbar_labels[] =
{ "AssociateTransactionFileAction", N_("Associate File") },
{ "AssociateTransactionLocationAction", N_("Associate Location") },
{ "ExecAssociatedTransactionAction", N_("Open File/Location") },
{ "JumpAssociatedInvoiceAction", N_("Open Invoice") },
{ NULL, NULL },
};
@ -890,6 +902,7 @@ static const char* tran_action_labels[] =
ASSOCIATE_TRANSACTION_FILE_LABEL,
ASSOCIATE_TRANSACTION_LOCATION_LABEL,
EXECASSOCIATED_TRANSACTION_LABEL,
JUMP_ASSOCIATED_INVOICE_LABEL,
NULL
};
@ -904,6 +917,7 @@ static const char* tran_action_tips[] =
ASSOCIATE_TRANSACTION_FILE_TIP,
ASSOCIATE_TRANSACTION_LOCATION_TIP,
EXECASSOCIATED_TRANSACTION_TIP,
JUMP_ASSOCIATED_INVOICE_TIP,
NULL
};
@ -937,6 +951,7 @@ gnc_plugin_page_register_ui_update (gpointer various, GncPluginPageRegister *pag
GtkAction *action;
gboolean expanded, voided, read_only = FALSE;
Transaction *trans;
GncInvoice *inv;
CursorClass cursor_class;
const char *uri;
@ -1009,6 +1024,12 @@ gnc_plugin_page_register_ui_update (gpointer various, GncPluginPageRegister *pag
"ExecAssociatedTransactionAction");
gtk_action_set_sensitive (GTK_ACTION(action), (uri && *uri));
/* Set 'ExecAssociatedInvoice' */
inv = invoice_from_trans(trans);
action = gnc_plugin_page_get_action (GNC_PLUGIN_PAGE(page),
"JumpAssociatedInvoiceAction");
gtk_action_set_sensitive (GTK_ACTION(action), (!(!inv)));
gnc_plugin_business_split_reg_ui_update (GNC_PLUGIN_PAGE(page));
/* If we are in a readonly book, make any modifying action inactive */
@ -4307,6 +4328,60 @@ gnc_plugin_page_register_cmd_execassociated_transaction (GtkAction *action,
}
static GncInvoice * invoice_from_trans (Transaction *trans)
{
GncInvoice *invoice;
SplitList *splits;
g_return_if_fail (GNC_IS_TRANSACTION(trans));
invoice = gncInvoiceGetInvoiceFromTxn(trans);
if (invoice)
return invoice;
for (splits = xaccTransGetSplitList (trans); splits; splits = splits->next)
{
Split *split = splits->data;
GNCLot *lot;
if (!split)
continue;
lot = xaccSplitGetLot (split);
if (!lot)
continue;
invoice = gncInvoiceGetInvoiceFromLot (lot);
if (!invoice)
continue;
return invoice;
}
return NULL;
}
static void
gnc_plugin_page_register_cmd_jump_associated_invoice (GtkAction *action,
GncPluginPageRegister *plugin_page)
{
GncPluginPageRegisterPrivate *priv;
SplitRegister *reg;
GncInvoice *invoice;
ENTER("(action %p, plugin_page %p)", action, plugin_page);
g_return_if_fail(GNC_IS_PLUGIN_PAGE_REGISTER(plugin_page));
priv = GNC_PLUGIN_PAGE_REGISTER_GET_PRIVATE(plugin_page);
reg = gnc_ledger_display_get_split_register (priv->gsr->ledger);
invoice = invoice_from_trans (xaccSplitGetParent
(gnc_split_register_get_current_split (reg)));
if (invoice)
gnc_ui_invoice_edit (NULL, invoice);
LEAVE(" ");
}
static void
gnc_plugin_page_register_cmd_blank_transaction (GtkAction *action,
GncPluginPageRegister *plugin_page)

2
gnucash/gtkbuilder/dialog-search.glade
View File

@ -302,7 +302,7 @@
</child>
</object>
<packing>
<property name="expand">True</property>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>

2
gnucash/import-export/aqb/gnc-ab-utils.c
View File

@ -331,7 +331,7 @@ join_ab_strings_cb(const gchar *str, gpointer user_data)
tmp = g_strdup(str);
g_strstrip(tmp);
gnc_utf8_strip_invalid(tmp);
gnc_utf8_strip_invalid_and_controls(tmp);
if (*acc)
{

12
gnucash/import-export/aqb/gnc-gwen-gui.c
View File

@ -1045,9 +1045,17 @@ get_input(GncGWENGui *gui, guint32 flags, const gchar *title,
gtk_widget_set_visible(input_entry, TRUE);
}
if (gui->parent)
if (gui->dialog)
{
gtk_window_set_transient_for(GTK_WINDOW(dialog),
GTK_WINDOW(gui->parent));
GTK_WINDOW(gui->dialog));
}
else
{
if (gui->parent)
gtk_window_set_transient_for(GTK_WINDOW(dialog),
GTK_WINDOW(gui->parent));
}
if (title)
gtk_window_set_title(GTK_WINDOW(dialog), title);

102
gnucash/import-export/qif-imp/qif-guess-map.scm
View File

@ -184,13 +184,14 @@
;; of bogus accounts if you have funny stuff in your map.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:write-map hashtab)
(define (qif-import:write-map hashtab port)
(let ((table '()))
(hash-fold
(lambda (key value p)
(set! table (cons (cons key (record-fields->list value)) table))
#f) #f hashtab)
(write table)))
(hash-for-each
(lambda (key value)
(set! table
(cons (cons key (record-fields->list value)) table)))
hashtab)
(write table port)))
(define (qif-import:read-map tablist tab-sep)
(let* ((table (make-hash-table 20))
@ -255,34 +256,29 @@
;; GnuCash commodity namespaces and mnemonics (symbols).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:write-securities security-hash security-prefs)
(define (qif-import:write-securities security-hash security-prefs port)
(let ((table '()))
;; For each security that has been paired with an existing
;; GnuCash commodity, create a list containing the QIF name
;; and the commodity's namespace and mnemonic (symbol).
(hash-fold
(lambda (key value p)
;;FIXME: we used to type-check the values, like:
;; (gw:wcp-is-of-type? <gnc:commodity*> value)
(if (and value #t)
(set! table (cons (list key
(gnc-commodity-get-namespace value)
(gnc-commodity-get-mnemonic value))
table))
(gnc:warn "qif-import:write-securities:"
" something funny in hash table."))
#f)
#f security-hash)
(hash-for-each
(lambda (key value)
(set! table
(cons (list key
(gnc-commodity-get-namespace value)
(gnc-commodity-get-mnemonic value))
table)))
security-hash)
;; Add on the rest of the saved security mapping preferences.
(for-each
(lambda (m)
(if (not (hash-ref security-hash (car m)))
(set! table (cons m table))))
security-prefs)
(lambda (m)
(if (not (hash-ref security-hash (car m)))
(set! table (cons m table))))
security-prefs)
;; Write out the mappings.
(write table)))
(write table port)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -301,38 +297,38 @@
;; This procedure does all the work. We'll define it, then call it safely.
(define (private-save)
(with-output-to-file (gnc-build-userdata-path "qif-accounts-map")
(lambda ()
(display ";;; qif-accounts-map")
(newline)
(display ";;; Automatically generated by GnuCash. DO NOT EDIT.")
(newline)
(display ";;; (Unless you really, really want to.)")
(newline)
(display ";;; Map QIF accounts to GnuCash accounts")
(newline)
(qif-import:write-map acct-map)
(newline)
(call-with-output-file (gnc-build-userdata-path "qif-accounts-map")
(lambda (port)
(display ";;; qif-accounts-map" port)
(newline port)
(display ";;; Automatically generated by GnuCash. DO NOT EDIT." port)
(newline port)
(display ";;; (Unless you really, really want to.)" port)
(newline port)
(display ";;; Map QIF accounts to GnuCash accounts" port)
(newline port)
(qif-import:write-map acct-map port)
(newline port)
(display ";;; Map QIF categories to GnuCash accounts")
(newline)
(qif-import:write-map cat-map)
(newline)
(display ";;; Map QIF categories to GnuCash accounts" port)
(newline port)
(qif-import:write-map cat-map port)
(newline port)
(display ";;; Map QIF payee/memo to GnuCash accounts")
(newline)
(qif-import:write-map memo-map)
(newline)
(display ";;; Map QIF payee/memo to GnuCash accounts" port)
(newline port)
(qif-import:write-map memo-map port)
(newline port)
(display ";;; Map QIF security names to GnuCash commodities")
(newline)
(qif-import:write-securities security-map security-prefs)
(newline)
(display ";;; Map QIF security names to GnuCash commodities" port)
(newline port)
(qif-import:write-securities security-map security-prefs port)
(newline port)
(display ";;; GnuCash separator used in these mappings")
(newline)
(write (gnc-get-account-separator-string))
(newline)))
(display ";;; GnuCash separator used in these mappings" port)
(newline port)
(write (gnc-get-account-separator-string) port)
(newline port)))
#t)
;; Safely save the file.

634
gnucash/report/html-utilities.scm
View File

@ -53,68 +53,6 @@
(string-append "price-guid=" (gncPriceGetGUID price))
""))
(define (guid-ref idstr type guid)
(gnc-build-url type (string-append idstr guid) ""))
(define (gnc:customer-anchor-text customer)
(guid-ref "customer=" URL-TYPE-CUSTOMER (gncCustomerReturnGUID customer)))
(define (gnc:job-anchor-text job)
(guid-ref "job=" URL-TYPE-JOB (gncJobReturnGUID job)))
(define (gnc:vendor-anchor-text vendor)
(guid-ref "vendor=" URL-TYPE-VENDOR (gncVendorReturnGUID vendor)))
(define (gnc:employee-anchor-text employee)
(guid-ref "employee=" URL-TYPE-EMPLOYEE (gncEmployeeReturnGUID employee)))
(define (gnc:invoice-anchor-text invoice)
(guid-ref "invoice=" URL-TYPE-INVOICE (gncInvoiceReturnGUID invoice)))
(define (gnc:owner-anchor-text owner)
(let ((type (gncOwnerGetType (gncOwnerGetEndOwner owner))))
(cond
((eqv? type GNC-OWNER-CUSTOMER)
(gnc:customer-anchor-text (gncOwnerGetCustomer owner)))
((eqv? type GNC-OWNER-VENDOR)
(gnc:vendor-anchor-text (gncOwnerGetVendor owner)))
((eqv? type GNC-OWNER-EMPLOYEE)
(gnc:employee-anchor-text (gncOwnerGetEmployee owner)))
((eqv? type GNC-OWNER-JOB)
(gnc:job-anchor-text (gncOwnerGetJob owner)))
(else
""))))
(define (gnc:owner-report-text owner acc)
(let* ((end-owner (gncOwnerGetEndOwner owner))
(type (gncOwnerGetType end-owner))
(ref #f))
(cond
((eqv? type GNC-OWNER-CUSTOMER)
(set! ref "owner=c:"))
((eqv? type GNC-OWNER-VENDOR)
(set! ref "owner=v:"))
((eqv? type GNC-OWNER-EMPLOYEE)
(set! ref "owner=e:"))
(else (set! ref "unknown-type=")))
(if ref
(begin
(set! ref (string-append ref (gncOwnerReturnGUID end-owner)))
(if (not (null? acc))
(set! ref (string-append ref "&acct="
(gncAccountGetGUID acc))))
(gnc-build-url URL-TYPE-OWNERREPORT ref ""))
ref)))
;; Make a new report and return the anchor to it. The new report of
;; type 'reportname' will have the option values copied from
;; 'src-options', and additionally this function sets all options
@ -194,6 +132,8 @@
;; colspan at, optionally, the specified column.
(define (gnc:html-table-append-ruler/at! table colskip colspan)
(define empty-cell '())
(issue-deprecation-warning
"gnc:html-table-append-ruler/at! is deprecated.")
(gnc:html-table-append-row!
table
(append (make-list colskip empty-cell)
@ -203,6 +143,8 @@
(define (gnc:html-table-append-ruler/at/markup! table markup colskip colspan)
(define empty-cell "")
(issue-deprecation-warning
"gnc:html-table-append-ruler/at/markup! is deprecated.")
(gnc:html-table-append-row/markup!
table
markup
@ -212,7 +154,573 @@
1 colspan (gnc:make-html-text (gnc:html-markup-hr)))))))
(define (gnc:html-table-append-ruler! table colspan)
(gnc:html-table-append-ruler/at! table 0 colspan))
(gnc:html-table-append-row!
table (list (gnc:make-html-table-cell/size
1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
(define (gnc:html-table-append-ruler/markup! table markup colspan)
(issue-deprecation-warning
"gnc:html-table-append-ruler/markup! is unused.")
(gnc:html-table-append-ruler/at/markup! table markup 0 colspan))
;; Creates a table cell with some text in it. The cell will be created
;; with the colspan 'colspan' (the rowspan==1), the content 'content'
;; and in boldface if 'boldface?' is true. 'content' may be #f, or a
;; string, or a <html-text> object. Returns a <html-table-cell>
;; object.
(define (gnc:html-acct-table-cell colspan content boldface?)
;; instead of html-markup-b, just use the corresponding html-table-styles.
(define default-style "text-cell")
(define boldface-style "total-label-cell")
(issue-deprecation-warning
"gnc:html-acct-table-cell is unused.")
(gnc:make-html-table-cell/size/markup
1 colspan
(if boldface? boldface-style default-style)
content))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; function for account table without foreign commodities
;; Adds one row to the table. current-depth determines the number
;; of empty cells, my-name is the html-object to be displayed as
;; name, my-balance is a gnc-monetary to be displayed in the
;; balance column, and if reverse-balance? is #t the balance will
;; be displayed with the sign reversed.
(define (gnc:html-acct-table-row-helper!
table tree-depth
current-depth my-name my-balance
reverse-balance? row-style boldface? group-header-line?)
(issue-deprecation-warning
"gnc:html-acct-table-row-helper! is unused.")
(gnc:html-table-append-row/markup!
table
row-style
(append
;; left half of the table
(gnc:html-make-empty-cells (- current-depth 1))
(list (gnc:html-acct-table-cell (+ 1 (- tree-depth current-depth))
my-name boldface?))
;; right half of the table
(gnc:html-make-empty-cells
(- tree-depth (+ current-depth (if group-header-line? 1 0))))
;; the account balance
(list (and my-balance
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:make-html-text
((if boldface? gnc:html-markup-b identity)
((if reverse-balance? gnc:monetary-neg identity)
my-balance))))))
(gnc:html-make-empty-cells (- current-depth
(if group-header-line? 0 1))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; function for account table with foreign commodities visible
;; Adds all appropriate rows to the table which belong to one
;; balance, i.e. one row for each commodity. (Note: Multiple
;; commodities come e.g. from subaccounts with different
;; commodities.) my-name (a html-object) is the name to be printed
;; in the appropriate name column. my-commodity (a
;; <gnc:commodity*>) is the "natural" balance of the current
;; account. balance (a commodity-collector) is the balance to be
;; printed. If reverse-balance? == #t then the balances' signs get
;; reversed.
;; DM: If you trace this function through gnc:html-build-acct-table,
;; my-commodity always ends up being report-commodity.
(define (gnc:html-acct-table-comm-row-helper!
table tree-depth report-commodity exchange-fn
current-depth my-name my-commodity balance
reverse-balance? is-stock-account? main-row-style other-rows-style
boldface? group-header-line?)
(issue-deprecation-warning
"gnc:html-acct-table-comm-row-helper! is unused.")
(let ((already-printed #f))
;; Adds one row to the table. my-name is the html-object
;; displayed in the name column; foreign-balance is the
;; <gnc-monetary> for the foreign column or #f if to be left
;; empty; domestic-balance is the <gnc-monetary> for the
;; domestic column.
(define (commodity-row-helper!
my-name foreign-balance domestic-balance row-style)
(gnc:html-table-append-row/markup!
table
row-style
(append
;; left third of the table
(gnc:html-make-empty-cells (- current-depth 1))
(list (gnc:html-acct-table-cell (+ 1 (- tree-depth current-depth))
my-name boldface?))
;; right two-thirds of the table
(gnc:html-make-empty-cells
(* 2 (- tree-depth (+ current-depth (if group-header-line? 1 0)))))
(if boldface?
(list
(and foreign-balance
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:make-html-text (gnc:html-markup-b foreign-balance))))
(and
domestic-balance
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:make-html-text (gnc:html-markup-b domestic-balance)))))
(list
(and foreign-balance
(gnc:make-html-table-cell/markup
"number-cell"
foreign-balance))
(and domestic-balance
(gnc:make-html-table-cell/markup
"number-cell"
domestic-balance))))
(gnc:html-make-empty-cells (* 2 (- current-depth
(if group-header-line? 0 1)))))))
;;;;;;;;;;
;; the first row for each account: shows the name and the
;; balance in the report-commodity
(if (and (not is-stock-account?)
;; FIXME: need to check whether we really have only one
;; foreign currency if is-stock-account==#t.
(gnc-commodity-equiv my-commodity report-commodity))
;; usual case: the account balance in terms of report
;; commodity
(commodity-row-helper!
my-name #f
(and balance
(balance 'getmonetary report-commodity reverse-balance?))
main-row-style)
;; Special case for stock-accounts: then the foreign commodity
;; gets displayed in this line rather then the following lines
;; (loop below). Is also used if is-stock-account? is true.
(let ((my-balance
(and balance
(balance 'getmonetary my-commodity reverse-balance?))))
(set! already-printed my-commodity)
(commodity-row-helper!
my-name
my-balance
(exchange-fn my-balance report-commodity)
main-row-style)))
;; The additional rows: show no name, but the foreign currency
;; balance and its corresponding value in the
;; report-currency. One row for each non-report-currency.
(if (and balance (not is-stock-account?))
(balance
'format
(lambda (curr val)
(if (or (gnc-commodity-equiv curr report-commodity)
(and already-printed
(gnc-commodity-equiv curr already-printed)))
'()
(let ((bal
(if reverse-balance?
(gnc:monetary-neg (gnc:make-gnc-monetary curr val))
(gnc:make-gnc-monetary curr val))))
(commodity-row-helper!
;; print no account name
(gnc:html-make-empty-cell)
;; print the account balance in the respective
;; commodity
bal
(exchange-fn bal report-commodity)
other-rows-style))))
#f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:html-build-acct-table
;;
;; Builds and returns a tree-(hierarchy-)shaped table as a html-table
;; object.
;;
;; Arguments by topic:
;;
;; Reporting period -- start-date, end-date
;;
;; Selected accounts -- tree-depth, show-subaccts?, accounts
;;
;; Foreign currency -- show-other-curr?, report-commodity,
;; exchange-fn
;;
;; Output fine-tuning -- show-col-headers?, show-total? (with
;; total-name, get-total-fn), group-types?,
;; show-parent-balance?, show-parent-total?
;;
;; Feedback while building -- start-percent, delta-percent
;;
;; Note: The returned table object will have 2*tree-depth columns if
;; show-other-curr?==#f, else it will have 3*tree-depth columns.
;;
;; Arguments in detail:
;;
;; <gnc:time-pair> start-date: Start date of reporting period. If #f,
;; everything till end-date will be considered.
;;
;; <gnc:time-pair> end-date: End date of reporting period.
;;
;; <int> tree-depth, <bool> show-subaccounts?, <gnc:list-of-account*>
;; accounts: An account is shown if ( tree-depth is large enough AND [
;; it is a member in accounts OR { show-subaccounts? == #t AND any of
;; the parents is member in accounts. }]) Note that the accounts shown
;; are totally independent from the calculated balance and vice
;; versa.
;;
;; <bool> show-col-headers?: show column headings "Account" and
;; "Balance"
;;
;; <bool> show-total?: If #f, no total sum is shown.
;;
;; #<procedure ...> get-total-fn: The function to calculate the total
;; sum, e.g. gnc:accounts-get-comm-total-{profit,assets}.
;;
;; <chars> total-name: The name to show in the total sum line.
;;
;; <bool> group-types?: Specify whether to group the accounts
;; according to their types and show a subtotal for each group.
;;
;; <bool> show-parent-balance?: Specify whether to show balances of
;; non-leaf accounts separately.
;;
;; <bool> show-parent-total?: Whether to show a line with the label
;; e.g. "Total My-Assets" and the subtotal for this account and its
;; children.
;;
;; <bool> show-other-curr?, <gnc:commodity*> report-commodity,
;; #<procedure ...> exchange-fn: The rightmost column always shows
;; balances in the currency report-commodity. If those balances happen
;; to be in another currency, they will get converted to the
;; report-commodity by means of the exchange-fn which e.g. came from
;; gnc:make-exchange-function. If show-other-curr? == #t, the
;; non-report-currencies will additionally be displayed in the
;; second-rightmost column.
;;
;; <int> start-percent, delta-percent: Fill in the [start:start+delta]
;; section of the progress bar while running this function.
;;
(define (gnc:first-html-build-acct-table . args)
(issue-deprecation-warning
"gnc:first-html-build-acct-table is deprecated. use gnc:html-build-acct-table.")
(apply gnc:html-build-acct-table args))
(define (gnc:html-build-acct-table
start-date end-date
tree-depth show-subaccts? accounts
start-percent delta-percent
show-col-headers?
show-total? get-total-fn
total-name group-types? show-parent-balance? show-parent-total?
show-other-curr? report-commodity exchange-fn show-zero-entries?)
(issue-deprecation-warning
"gnc:html-build-acct-table is unused.")
(let ((table (gnc:make-html-table))
(work-to-do 0)
(work-done 0)
(topl-accounts (gnc-account-get-children-sorted
(gnc-get-current-root-account))))
;; The following functions are defined inside build-acct-table
;; to avoid passing tons of arguments which are constant anyway
;; inside this function.
;; If start-date == #f then balance-at-date will be used (for
;; balance reports), otherwise balance-interval (for profit and
;; loss reports). This function takes only the current account
;; into consideration, i.e. none of the subaccounts are included
;; in the balance. Returns a commodity-collector.
(define (my-get-balance-nosub account)
(if start-date
(gnc:account-get-comm-balance-interval
account start-date end-date #f)
(gnc:account-get-comm-balance-at-date
account end-date #f)))
;; Additional function that includes the subaccounts as
;; well. Note: It is necessary to define this here (instead of
;; changing an argument for account-get-balance) because the
;; use-acct? query is needed.
(define (my-get-balance account)
;; this-collector for storing the result
(let ((this-collector (my-get-balance-nosub account)))
(for-each
(lambda (x) (if x
(this-collector 'merge x #f)))
(gnc:account-map-descendants
(lambda (a)
;; Important: Calculate the balance if and only if the
;; account a is shown, i.e. (use-acct? a) == #t.
(and (use-acct? a)
(my-get-balance-nosub a)))
account))
this-collector))
;; Use this account in the account hierarchy? Check against the
;; account selection and, if not selected, show-subaccts?==#t and
;; any parent was selected. (Maybe the other way around is more
;; effective?)
(define (use-acct? a)
(or (member a accounts)
(and show-subaccts?
(let ((parent (gnc-account-get-parent a)))
(and parent
(use-acct? parent))))))
;; Show this account? Only if nonzero amount or appropriate
;; preference.
(define (show-acct? a)
(and (or show-zero-entries?
(not (gnc-commodity-collector-allzero?
(my-get-balance a))))
(use-acct? a)))
;; sort an account list. Currently this uses only the account-code
;; field, but anyone feel free to add more options to this.
(define (sort-fn accts)
(sort accts
(lambda (a b)
(string<? (xaccAccountGetCode a)
(xaccAccountGetCode b)))))
;; Remove the last appended row iff *all* its fields are empty
;; (==#f) or have an html-table-cell which in turn is empty
;; (resulting from the add-group! function above). Note: This
;; depends on the structure of html-table-data, i.e. if those are
;; changed then this might break.
(define (remove-last-empty-row)
(if (and (not (null? (gnc:html-table-data table)))
(not (or-map
(lambda (e)
(if (gnc:html-table-cell? e)
(car (gnc:html-table-cell-data e))
e))
(car (gnc:html-table-data table)))))
(gnc:html-table-remove-last-row! table)))
;; Wrapper for gnc:html-acct-table-row-helper!
(define (add-row-helper!
current-depth my-name my-balance
reverse-balance? row-style boldface? group-header-line?)
(gnc:html-acct-table-row-helper!
table tree-depth
current-depth my-name my-balance
reverse-balance? row-style boldface? group-header-line?))
;; Wrapper
(define (add-commodity-rows!
current-depth my-name my-commodity balance
reverse-balance? is-stock-account?
main-row-style other-rows-style boldface? group-header-line?)
(gnc:html-acct-table-comm-row-helper!
table tree-depth report-commodity exchange-fn
current-depth my-name my-commodity balance
reverse-balance? is-stock-account?
main-row-style other-rows-style boldface? group-header-line?))
;; Adds all appropriate rows to the table which belong to one
;; account. Uses the above helper function, i.e. here the
;; necessary values only are "extracted" from the account.
(define (add-account-rows! acct current-depth alternate-row?)
(let ((row-style (if alternate-row? "alternate-row" "normal-row")))
(if show-other-curr?
(add-commodity-rows! current-depth
(gnc:html-account-anchor acct)
(xaccAccountGetCommodity acct)
(my-get-balance acct)
(gnc-reverse-balance acct)
(gnc:account-has-shares? acct)
row-style row-style
#f #f)
(add-row-helper!
current-depth
(gnc:html-account-anchor acct)
(gnc:sum-collector-commodity (my-get-balance acct)
report-commodity exchange-fn)
(gnc-reverse-balance acct)
row-style
#f #f))))
;; Generalization of add-account-rows! for a subtotal or for the
;; total balance.
(define (add-subtotal-row!
current-depth subtotal-name balance
row-style boldface? group-header-line?)
(if show-other-curr?
(add-commodity-rows! current-depth subtotal-name
report-commodity
(gnc:sum-collector-stocks
balance report-commodity exchange-fn)
#f #f row-style row-style
boldface? group-header-line?)
;; Show no other currencies. Therefore just calculate
;; one total via sum-collector-commodity and show it.
(add-row-helper! current-depth subtotal-name
(gnc:sum-collector-commodity
balance report-commodity exchange-fn)
#f
row-style
boldface? group-header-line?)))
(define (count-accounts! current-depth accnts)
(if (<= current-depth tree-depth)
(let ((sum 0))
(for-each
(lambda (acct)
(let ((subaccts (filter
use-acct?
(gnc-account-get-children acct))))
(set! sum (+ sum 1))
(if (or (= current-depth tree-depth) (null? subaccts))
sum
(set! sum (+ sum (count-accounts! (+ 1 current-depth) subaccts))))))
accnts)
sum)
0))
;; This prints *all* the rows that belong to one group: the title
;; row, the subaccount tree, and the Total row with the balance of
;; the subaccounts. groupname may be a string or a html-text
;; object. subaccounts is a list of accounts. thisbalance is the
;; balance of this group, or it may be #f, in which case the
;; balance is calculated from the subaccounts list.
(define (add-group! current-depth groupname subaccounts
thisbalance group-total-line?)
(let ((heading-style (if (= current-depth 1)
"primary-subheading"
"secondary-subheading")))
;; first the group name
(add-subtotal-row! current-depth groupname
(and show-parent-balance? thisbalance)
heading-style
(not (and show-parent-balance? thisbalance)) #t)
;; then all the subaccounts
(traverse-accounts! subaccounts (+ 1 current-depth))
;; and now the "total" row
(if group-total-line?
(begin
(remove-last-empty-row) ;; FIXME: do this here or not?
(add-subtotal-row!
current-depth
(let ((total-text (gnc:make-html-text (_ "Total") " ")))
(if (gnc:html-text? groupname)
(apply gnc:html-text-append!
total-text
(gnc:html-text-body groupname))
(gnc:html-text-append! total-text groupname))
total-text)
;; Calculate the balance, including the subbalances.
;; A subbalance is only calculated if no thisbalance was
;; given. (Because any "thisbalance" calculation already
;; includes the appropriate subaccounts.)
(let ((subbalance (gnc:accounts-get-balance-helper
subaccounts my-get-balance
gnc-reverse-balance)))
(if thisbalance
(subbalance 'merge thisbalance #f))
subbalance)
heading-style
#t #f)))))
;; and an empty line
; (add-subtotal-row! current-depth #f #f heading-style #f #f)))))
;; Adds rows to the table. Therefore it goes through the list of
;; accounts, runs add-account-rows! on each account. If
;; tree-depth and current-depth require, it will recursively call
;; itself on the list of children accounts.
(define (traverse-accounts! accnts current-depth)
(let ((alternate #f))
(if (<= current-depth tree-depth)
(for-each
(lambda (acct)
(let ((subaccts (filter
use-acct?
(gnc-account-get-children acct))))
(set! work-done (+ 1 work-done))
(if start-percent
(gnc:report-percent-done
(+ start-percent (* delta-percent (/ work-done work-to-do)))))
(if (or (= current-depth tree-depth) (null? subaccts))
(begin
(if (show-acct? acct)
(add-account-rows! acct current-depth alternate))
(set! alternate (not alternate)))
(add-group! current-depth
(gnc:html-account-anchor acct)
subaccts
(gnc:accounts-get-balance-helper
(list acct) my-get-balance-nosub
gnc-reverse-balance)
show-parent-total?))))
(sort-fn accnts)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; start the recursive account processing
(set! work-to-do (count-accounts!
(if group-types? 2 1)
(filter use-acct? topl-accounts)))
(if group-types?
;; Print a subtotal for each group.
(for-each
(lambda (accts)
(if (and (not (null? accts)) (not (null? (cdr accts))))
(add-group! 1
(gnc:account-get-type-string-plural (car accts))
(cdr accts) #f #t)))
(gnc:decompose-accountlist (lset-intersection
equal? accounts topl-accounts)))
;; No extra grouping.
;; FIXME: go through accounts even if not
;; shown, because the children might be shown.
(traverse-accounts! (filter use-acct? topl-accounts) 1))
(remove-last-empty-row)
;; Show the total sum.
(if show-total?
(begin
(gnc:html-table-append-ruler/markup!
table "grand-total" (* (if show-other-curr? 3 2) tree-depth))
(add-subtotal-row!
1 total-name
(get-total-fn (filter use-acct? topl-accounts) my-get-balance)
"grand-total"
#t #f)))
;; set default alignment to right, and override for the name
;; columns
(gnc:html-table-set-style!
table "td"
'attribute '("align" "right")
'attribute '("valign" "top"))
(gnc:html-table-set-style!
table "th"
'attribute '("align" "center")
'attribute '("valign" "top"))
;; set some column headers
(if show-col-headers?
(gnc:html-table-set-col-headers!
table
(list (gnc:make-html-table-header-cell/size
1 tree-depth (_ "Account name"))
(gnc:make-html-table-header-cell/size
1 (if show-other-curr?
(* 2 tree-depth)
tree-depth)
(_ "Balance")))))
;; No extra alignment here because that's already done in
;; html-acct-table-cell.
table))
;; Create a html-table of all exchange rates. The report-commodity is
;; 'common-commodity', the exchange rates are given through the

26
gnucash/report/options-utilities.scm
View File

@ -66,24 +66,14 @@
(gnc:register-option
options
(gnc:make-multichoice-option
pagename name-display-depth
sort-tag
help-string
default-depth
(list (list->vector
(list 'all (N_ "All") (N_ "All accounts")))
(list->vector
(list 1 "1" (N_ "Top-level.")))
(list->vector
(list 2 "2" (N_ "Second-level.")))
(list->vector
(list 3 "3" (N_ "Third-level.")))
(list->vector
(list 4 "4" (N_ "Fourth-level.")))
(list->vector
(list 5 "5" (N_ "Fifth-level.")))
(list->vector
(list 6 "6" (N_ "Sixth-level.")))))))
pagename name-display-depth sort-tag help-string default-depth
(list (vector 'all (N_ "All") (N_ "All accounts"))
(vector 1 "1" (N_ "Top-level."))
(vector 2 "2" (N_ "Second-level."))
(vector 3 "3" (N_ "Third-level."))
(vector 4 "4" (N_ "Fourth-level."))
(vector 5 "5" (N_ "Fifth-level."))
(vector 6 "6" (N_ "Sixth-level."))))))
;; These help for selecting a bunch of accounts.
(define (gnc:options-add-account-selection!

13
gnucash/report/report-utilities.scm
View File

@ -883,10 +883,9 @@
;; reduce the lot balance automatically.
((eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits)))
TXN-TYPE-INVOICE)
(let* ((lot (gncInvoiceGetPostedLot
(gncInvoiceGetInvoiceFromTxn
(xaccSplitGetParent (car splits)))))
(invoice (gncInvoiceGetInvoiceFromLot lot))
(let* ((invoice (gncInvoiceGetInvoiceFromTxn
(xaccSplitGetParent (car splits))))
(lot (gncInvoiceGetPostedLot invoice))
(bal (gnc-lot-get-balance lot))
(bal (if receivable? bal (- bal)))
(date (if (eq? date-type 'postdate)
@ -944,7 +943,9 @@
(xaccTransGetCurrency txn)
(xaccSplitGetValue spl))))))
(define (trans->str txn)
(format #f "Txn<d:~a>" (qof-print-date (xaccTransGetDate txn))))
(format #f "Txn<d:~a,desc:~a>"
(qof-print-date (xaccTransGetDate txn))
(xaccTransGetDescription txn)))
(define (account->str acc)
(format #f "Acc<~a>" (xaccAccountGetName acc)))
(define (monetary-collector->str coll)
@ -973,7 +974,7 @@
(gncInvoiceGetTotal inv)))))
(define (lot->str lot)
(format #f "Lot<Acc:~a,Title:~a,Notes:~a,Balance:~a,NSplits:~a>"
(gnc:strify (xaccAccountGetName (gnc-lot-get-account lot)))
(xaccAccountGetName (gnc-lot-get-account lot))
(gnc-lot-get-title lot)
(gnc-lot-get-notes lot)
(gnc-lot-get-balance lot)

51
gnucash/report/reports/example/hello-world.scm
View File

@ -65,22 +65,18 @@
(gnc:make-multichoice-option
(N_ "Hello, World!") (N_ "Multi Choice Option")
"b" (N_ "This is a multi choice option.") 'third
(list (list->vector
(list 'first
(N_ "First Option")
(N_ "Help for first option.")))
(list->vector
(list 'second
(N_ "Second Option")
(N_ "Help for second option.")))
(list->vector
(list 'third
(N_ "Third Option")
(N_ "Help for third option.")))
(list->vector
(list 'fourth
(N_ "Fourth Options")
(N_ "The fourth option rules!"))))))
(list (vector 'first
(N_ "First Option")
(N_ "Help for first option."))
(vector 'second
(N_ "Second Option")
(N_ "Help for second option."))
(vector 'third
(N_ "Third Option")
(N_ "Help for third option."))
(vector 'fourth
(N_ "Fourth Options")
(N_ "The fourth option rules!")))))
;; This is a string option. Users can type anything they want
;; as a value. The default value is "Hello, World". This is
@ -196,19 +192,16 @@
(gnc:make-list-option
(N_ "Hello Again") (N_ "A list option")
"h" (N_ "This is a list option.")
(list 'good)
(list (list->vector
(list 'good
(N_ "The Good")
(N_ "Good option.")))
(list->vector
(list 'bad
(N_ "The Bad")
(N_ "Bad option.")))
(list->vector
(list 'ugly
(N_ "The Ugly")
(N_ "Ugly option."))))))
'(good)
(list (vector 'good
(N_ "The Good")
(N_ "Good option."))
(vector 'bad
(N_ "The Bad")
(N_ "Bad option."))
(vector 'ugly
(N_ "The Ugly")
(N_ "Ugly option.")))))
;; This option is for testing. When true, the report generates
;; an exception.

45
gnucash/report/reports/locale-specific/de_DE/taxtxf.scm
View File

@ -152,33 +152,24 @@
gnc:pagename-general (N_ "Alternate Period")
"c" (N_ "Override or modify From: & To:.")
(if after-tax-day 'from-to 'last-year)
(list (list->vector
(list 'from-to (N_ "Use From - To") (N_ "Use From - To period.")))
(list->vector
(list '1st-est (N_ "1st Est Tax Quarter") (N_ "Jan 1 - Mar 31.")))
(list->vector
(list '2nd-est (N_ "2nd Est Tax Quarter") (N_ "Apr 1 - May 31.")))
(list->vector
;; Translators: The US tax quarters are different from
;; actual year's quarters! See the definition of
;; tax-qtr-real-qtr-year variable above.
(list '3rd-est (N_ "3rd Est Tax Quarter") (N_ "Jun 1 - Aug 31.")))
(list->vector
(list '4th-est (N_ "4th Est Tax Quarter") (N_ "Sep 1 - Dec 31.")))
(list->vector
(list 'last-year (N_ "Last Year") (N_ "Last Year.")))
(list->vector
(list '1st-last (N_ "Last Yr 1st Est Tax Qtr")
(N_ "Jan 1 - Mar 31, Last year.")))
(list->vector
(list '2nd-last (N_ "Last Yr 2nd Est Tax Qtr")
(N_ "Apr 1 - May 31, Last year.")))
(list->vector
(list '3rd-last (N_ "Last Yr 3rd Est Tax Qtr")
(N_ "Jun 1 - Aug 31, Last year.")))
(list->vector
(list '4th-last (N_ "Last Yr 4th Est Tax Qtr")
(N_ "Sep 1 - Dec 31, Last year."))))))
(list (vector 'from-to (N_ "Use From - To") (N_ "Use From - To period."))
(vector '1st-est (N_ "1st Est Tax Quarter") (N_ "Jan 1 - Mar 31."))
(vector '2nd-est (N_ "2nd Est Tax Quarter") (N_ "Apr 1 - May 31."))
(vector '3rd-est (N_ "3rd Est Tax Quarter") (N_ "Jun 1 - Aug 31."))
(vector '4th-est (N_ "4th Est Tax Quarter") (N_ "Sep 1 - Dec 31."))
(vector 'last-year (N_ "Last Year") (N_ "Last Year."))
(vector '1st-last
(N_ "Last Yr 1st Est Tax Qtr")
(N_ "Jan 1 - Mar 31, Last year."))
(vector '2nd-last
(N_ "Last Yr 2nd Est Tax Qtr")
(N_ "Apr 1 - May 31, Last year."))
(vector '3rd-last
(N_ "Last Yr 3rd Est Tax Qtr")
(N_ "Jun 1 - Aug 31, Last year."))
(vector '4th-last
(N_ "Last Yr 4th Est Tax Qtr")
(N_ "Sep 1 - Dec 31, Last year.")))))
(gnc:register-tax-option
(gnc:make-account-list-option

54
gnucash/report/reports/locale-specific/us/taxtxf.scm
View File

@ -180,36 +180,30 @@
gnc:pagename-general (N_ "Alternate Period")
"c" (N_ "Override or modify From: & To:.")
(if after-tax-day 'from-to 'last-year)
(list (list->vector
(list 'from-to (N_ "Use From - To") (N_ "Use From - To period.")))
(list->vector
(list '1st-est (N_ "1st Est Tax Quarter") (N_ "Jan 1 - Mar 31.")))
(list->vector
(list '2nd-est (N_ "2nd Est Tax Quarter") (N_ "Apr 1 - May 31.")))
(list->vector
;; Translators: The US tax quarters are different from
;; actual year's quarters! See the definition of
;; tax-qtr-real-qtr-year variable above.
(list '3rd-est (N_ "3rd Est Tax Quarter") (N_ "Jun 1 - Aug 31.")))
(list->vector
(list '4th-est (N_ "4th Est Tax Quarter") (N_ "Sep 1 - Dec 31.")))
(list->vector
(list 'last-year (N_ "Last Year") (N_ "Last Year.")))
(list->vector
(list '1st-last (N_ "Last Yr 1st Est Tax Qtr")
(N_ "Jan 1 - Mar 31, Last year.")))
(list->vector
(list '2nd-last (N_ "Last Yr 2nd Est Tax Qtr")
(N_ "Apr 1 - May 31, Last year.")))
(list->vector
(list '3rd-last (N_ "Last Yr 3rd Est Tax Qtr")
;; Translators: The US tax quarters are different from
;; actual year's quarters! See the definition of
;; tax-qtr-real-qtr-year variable above.
(N_ "Jun 1 - Aug 31, Last year.")))
(list->vector
(list '4th-last (N_ "Last Yr 4th Est Tax Qtr")
(N_ "Sep 1 - Dec 31, Last year."))))))
(list (vector 'from-to (N_ "Use From - To") (N_ "Use From - To period."))
(vector '1st-est (N_ "1st Est Tax Quarter") (N_ "Jan 1 - Mar 31."))
(vector '2nd-est (N_ "2nd Est Tax Quarter") (N_ "Apr 1 - May 31."))
;; Translators: The US tax quarters are different from
;; actual year's quarters! See the definition of
;; tax-qtr-real-qtr-year variable above.
(vector '3rd-est (N_ "3rd Est Tax Quarter") (N_ "Jun 1 - Aug 31."))
(vector '4th-est (N_ "4th Est Tax Quarter") (N_ "Sep 1 - Dec 31."))
(vector 'last-year (N_ "Last Year") (N_ "Last Year."))
(vector '1st-last
(N_ "Last Yr 1st Est Tax Qtr")
(N_ "Jan 1 - Mar 31, Last year."))
(vector '2nd-last
(N_ "Last Yr 2nd Est Tax Qtr")
(N_ "Apr 1 - May 31, Last year."))
(vector '3rd-last
(N_ "Last Yr 3rd Est Tax Qtr")
;; Translators: The US tax quarters are different from
;; actual year's quarters! See the definition of
;; tax-qtr-real-qtr-year variable above.
(N_ "Jun 1 - Aug 31, Last year."))
(vector '4th-last
(N_ "Last Yr 4th Est Tax Qtr")
(N_ "Sep 1 - Dec 31, Last year.")))))
(gnc:register-tax-option
(gnc:make-account-list-option

435
gnucash/report/reports/standard/budget-barchart.scm
View File

@ -32,6 +32,7 @@
(use-modules (gnucash gettext))
(gnc:module-load "gnucash/report" 0)
(use-modules (gnucash reports))
(define reportname
(N_ "Budget Chart"))
@ -41,97 +42,34 @@
(define optname-running-sum (N_ "Running Sum"))
(define optname-chart-type (N_ "Chart Type"))
(define opthelp-chart-type (N_ "Select which chart type to use"))
(define optname-plot-width (N_ "Plot Width"))
(define optname-plot-height (N_ "Plot Height"))
(define optname-from-date (N_ "Start Date"))
(define optname-to-date (N_ "End Date"))
(define optname-depth-limit (N_ "Levels of Subaccounts"))
(define opthelp-depth-limit
(N_ "Maximum number of levels in the account tree displayed."))
(define optname-budget-period-start (N_ "Range start"))
(define opthelp-budget-period-start
(N_ "Select a budget period type that starts the reporting range."))
(define optname-budget-period-start-exact (N_ "Exact start period"))
(define opthelp-budget-period-start-exact
(N_ "Select exact period that starts the reporting range."))
(define optname-budget-period-end (N_ "Range end"))
(define opthelp-budget-period-end
(N_ "Select a budget period type that ends the reporting range."))
(define optname-budget-period-end-exact (N_ "Exact end period"))
(define opthelp-budget-period-end-exact
(N_ "Select exact period that ends the reporting range."))
;(define (options-generator inc-exp?)
(define (options-generator)
(let* ((options (gnc:new-options))
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
(let* (
(options (gnc:new-options))
;; This is just a helper function for making options.
;; See libgnucash/scm/options.scm for details.
(add-option
(lambda (new-option)
(gnc:register-option options new-option)))
)
;; Option to select Budget
(add-option (gnc:make-budget-option
gnc:pagename-general optname-budget
"a" (N_ "Budget to use.")))
;; options to select budget period
(let ((period-options
(list (vector 'first
(N_ "First")
(N_ "The first period of the budget"))
(vector 'previous
(N_ "Previous")
(N_ "Budget period was before current period, according to report evaluation date"))
(vector 'current
(N_ "Current")
(N_ "Current period, according to report evaluation date"))
(vector 'next
(N_ "Next")
(N_ "Next period, according to report evaluation date"))
(vector 'last
(N_ "Last")
(N_ "Last budget period"))
(vector 'manual
(N_ "Manual period selection")
(N_ "Explicitly select period value with spinner below"))))
(start-period 'first)
(end-period 'last))
(add-option
(gnc:make-multichoice-callback-option
gnc:pagename-general optname-budget-period-start
"g1.1" opthelp-budget-period-start start-period
period-options
#f
(lambda (new-val)
(gnc-option-db-set-option-selectable-by-name
options gnc:pagename-general optname-budget-period-start-exact
(eq? new-val 'manual))
(set! end-period new-val))))
(add-option
(gnc:make-number-range-option
gnc:pagename-general optname-budget-period-start-exact
"g1.2" opthelp-budget-period-start-exact
1 1 60 0 1))
(add-option
(gnc:make-multichoice-callback-option
gnc:pagename-general optname-budget-period-end
"g2.1" opthelp-budget-period-end end-period
period-options
#f
(lambda (new-val)
(gnc-option-db-set-option-selectable-by-name
options gnc:pagename-general optname-budget-period-end-exact
(eq? new-val 'manual))
(set! end-period new-val))))
(add-option
(gnc:make-number-range-option
gnc:pagename-general optname-budget-period-end-exact
"g2.2" opthelp-budget-period-end-exact
1 1 60 0 1)))
;; date interval
(gnc:options-add-date-interval!
options gnc:pagename-general
optname-from-date optname-to-date "b")
;; Option to select the accounts to that will be displayed
(add-option (gnc:make-account-list-option
@ -158,30 +96,30 @@
;; Display tab
(add-option
(gnc:make-multichoice-option
gnc:pagename-display ;; tab name
optname-chart-type ;; displayed option name
"b" ;; localization in the tab
opthelp-chart-type ;; option help text
'bars ;; default selectioin
(list
(vector 'bars
(N_ "Barchart")
(N_ "Show the report as a bar chart."))
(vector 'lines
(N_ "Linechart")
(N_ "Show the report as a line chart.")))))
(gnc:make-multichoice-option
gnc:pagename-display ;; tab name
optname-chart-type ;; displayed option name
"b" ;; localization in the tab
(N_ "This is a multi choice option.") ;; option help text
'bars ;; default selectioin
(list
(vector 'bars
(N_ "Barchart")
(N_ "Show the report as a bar chart."))
(vector 'lines
(N_ "Linechart")
(N_ "Show the report as a line chart.")))))
(gnc:options-add-plot-size!
options gnc:pagename-display
optname-plot-width optname-plot-height
"c" (cons 'percent 80) (cons 'percent 80))
optname-plot-width optname-plot-height "c" (cons 'percent 100.0) (cons 'percent 100.0))
;; Set default page
(gnc:options-set-default-section options gnc:pagename-general)
;; Return options
options))
options
))
;; For each period in the budget:
@ -190,83 +128,125 @@
;;
;; Create bar and values
;;
(define (gnc:chart-create-budget-actual budget acct running-sum chart-type width height
startperiod endperiod)
(define curr (xaccAccountGetCommodity acct))
(define (amount->monetary amount)
(gnc:monetary->string
(gnc:make-gnc-monetary curr amount)))
(let ((chart (gnc:make-html-chart)))
(gnc:html-chart-set-type! chart (if (eq? chart-type 'bars) 'bar 'line))
(gnc:html-chart-set-title! chart (xaccAccountGetName acct))
(gnc:html-chart-set-width! chart width)
(gnc:html-chart-set-height! chart height)
(gnc:html-chart-set-currency-iso! chart (gnc-commodity-get-mnemonic curr))
(gnc:html-chart-set-currency-symbol! chart (gnc-commodity-get-nice-symbol curr))
(gnc:html-chart-set-y-axis-label! chart (gnc-commodity-get-mnemonic curr))
(define (gnc:chart-create-budget-actual budget acct running-sum chart-type width height report-start-time report-end-time)
(let* (
(chart #f)
)
;; disable animation; with multiple accounts selected this report
;; will create several charts, all will want to animate
(gnc:html-chart-set! chart '(options animation duration) 0)
(gnc:html-chart-set! chart '(options hover animationDuration) 0)
(gnc:html-chart-set! chart '(options responsiveAnimationDuration) 0)
(if (eqv? chart-type 'bars)
(begin
;; Setup barchart
(set! chart (gnc:make-html-barchart))
(gnc:html-barchart-set-title! chart (xaccAccountGetName acct))
(gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height)
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
(gnc:html-barchart-set-col-labels!
chart (list (_ "Budget") (_ "Actual")))
(gnc:html-barchart-set-col-colors!
chart '("#0074D9" "#FF4136"))
)
;; else
(begin
;; Setup linechart
(set! chart (gnc:make-html-linechart))
(gnc:html-linechart-set-title! chart (xaccAccountGetName acct))
(gnc:html-linechart-set-width! chart width)
(gnc:html-linechart-set-height! chart height)
(gnc:html-linechart-set-row-labels-rotated?! chart #t)
(gnc:html-linechart-set-col-labels!
chart (list (_ "Budget") (_ "Actual")))
(gnc:html-linechart-set-col-colors!
chart '("#0074D9" "#FF4136"))
)
)
;; loop though periods
(let loop ((periods (iota (gnc-budget-get-num-periods budget)))
(bgt-sum 0)
(act-sum 0)
(bgt-vals '())
(act-vals '())
(dates-list '()))
;; Prepare vars for running sums, and to loop though periods
(let* (
(num-periods (gnc-budget-get-num-periods budget))
(period 0)
(bgt-sum 0)
(act-sum 0)
(date (gnc-budget-get-period-start-date budget period))
(bgt-vals '())
(act-vals '())
(date-iso-string-list '())
(save-fmt (qof-date-format-get))
)
(cond
((null? periods)
(gnc:html-chart-add-data-series! chart
(_ "Budget")
(reverse bgt-vals)
"#0074D9"
'fill (eq? chart-type 'bars))
(gnc:html-chart-add-data-series! chart
(_ "Actual")
(reverse act-vals)
"#FF4136"
'fill (eq? chart-type 'bars))
(gnc:html-chart-set-data-labels! chart (reverse dates-list))
(when running-sum
(gnc:html-chart-set-title!
chart
(list (xaccAccountGetName acct)
;; Translators: Bgt and Act refer to budgeted and
;; actual total amounts.
(format #f (_ "Bgt: ~a Act: ~a")
(amount->monetary bgt-sum)
(amount->monetary act-sum))))))
(else
(let* ((period (car periods))
(bgt-sum (+ (gnc:get-account-period-rolledup-budget-value
budget acct period)
(if running-sum bgt-sum 0)))
(act-sum (+ (gnc-budget-get-account-period-actual-value
budget acct period)
(if running-sum act-sum 0))))
(if (<= startperiod period endperiod)
(loop (cdr periods)
bgt-sum
act-sum
(cons bgt-sum bgt-vals)
(cons act-sum act-vals)
(cons (qof-print-date
(gnc-budget-get-period-start-date budget period))
dates-list))
(loop (cdr periods)
bgt-sum
act-sum
bgt-vals
act-vals
dates-list))))))
;; make sure jqplot receives the date strings in ISO format (Bug763257)
(qof-date-format-set QOF-DATE-FORMAT-ISO)
;; Loop through periods
(while (< period num-periods)
;;add calc new running sums
(if running-sum
(begin
(set! bgt-sum (+ bgt-sum
(gnc-numeric-to-double
(gnc:get-account-period-rolledup-budget-value budget acct period))))
(set! act-sum (+ act-sum
(gnc-numeric-to-double
(gnc-budget-get-account-period-actual-value budget acct period))))
)
)
(if (<= report-start-time date)
;; within reporting period, update the display lists
(begin
(if (not running-sum)
(begin
(set! bgt-sum
(gnc-numeric-to-double
(gnc:get-account-period-rolledup-budget-value budget acct period)))
(set! act-sum
(gnc-numeric-to-double
(gnc-budget-get-account-period-actual-value budget acct period)))
)
)
(set! bgt-vals (append bgt-vals (list bgt-sum)))
(set! act-vals (append act-vals (list act-sum)))
(set! date-iso-string-list (append date-iso-string-list (list (qof-print-date date))))
)
)
;; prepare data for next loop repetition
(set! period (+ period 1))
(set! date (gnc-budget-get-period-start-date budget period))
(if (< report-end-time date)
(set! period num-periods) ;; reporting period has ended, break the loop
)
)
;; restore the date strings format
(qof-date-format-set save-fmt)
(if (eqv? chart-type 'bars)
(begin
;; Add data to the bar chart
(gnc:html-barchart-append-column! chart bgt-vals)
(gnc:html-barchart-append-column! chart act-vals)
(gnc:html-barchart-set-row-labels! chart date-iso-string-list)
(if running-sum
(gnc:html-barchart-set-subtitle!
chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum)))
)
;; else
(begin
;; Add data to the line chart
(gnc:html-linechart-append-column! chart bgt-vals)
(gnc:html-linechart-append-column! chart act-vals)
(gnc:html-linechart-set-row-labels! chart date-iso-string-list)
(if running-sum
(gnc:html-linechart-set-subtitle!
chart
(format #f "Bgt: ~a Act: ~a" bgt-sum act-sum)))
)
)
)
;; Return newly created chart
chart))
chart
))
;; This is the rendering function. It accepts a database of options
;; and generates an object of type <html-document>. See the file
@ -281,52 +261,43 @@
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
(define (curr-period budget)
(let ((now (current-time))
(max-period (1- (gnc-budget-get-num-periods budget))))
(let loop ((period 0))
(cond
((< now (gnc-budget-get-period-end-date budget period)) period)
((<= max-period period) period)
(else (loop (1+ period)))))))
(define (option->period period budget manual-period)
(let ((max-period (1- (gnc-budget-get-num-periods budget))))
(min max-period
(max 0
(case period
((first) 0)
((previous) (1- (curr-period budget)))
((current) (curr-period budget))
((next) (1+ (curr-period budget)))
((last) max-period)
((manual) (1- manual-period)))))))
(let* ((budget (get-option gnc:pagename-general optname-budget))
(budget-valid? (and budget (not (null? budget))))
(running-sum (get-option gnc:pagename-display optname-running-sum))
(chart-type (get-option gnc:pagename-display optname-chart-type))
(height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width))
(accounts (get-option gnc:pagename-accounts optname-accounts))
(depth-limit (get-option gnc:pagename-accounts optname-depth-limit))
(report-title (get-option gnc:pagename-general gnc:optname-reportname))
(start-period (get-option gnc:pagename-general optname-budget-period-start))
(start-period-exact (and budget-valid?
(option->period
start-period budget
(get-option
gnc:pagename-general
optname-budget-period-start-exact))))
(end-period (get-option gnc:pagename-general optname-budget-period-end))
(end-period-exact (and budget-valid?
(option->period
end-period budget
(get-option
gnc:pagename-general
optname-budget-period-end-exact))))
(document (gnc:make-html-document)))
;; This is a helper function to find out the level of the account
;; with in the account tree
(define (get-account-level account level)
(let (
(parent (gnc-account-get-parent account))
)
(cond
(
(null? parent) ;; exit
level
)
(else
(get-account-level parent (+ level 1))
)
)
)
)
(let* (
(budget (get-option gnc:pagename-general optname-budget))
(budget-valid? (and budget (not (null? budget))))
(running-sum (get-option gnc:pagename-display optname-running-sum))
(chart-type (get-option gnc:pagename-display optname-chart-type))
(height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width))
(accounts (get-option gnc:pagename-accounts optname-accounts))
(depth-limit (get-option gnc:pagename-accounts optname-depth-limit))
(report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(document (gnc:make-html-document))
(from-date-t64 (gnc:time64-start-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-from-date))))
(to-date-t64 (gnc:time64-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-to-date))))
)
(cond
((null? accounts)
;; No accounts selected
@ -342,25 +313,33 @@
;; Else create chart for each account
(else
(for-each
(lambda (acct)
(if (or (and (eq? depth-limit 'all)
(null? (gnc-account-get-descendants acct)))
(and (not (eq? depth-limit 'all))
(<= (gnc-account-get-current-depth acct) depth-limit)
(null? (gnc-account-get-descendants acct)))
(and (not (eq? depth-limit 'all))
(= (gnc-account-get-current-depth acct) depth-limit)))
(for-each
(lambda (acct)
(if (or
(and (equal? depth-limit 'all)
(null? (gnc-account-get-descendants acct))
)
(and (not (equal? depth-limit 'all))
(<= (get-account-level acct 0) depth-limit)
(null? (gnc-account-get-descendants acct))
)
(and (not (equal? depth-limit 'all))
(= (get-account-level acct 0) depth-limit)
)
)
(gnc:html-document-add-object!
document
(gnc:chart-create-budget-actual
budget acct running-sum chart-type
width height
(min start-period-exact end-period-exact)
(max start-period-exact end-period-exact)))))
accounts)))
document
(gnc:chart-create-budget-actual budget acct running-sum chart-type width height from-date-t64 to-date-t64)
)
)
)
accounts
)
)
) ;; end cond
document))
document
))
;; Here we define the actual report
(gnc:define-report

76
gnucash/report/reports/standard/new-aging.scm
View File

@ -44,6 +44,22 @@
(define optname-show-zeros (N_ "Show zero balance items"))
(define optname-date-driver (N_ "Due or Post Date"))
;; Display tab options
(define optname-addr-source (N_ "Address Source"))
(define addr-options-list
(list (list (N_ "Address Name") "b"
(N_ "Display Address Name. This, and other fields, may be useful if \
copying this report to a spreadsheet for use in a mail merge."))
(list (N_ "Address 1") "c" (N_ "Display Address 1."))
(list (N_ "Address 2") "d" (N_ "Display Address 2."))
(list (N_ "Address 3") "e" (N_ "Display Address 3."))
(list (N_ "Address 4") "f" (N_ "Display Address 4."))
(list (N_ "Address Phone") "g" (N_ "Display Phone."))
(list (N_ "Address Fax") "h" (N_ "Display Fax."))
(list (N_ "Address Email") "i" (N_ "Display Email."))
(list (N_ "Active") "j" (N_ "Display Active status."))))
(define no-APAR-account (_ "No valid A/Payable or A/Receivable \
account found. Please ensure valid AP/AR account exists."))
@ -100,8 +116,41 @@ exist but have no suitable transactions."))
(N_ "Post date is leading.")))))
(gnc:options-set-default-section options "General")
(for-each
(lambda (opt)
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display (car opt) (cadr opt) (caddr opt) #f)))
addr-options-list)
options))
(define (options->address options receivable? owner)
(define (op-value name)
(gnc:option-value (gnc:lookup-option options gnc:pagename-display name)))
(let* ((address-list-names (map car addr-options-list))
(address-list-options (map op-value address-list-names))
(addr-source (if receivable? (op-value optname-addr-source) 'billing))
(result-list
(cond
(owner
(let ((addr (if (eq? addr-source 'shipping)
(gncCustomerGetShipAddr (gncOwnerGetCustomer owner))
(gncOwnerGetAddr owner))))
(list (gncAddressGetName addr)
(gncAddressGetAddr1 addr)
(gncAddressGetAddr2 addr)
(gncAddressGetAddr3 addr)
(gncAddressGetAddr4 addr)
(gncAddressGetPhone addr)
(gncAddressGetFax addr)
(gncAddressGetEmail addr)
(if (gncOwnerGetActive owner) (_ "Y") (_ "N")))))
(else address-list-names))))
(fold-right (lambda (opt elt prev) (if opt (cons elt prev) prev))
'() address-list-options result-list)))
(define (txn-is-invoice? txn)
(eqv? (xaccTransGetTxnType txn) TXN-TYPE-INVOICE))
@ -137,9 +186,9 @@ exist but have no suitable transactions."))
owner))
(define (aging-renderer report-obj receivable)
(define options (gnc:report-options report-obj))
(define (op-value section name)
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
(gnc:option-value (gnc:lookup-option options section name)))
(define make-heading-list
(list ""
@ -200,7 +249,9 @@ exist but have no suitable transactions."))
splits)))
(cond
((null? accounts)
(gnc:html-table-set-col-headers! table make-heading-list)
(gnc:html-table-set-col-headers!
table (append make-heading-list
(options->address options receivable #f)))
(gnc:html-document-add-object!
document (if (null? (gnc:html-table-data table))
(gnc:make-html-text empty-APAR-accounts)
@ -276,7 +327,8 @@ exist but have no suitable transactions."))
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:owner-report-text owner account)
(gnc:make-gnc-monetary comm aging-total))))))))
(gnc:make-gnc-monetary comm aging-total)))))
(options->address options receivable owner))))
(lp (cdr acc-owners)
other-owner-splits
(map + acc-totals
@ -288,7 +340,21 @@ exist but have no suitable transactions."))
(aging-options-generator (gnc:new-options)))
(define (receivable-options-generator)
(aging-options-generator (gnc:new-options)))
(let ((options (aging-options-generator (gnc:new-options))))
(define (add-option new-option)
(gnc:register-option options new-option))
(add-option
(gnc:make-multichoice-option
gnc:pagename-display optname-addr-source "a" (N_ "Address source.") 'billing
(list
(vector 'billing
(N_ "Billing")
(N_ "Address fields from billing address."))
(vector 'shipping
(N_ "Shipping")
(N_ "Address fields from shipping address.")))))
options))
(define (payables-renderer report-obj)
(aging-renderer report-obj #f))

6
gnucash/report/reports/standard/view-column.scm
View File

@ -138,9 +138,9 @@
(gnc:html-table-cell-append-objects!
contents-cell
(gnc:make-html-text
(string-append
"<h3>" (_ "Report error") "</h3><p>"
(_ "An error occurred while running the report.")))))
(gnc:html-markup-h3 (_ "Report error"))
(_ "An error occurred while running the report.")
(gnc:html-markup "pre" gnc:last-captured-error))))
;; increment the alloc number for each occupied row
(let loop ((row current-row-num))

6
gnucash/report/test/test-report-extras.scm
View File

@ -53,11 +53,11 @@
(if test-title
(gnc:html-document-set-title! document test-title))
(let ((render (gnc:html-document-render document)))
(with-output-to-file (format #f "/tmp/~a-~a.html"
(call-with-output-file (format #f "/tmp/~a-~a.html"
(string-map sanitize-char prefix)
(string-map sanitize-char test-title))
(lambda ()
(display render)))
(lambda (p)
(display render p)))
render)))
(define (strip-string s1 s2)

6
gnucash/report/test/test-report-html.scm
View File

@ -892,9 +892,9 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-document-set-style-sheet! doc (gnc:html-style-sheet-find "Default"))
(gnc:html-document-add-object! doc table)
(let ((render (gnc:html-document-render doc)))
(with-output-to-file (format #f "/tmp/html-acct-table-~a.html" prefix)
(lambda ()
(display render)))
(call-with-output-file (format #f "/tmp/html-acct-table-~a.html" prefix)
(lambda (p)
(display render p)))
(xml->sxml render
#:trim-whitespace? #t
#:entities '((nbsp . "\xa0")

6
gnucash/report/trep-engine.scm
View File

@ -2204,9 +2204,9 @@ be excluded from periodic reporting.")
(if (list? csvlist)
(catch #t
(lambda ()
(with-output-to-file filename
(lambda ()
(display (lists->csv (append infolist csvlist))))))
(call-with-output-file filename
(lambda (p)
(display (lists->csv (append infolist csvlist)) p))))
(lambda (key . args)
;; Translators: ~a error type, ~a filename, ~s error details
(let ((fmt (N_ "error ~a during csv output to ~a: ~s")))

4
gnucash/ui/gnc-plugin-page-register-ui.xml
View File

@ -25,6 +25,8 @@
<menuitem name="AssociateTransactionFile" action="AssociateTransactionFileAction"/>
<menuitem name="AssociateTransactionLocation" action="AssociateTransactionLocationAction"/>
<menuitem name="ExecAssociateTransaction" action="ExecAssociatedTransactionAction"/>
<separator name="TransactionSep4"/>
<menuitem name="JumpAssociateInvoice" action="JumpAssociatedInvoiceAction"/>
</menu>
<menu name="View" action="ViewAction">
@ -101,6 +103,8 @@
<menuitem name="AssociateTransactionLocation" action="AssociateTransactionLocationAction"/>
<menuitem name="ExecAssociateTransaction" action="ExecAssociatedTransactionAction"/>
<separator name="PopupSep4"/>
<menuitem name="JumpAssociateInvoice" action="JumpAssociatedInvoiceAction"/>
<separator name="PopupSep5"/>
<menuitem name="BlankTransaction" action="BlankTransactionAction"/>
<menuitem name="SplitTransaction" action="SplitTransactionAction"/>
<menuitem name="EditExchangeRate" action="EditExchangeRateAction"/>

3
libgnucash/app-utils/c-interface.scm
View File

@ -69,7 +69,8 @@
(display captured-error (current-error-port))
(set! gnc:last-captured-error (gnc:html-string-sanitize captured-error))
(when (defined? 'gnc:warn)
(gnc:warn captured-error)))
(gnc:warn captured-error))
#f)
(else result))))
(define-public gnc:last-captured-error "")

12
libgnucash/engine/gncOwner.c
View File

@ -210,17 +210,17 @@ const char * gncOwnerGetTypeString (const GncOwner *owner)
switch (type)
{
case GNC_OWNER_NONE:
return "None";
return N_("None");
case GNC_OWNER_UNDEFINED:
return "Undefined";
return N_("Undefined");
case GNC_OWNER_CUSTOMER:
return "Customer";
return N_("Customer");
case GNC_OWNER_JOB:
return "Job";
return N_("Job");
case GNC_OWNER_VENDOR:
return "Vendor";
return N_("Vendor");
case GNC_OWNER_EMPLOYEE:
return "Employee";
return N_("Employee");
default:
PWARN ("Unknown owner type");
return NULL;