gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Wed Sep 25 12:19:21 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/b49109b7 (commit)
via https://github.com/Gnucash/gnucash/commit/22cdd237 (commit)
via https://github.com/Gnucash/gnucash/commit/298724dd (commit)
via https://github.com/Gnucash/gnucash/commit/ee260d8e (commit)
via https://github.com/Gnucash/gnucash/commit/9832fa39 (commit)
via https://github.com/Gnucash/gnucash/commit/a259ba4a (commit)
from https://github.com/Gnucash/gnucash/commit/8342a6df (commit)
commit b49109b7826cc7c1c9dfa055f69598304291710c
Merge: 8342a6dfb 22cdd237f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Sep 26 00:19:06 2019 +0800
Merge branch 'maint'
diff --cc gnucash/gnome/gnc-plugin-report-system.c
index a9a5071d7,000000000..0fbcc024f
mode 100644,000000..100644
--- a/gnucash/gnome/gnc-plugin-report-system.c
+++ b/gnucash/gnome/gnc-plugin-report-system.c
@@@ -1,275 -1,0 +1,282 @@@
+/*
+ * gnc-plugin-report-system.c --
+ * Copyright (C) 2003 David Hampton <hampton at employees.org>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of
+ * the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, contact:
+ *
+ * Free Software Foundation Voice: +1-617-542-5942
+ * 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+ * Boston, MA 02110-1301, USA gnu at gnu.org
+ */
+
+#include <config.h>
+
+#include <gtk/gtk.h>
+#include <glib/gi18n.h>
+
+#include "dialog-report-style-sheet.h"
+#include "file-utils.h"
+#include "gnc-gnome-utils.h"
+#include "gnc-html.h"
++#include "gnc-guile-utils.h"
+#include "gnc-plugin-page-report.h"
+#include "gnc-plugin-report-system.h"
+#include "gnc-plugin-manager.h"
+#include "gnc-report.h"
+#include "gnc-engine.h"
+#include "window-report.h"
+
+static void gnc_plugin_report_system_class_init (GncPluginReportSystemClass *klass);
+static void gnc_plugin_report_system_init (GncPluginReportSystem *plugin);
+static void gnc_plugin_report_system_finalize (GObject *object);
+
+
+/* Command callbacks */
+static void gnc_plugin_report_system_cmd_edit_style_sheet (GtkAction *action,
+ GncMainWindowActionData *data);
+
+
+#define PLUGIN_ACTIONS_NAME "gnc-plugin-report-system-actions"
+#define PLUGIN_UI_FILENAME "gnc-plugin-report-system-ui.xml"
+
+static GtkActionEntry gnc_plugin_actions [] =
+{
+ /* Menu Items */
+ {
+ "EditStyleSheetsAction", NULL, N_("St_yle Sheets"), NULL,
+ N_("Edit report style sheets"),
+ G_CALLBACK (gnc_plugin_report_system_cmd_edit_style_sheet)
+ },
+};
+static guint gnc_plugin_n_actions = G_N_ELEMENTS (gnc_plugin_actions);
+
+
+typedef struct GncPluginReportSystemPrivate
+{
+ gpointer dummy;
+} GncPluginReportSystemPrivate;
+
+G_DEFINE_TYPE_WITH_PRIVATE(GncPluginReportSystem, gnc_plugin_report_system, GNC_TYPE_PLUGIN)
+
+#define GNC_PLUGIN_REPORT_SYSTEM_GET_PRIVATE(o) \
+ (G_TYPE_INSTANCE_GET_PRIVATE ((o), GNC_TYPE_PLUGIN_REPORT_SYSTEM, GncPluginReportSystemPrivate))
+
+static GObjectClass *parent_class = NULL;
+
+/************************************************************
+ * Object Implementation *
+ ************************************************************/
+
+static void
+gnc_plugin_report_system_class_init (GncPluginReportSystemClass *klass)
+{
+ GObjectClass *object_class = G_OBJECT_CLASS (klass);
+ GncPluginClass *plugin_class = GNC_PLUGIN_CLASS (klass);
+
+ parent_class = g_type_class_peek_parent (klass);
+
+ object_class->finalize = gnc_plugin_report_system_finalize;
+
+ /* plugin info */
+ plugin_class->plugin_name = GNC_PLUGIN_REPORT_SYSTEM_NAME;
+
+ /* widget addition/removal */
+ plugin_class->actions_name = PLUGIN_ACTIONS_NAME;
+ plugin_class->actions = gnc_plugin_actions;
+ plugin_class->n_actions = gnc_plugin_n_actions;
+ plugin_class->ui_filename = PLUGIN_UI_FILENAME;
+}
+
+static void
+gnc_plugin_report_system_init (GncPluginReportSystem *plugin)
+{
+}
+
+static void
+gnc_plugin_report_system_finalize (GObject *object)
+{
+ g_return_if_fail (GNC_IS_PLUGIN_REPORT_SYSTEM (object));
+
+ G_OBJECT_CLASS (parent_class)->finalize (object);
+}
+
+/************************************************************
+ * Command Callbacks *
+ ************************************************************/
+
+static void
+gnc_plugin_report_system_cmd_edit_style_sheet (GtkAction *action,
+ GncMainWindowActionData *data)
+{
+ gnc_style_sheet_dialog_open(GTK_WINDOW (data->window));
+}
+
+/************************************************************
+ * Html url and stream handlers *
+ ************************************************************/
+
+static gboolean
+gnc_report_system_file_stream_cb (const char *location, char ** data, int *len)
+{
+ *len = gncReadFile (location, data);
+ return (*len > 0);
+}
+
+static gboolean
+gnc_report_system_report_stream_cb (const char *location, char ** data, int *len)
+{
+ gboolean ok;
+
+ ok = gnc_run_report_id_string (location, data);
+
+ if (!ok)
+ {
++ SCM captured = scm_c_eval_string ("gnc:last-captured-error");
++ gchar *captured_str = gnc_scm_to_utf8_string(captured);
++
+ *data = g_strdup_printf ("<html><body><h3>%s</h3>"
- "<p>%s</p></body></html>",
- _("Report error"),
- _("An error occurred while running the report."));
++ "<p>%s</p><pre>%s</pre></body></html>",
++ _("Report error"),
++ _("An error occurred while running the report."),
++ captured_str);
++
++ g_free(captured_str);
+
+ /* Make sure the progress bar is finished, which will also
+ * make the GUI sensitive again. Easier to do this via guile
+ * because otherwise we would need to link against gnome-utils
+ * and a lot more. */
+ scm_c_eval_string("(gnc:report-finished)");
+ }
+
+ *len = strlen(*data);
+ return ok;
+}
+
+/* TODO: unroll start_editor */
+static gboolean
+gnc_report_system_options_url_cb (const char *location, const char *label,
+ gboolean new_window, GNCURLResult *result)
+{
+ SCM report;
+ int report_id;
+
+ g_return_val_if_fail (location != NULL, FALSE);
+ g_return_val_if_fail (result != NULL, FALSE);
+
+ result->load_to_stream = FALSE;
+
+ /* href="gnc-options:report-id=2676" */
+ if (strncmp ("report-id=", location, 10) == 0)
+ {
+ if (sscanf (location + 10, "%d", &report_id) != 1)
+ {
+ result->error_message =
+ g_strdup_printf (_("Badly formed options URL: %s"), location);
+
+ return FALSE;
+ }
+
+ report = gnc_report_find(report_id);
+ if (report == SCM_UNDEFINED ||
+ report == SCM_BOOL_F)
+ {
+ result->error_message =
+ g_strdup_printf (_("Badly-formed report id: %s"), location);
+
+ return FALSE;
+ }
+
+ gnc_report_edit_options (report, GTK_WINDOW(result->parent));
+
+ return TRUE;
+ }
+ else
+ {
+ result->error_message =
+ g_strdup_printf (_("Badly formed options URL: %s"), location);
+
+ return FALSE;
+ }
+}
+
+static gboolean
+gnc_report_system_report_url_cb (const char *location, const char *label,
+ gboolean new_window, GNCURLResult *result)
+{
+ g_return_val_if_fail (location != NULL, FALSE);
+ g_return_val_if_fail (result != NULL, FALSE);
+
+ /* make a new window if necessary */
+ if (new_window)
+ {
+ char *url;
+
+ url = gnc_build_url (URL_TYPE_REPORT, location, label);
+ gnc_main_window_open_report_url (url, GNC_MAIN_WINDOW(result->parent));
+ g_free (url);
+
+ result->load_to_stream = FALSE;
+ }
+ else
+ {
+ result->load_to_stream = TRUE;
+ }
+
+ return TRUE;
+}
+
+static gboolean
+gnc_report_system_help_url_cb (const char *location, const char *label,
+ gboolean new_window, GNCURLResult *result)
+{
+ g_return_val_if_fail (location != NULL, FALSE);
+
+ if (label && (*label != '\0'))
+ gnc_gnome_help (location, label);
+ else
+ gnc_gnome_help (location, NULL);
+ return TRUE;
+}
+
+
+/************************************************************
+ * Plugin Bootstrapping *
+ ************************************************************/
+
+void
+gnc_plugin_report_system_new (void)
+{
+ GncPlugin *plugin;
+
+ /* Reference the report page plugin to ensure it exists in the gtk
+ * type system. */
+ GNC_TYPE_PLUGIN_PAGE_REPORT;
+
+ /* Register html handlers */
+ gnc_html_register_stream_handler (URL_TYPE_HELP, gnc_report_system_file_stream_cb);
+ gnc_html_register_stream_handler (URL_TYPE_FILE, gnc_report_system_file_stream_cb);
+ gnc_html_register_stream_handler (URL_TYPE_REPORT, gnc_report_system_report_stream_cb);
+
+ gnc_html_register_url_handler (URL_TYPE_OPTIONS, gnc_report_system_options_url_cb);
+ gnc_html_register_url_handler (URL_TYPE_REPORT, gnc_report_system_report_url_cb);
+ gnc_html_register_url_handler (URL_TYPE_HELP, gnc_report_system_help_url_cb);
+
+ scm_c_use_module("gnucash reports");
+ scm_c_use_module("gnucash report-menus");
+ scm_c_eval_string("(gnc:report-menu-setup)");
+
+ plugin = GNC_PLUGIN (g_object_new (GNC_TYPE_PLUGIN_REPORT_SYSTEM, NULL));
+ gnc_plugin_manager_add_plugin (gnc_plugin_manager_get (), plugin);
+}
diff --cc gnucash/report/html-utilities.scm
index 4769a1fa3,000000000..2c5d4957d
mode 100644,000000..100644
--- a/gnucash/report/html-utilities.scm
+++ b/gnucash/report/html-utilities.scm
@@@ -1,385 -1,0 +1,372 @@@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; html-utilities.scm: Useful functions when using the HTML generator.
+;;
+;; Modified slightly by David Montenegro 2004.06.18.
+;;
+;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+;; Boston, MA 02110-1301, USA gnu at gnu.org
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(use-modules (gnucash utilities))
+
+;; returns a list with n #f (empty cell) values
+(define (gnc:html-make-empty-cell) #f)
+(define (gnc:html-make-empty-cells n)
+ (if (> n 0)
+ (cons #f (gnc:html-make-empty-cells (- n 1)))
+ (list)))
+
+(define (gnc:register-guid type guid)
+ (gnc-build-url URL-TYPE-REGISTER (string-append type guid) ""))
+
+(define (gnc:account-anchor-text acct)
+ (gnc:register-guid "acct-guid=" (gncAccountGetGUID acct)))
+
+(define (gnc:split-anchor-text split)
+ (gnc:register-guid "split-guid=" (gncSplitGetGUID split)))
+
+(define (gnc:transaction-anchor-text trans)
+ (gnc:register-guid "trans-guid=" (gncTransGetGUID trans)))
+
+(define (gnc:report-anchor-text report-id)
+ (gnc-build-url URL-TYPE-REPORT
+ (string-append "id=" (number->string report-id))
+ ""))
+
+(define (gnc:price-anchor-text price)
+ (gnc-build-url URL-TYPE-PRICE
+ (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
+;; according to 'optionlist'. Each element of optionlist is a list of
+;; section, name, and value of the function.
+(define (gnc:make-report-anchor reportname src-report
+ optionlist)
+ (let ((src-options (gnc:report-options src-report))
+ (options (gnc:make-report-options reportname)))
+ (if options
+ (begin
+ (gnc:options-copy-values src-options options)
+ (for-each
+ (lambda (l)
+ (let ((o (gnc:lookup-option options (car l) (cadr l))))
+ (if o
+ (gnc:option-set-value o (caddr l))
+ (warn "gnc:make-report-anchor:" reportname
+ " No such option: " (car l) (cadr l)))))
+ optionlist)
+ (let ((id (gnc:make-report reportname options)))
+ (gnc:report-anchor-text id)))
+ (warn "gnc:make-report-anchor: No such report: " reportname))))
+
+
+;; returns the account name as html-text and anchor to the register.
+(define (gnc:html-account-anchor acct)
+ (gnc:make-html-text (if (and acct (not (null? acct)))
+ (gnc:html-markup-anchor
+ (gnc:account-anchor-text acct)
+ (xaccAccountGetName acct))
+ "")))
+
+(define (gnc:html-split-anchor split text)
+ (gnc:make-html-text (if (not (null? (xaccSplitGetAccount split)))
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text split)
+ text)
+ text)))
+
+(define (gnc:html-transaction-anchor trans text)
+ (gnc:make-html-text (gnc:html-markup-anchor
+ (gnc:transaction-anchor-text trans)
+ text)))
+
+(define (gnc:html-price-anchor price value)
+ (gnc:make-html-text (if price
+ (gnc:html-markup-anchor
+ (gnc:price-anchor-text price)
+ (if value
+ value
+ (gnc-price-get-value price)))
+ value)))
+
+(define (gnc:assign-colors num-colors)
+ ;; default CSS colours
+ ;; (define base-colors '("red" "orange" "yellow" "green"
+ ;; "cyan" "blue" "purple" "magenta"
+ ;; "orchid" "khaki" "gold" "orange"
+ ;; "red3" "orange3" "yellow3" "green3"
+ ;; "cyan3" "blue3" "purple3" "magenta3"
+ ;; "orchid3" "khaki3" "gold3" "orange3"))
+
+ ;; new base-colors from http://clrs.cc/ and flatuicolors.com
+ (define base-colors (list "#FF4136" "#FF851B" "#FFDC00" "#2ECC40"
+ "#0074D9" "#001f3f" "#85144b" "#7FDBFF"
+ "#F012BE" "#3D9970" "#39CCCC" "#f39c12"
+ "#e74c3c" "#e67e22" "#9b59b6" "#8e44ad"
+ "#16a085" "#d35400"))
+ (let lp ((i 0) (result '()) (colors base-colors))
+ (cond
+ ((<= num-colors i) (reverse result))
+ ((null? colors) (lp (1+ i) (cons (car base-colors) result) (cdr base-colors)))
+ (else (lp (1+ i) (cons (car colors) result) (cdr colors))))))
+
+;; Appends a horizontal ruler to a html-table with the specified
+;; colspan at, optionally, the specified column.
+(define (gnc:html-table-append-ruler/at! table colskip colspan)
+ (define empty-cell '())
+ (gnc:html-table-append-row!
+ table
+ (append (make-list colskip empty-cell)
+ (list
+ (gnc:make-html-table-cell/size
+ 1 colspan (gnc:make-html-text (gnc:html-markup-hr)))))))
+
+(define (gnc:html-table-append-ruler/at/markup! table markup colskip colspan)
+ (define empty-cell "")
+ (gnc:html-table-append-row/markup!
+ table
+ markup
+ (append (make-list colskip empty-cell)
+ (list
+ (gnc:make-html-table-cell/size
+ 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))
+
+;; Create a html-table of all exchange rates. The report-commodity is
+;; 'common-commodity', the exchange rates are given through the
+;; function 'exchange-fn' and the 'accounts' determine which
+;; commodities to show. Returns a html-object, a <html-table>.
+(define (gnc:html-make-exchangerates common-commodity exchange-fn accounts)
+ (let ((comm-list (gnc:accounts-get-commodities accounts common-commodity))
+ (markup (lambda (c) (gnc:make-html-table-cell/markup "number-cell" c)))
+ (table (gnc:make-html-table)))
+ (unless (null? comm-list)
+ (for-each
+ (lambda (commodity)
+ (let* ((orig-amt (gnc:make-gnc-monetary commodity 1))
+ (exchanged (exchange-fn orig-amt common-commodity)))
+ (gnc:html-table-append-row!
+ table (map markup (list orig-amt exchanged)))))
+ comm-list)
+ (gnc:html-table-set-col-headers!
+ table (list (gnc:make-html-table-header-cell/size
+ 1 2 (if (null? (cdr comm-list))
+ (_ "Exchange rate")
+ (_ "Exchange rates"))))))
+ table))
+
+
+(define (gnc:html-make-generic-budget-warning report-title-string)
+ (gnc:html-make-generic-simple-warning
+ report-title-string
+ (_ "No budgets exist. You must create at least one budget.")))
+
+
+(define (gnc:html-make-generic-simple-warning report-title-string message)
+ (let ((p (gnc:make-html-text)))
+ (gnc:html-text-append!
+ p
+ (gnc:html-markup-h2 (string-append report-title-string ":"))
+ (gnc:html-markup-h2 "")
+ (gnc:html-markup-p message))
+ p))
+
+
+(define (gnc:html-make-options-link report-id)
+ (if report-id
+ (gnc:html-markup-p
+ (gnc:html-markup-anchor
+ (gnc-build-url URL-TYPE-OPTIONS
+ (string-append "report-id=" (format #f "~a" report-id))
+ "")
+ (_ "Edit report options")))))
+
+(define* (gnc:html-render-options-changed options #:optional plaintext?)
+ ;; options -> html-object or string, depending on plaintext?. This
+ ;; summarises options that were changed by the user. Set plaintext?
+ ;; to #t for unit-tests only.
+ (define (disp d)
+ ;; option-value -> string. The option is passed to various
+ ;; scm->string converters; ultimately a generic stringify
+ ;; function handles symbol/string/other types.
+ (define (try proc)
+ ;; Try proc with d as a parameter, catching 'wrong-type-arg
+ ;; exceptions to return #f to the or evaluator.
+ (catch 'wrong-type-arg
+ (lambda () (proc d))
+ (const #f)))
+ (or (and (boolean? d) (if d (_ "Enabled") (_ "Disabled")))
+ (and (null? d) "null")
+ (and (list? d) (string-join (map disp d) ", "))
+ (and (pair? d) (format #f "~a . ~a"
+ (car d)
+ (if (eq? (car d) 'absolute)
+ (qof-print-date (cdr d))
+ (disp (cdr d)))))
+ (try gnc-commodity-get-mnemonic)
+ (try xaccAccountGetName)
+ (try gnc-budget-get-name)
+ (format #f "~a" d)))
+ (let ((render-list '()))
+ (define (add-option-if-changed option)
+ (let* ((section (gnc:option-section option))
+ (name (gnc:option-name option))
+ (default-value (gnc:option-default-value option))
+ (value (gnc:option-value option))
+ (retval (cons (format #f "~a / ~a" section name)
+ (disp value))))
+ (if (not (or (equal? default-value value)
+ (char=? (string-ref section 0) #\_)))
+ (addto! render-list retval))))
+ (gnc:options-for-each add-option-if-changed options)
+ (if plaintext?
+ (string-append
+ (string-join
+ (map (lambda (item)
+ (format #f "~a: ~a\n" (car item) (cdr item)))
+ render-list)
+ "")
+ "\n")
+ (apply
+ gnc:make-html-text
+ (apply
+ append
+ (map
+ (lambda (item)
+ (list
+ (gnc:html-markup-b (car item))
+ ": "
+ (cdr item)
+ (gnc:html-markup-br)))
+ render-list))))))
+
+(define (gnc:html-make-generic-warning
+ report-title-string report-id
+ warning-title-string warning-string)
+ (let ((p (gnc:make-html-text)))
+ (gnc:html-text-append!
+ p
+ (gnc:html-markup-h2 (string-append (_ report-title-string) ":"))
+ (gnc:html-markup-h2 warning-title-string)
+ (gnc:html-markup-p warning-string)
+ (gnc:html-make-options-link report-id))
+ p))
+
+(define (gnc:html-make-generic-options-warning
+ report-title-string report-id)
+ (gnc:html-make-generic-warning
+ report-title-string
+ report-id
+ ""
+ (_ "This report requires you to specify certain report options.")))
+
+(define (gnc:html-make-no-account-warning
+ report-title-string report-id)
+ (gnc:html-make-generic-warning
+ report-title-string
+ report-id
+ (_ "No accounts selected")
+ (_ "This report requires accounts to be selected in the report options.")))
+
+(define (gnc:html-make-empty-data-warning
+ report-title-string report-id)
+ (gnc:html-make-generic-warning
+ report-title-string
+ report-id
+ (_ "No data")
+ (_ "The selected accounts contain no data/transactions (or only zeroes) for the selected time period")))
+
+(define (gnc:html-js-include file)
+ (format #f
+ "<script language=\"javascript\" type=\"text/javascript\" src=\"file:///~a\"></script>\n"
+ (gnc-path-find-localized-html-file file)))
+
+(define (gnc:html-css-include file)
+ (format #f
+ "<link rel=\"stylesheet\" type=\"text/css\" href=\"file:///~a\" />\n"
+ (gnc-path-find-localized-html-file file)))
+
- ;; function to sanitize strings prior to sending to html
- (define (gnc:html-string-sanitize str)
- (with-output-to-string
- (lambda ()
- (string-for-each
- (lambda (c)
- (display
- (case c
- ((#\&) "&")
- ((#\<) "<")
- ((#\>) ">")
- (else c))))
- str))))
+
+
diff --cc gnucash/report/report.scm
index 75ce72831,ceee70e11..03fbbba3e
--- a/gnucash/report/report.scm
+++ b/gnucash/report/report.scm
@@@ -113,9 -122,8 +113,8 @@@
(export gnc:html-make-options-link)
(export gnc:html-js-include)
(export gnc:html-css-include)
- (export gnc:html-string-sanitize)
-;; report.scm
+;; report-core.scm
(export gnc:menuname-reports)
(export gnc:menuname-asset-liability)
(export gnc:menuname-income-expense)
diff --cc gnucash/report/reports/standard/test/CMakeLists.txt
index 560523605,600105681..810050ae3
--- a/gnucash/report/reports/standard/test/CMakeLists.txt
+++ b/gnucash/report/reports/standard/test/CMakeLists.txt
@@@ -16,8 -16,7 +16,9 @@@ set(scm_test_with_srfi64_SOURCE
test-register.scm
test-trial-balance.scm
test-average-balance.scm
+ test-invoice.scm
+ test-owner-report.scm
+ test-portfolios.scm
)
set(scm_test_with_textual_ports_SOURCES
diff --cc gnucash/report/reports/standard/test/test-portfolios.scm
index 000000000,6ce643e8e..df47e45ba
mode 000000,100644..100644
--- a/gnucash/report/reports/standard/test/test-portfolios.scm
+++ b/gnucash/report/reports/standard/test/test-portfolios.scm
@@@ -1,0 -1,127 +1,127 @@@
+ (use-modules (gnucash gnc-module))
+ (gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-(use-modules (gnucash engine test test-extras))
-(use-modules (gnucash report standard-reports portfolio))
-(use-modules (gnucash report standard-reports advanced-portfolio))
-(use-modules (gnucash report stylesheets))
-(use-modules (gnucash report report-system))
-(use-modules (gnucash report report-system test test-extras))
++(use-modules (tests test-engine-extras))
++(use-modules (gnucash reports standard portfolio))
++(use-modules (gnucash reports standard advanced-portfolio))
++(use-modules (gnucash report stylesheets plain))
++(use-modules (gnucash report))
++(use-modules (tests test-report-extras))
+ (use-modules (srfi srfi-64))
-(use-modules (gnucash engine test srfi64-extras))
++(use-modules (tests srfi64-extras))
+ (use-modules (sxml simple))
+ (use-modules (sxml xpath))
+ (use-modules (system vm coverage))
+ (use-modules (system vm vm))
+
+ ;; This is implementation testing for both the Portfolio and the
+ ;; Advanced Portfolio Report.
+
+ (define portfolio-uuid "4a6b82e8678c4f3d9e85d9f09634ca89")
+ (define advanced-uuid "21d7cfc59fc74f22887596ebde7e462d")
+
+ ;; Explicitly set locale to make the report output predictable
+ (setlocale LC_ALL "C")
+
+ (define (run-test)
+ (if #f
+ (coverage-test)
+ (run-test-proper)))
+
+ (define (coverage-test)
+ (let ((currfile (dirname (current-filename))))
+ (add-to-load-path (string-take currfile (string-rindex currfile #\/))))
+ (call-with-values
+ (lambda () (with-code-coverage run-test-proper))
+ (lambda (data result)
+ (let ((port (open-output-file "/tmp/lcov.info")))
+ (coverage-data->lcov data port)
+ (close port)))))
+
+ (define (run-test-proper)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-portfolios.scm")
+ (null-test "portfolio" portfolio-uuid)
+ (null-test "advanced-portfolio" advanced-uuid)
+ (portfolio-tests)
+ (advanced-tests)
+ (test-end "test-portfolios.scm"))
+
+ (define (options->sxml uuid options test-title)
+ (gnc:options->sxml uuid options "test-apr" test-title))
+
+ (define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+ (define (teardown)
+ (gnc-pricedb-destroy
+ (gnc-pricedb-get-db
+ (gnc-get-current-book)))
+ (gnc-clear-current-session))
+
+ (define (null-test variant uuid)
+ ;; This null-test tests for the presence of report.
+ (let ((options (gnc:make-report-options uuid)))
+ (test-assert (format #f "null-test ~a" variant)
+ (options->sxml uuid options "null-test"))))
+
+ (define (portfolio-tests)
+ (test-group-with-cleanup "portfolio-tests"
+ (let* ((account-alist (create-stock-test-data))
+ (options (gnc:make-report-options portfolio-uuid)))
+ (set-option! options "General" "Price Source" 'pricedb-latest)
+ (let ((sxml (options->sxml portfolio-uuid options "latest")))
+ (test-equal "portfolio: pricedb-latest"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$252.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'pricedb-nearest)
+ (set-option! options "General" "Date" (cons 'absolute (gnc-dmy2time64 1 3 1980)))
+ (let ((sxml (options->sxml portfolio-uuid options "nearest")))
+ (test-equal "portfolio: pricedb-nearest"
+ '("AAPL" "AAPL" "NASDAQ" "2.00" "$200.00" "$400.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'average-cost)
+ (set-option! options "General" "Date" (cons 'absolute (gnc-dmy2time64 1 9 1980)))
+ (let ((sxml (options->sxml portfolio-uuid options "average-cost")))
+ (test-equal "portfolio: average-cost"
+ '("AAPL" "AAPL" "NASDAQ" "1.00" "$200.00" "$200.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'weighted-average)
+ (let ((sxml (options->sxml portfolio-uuid options "'weighted-average")))
+ (test-equal "portfolio: weighted-average"
+ '("AAPL" "AAPL" "NASDAQ" "1.00" "$233.33" "$233 + 1/3")
+ (sxml->table-row-col sxml 1 1 #f))))
+ (teardown)))
+
+ (define (advanced-tests)
+ (test-group-with-cleanup "advanced-portfolio-tests"
+ (let ((account-alist (create-stock-test-data))
+ (options (gnc:make-report-options advanced-uuid)))
+ (let ((sxml (options->sxml advanced-uuid options "basic average")))
+ (test-equal "advanced: average basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$484.88" "$252.00" "$800.00"
+ "$553.00" "$227.88" "-$232.88" "-$5.00" "-0.63%" "$4.00"
+ "$10.00" "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Basis calculation method" 'fifo-basis)
+ (let ((sxml (options->sxml advanced-uuid options "basic fifo")))
+ (test-equal "advanced: fifo basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$543.94" "$252.00" "$800.00"
+ "$553.00" "$286.94" "-$291.94" "-$5.00" "-0.63%" "$4.00" "$10.00"
+ "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Basis calculation method" 'filo-basis)
+ (let ((sxml (options->sxml advanced-uuid options "basic filo")))
+ (test-equal "advanced: filo basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$400.00" "$252.00" "$800.00"
+ "$553.00" "$143.00" "-$148.00" "-$5.00" "-0.63%" "$4.00" "$10.00"
+ "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f))))
+ (teardown)))
commit 22cdd237f1c00b9679382793b19124a215a2df58
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Feb 21 17:07:17 2019 +0800
[test-portfolios] initial commit
1.1.1980 seed $10,000
1.2.1980 buy 1 AAPL @ $100
1.3.1980 buy 1 AAPL @ $200
1.5.1980 sell 1 AAPL @ $400, FIFO capgain = $300, less $10 fee
1.10.1980 1:10 stock split 1 to 10 AAPL, price now $40
1.11.1980 1:10 stock split 10 to 100 AAPL, price now $4
1.12.1980 3:1 stock split 100 to 33 AAPL, price now $12;
cash-in-lieu for 1/3 AAPL = $4
tests both portfolio.scm and advanced-portfolio.csm
tests report output using average/fifo/lifo
pending: DRP etc
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index 97b09f68a..600105681 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -16,6 +16,7 @@ set(scm_test_with_srfi64_SOURCES
test-register.scm
test-trial-balance.scm
test-average-balance.scm
+ test-portfolios.scm
)
set(scm_test_with_textual_ports_SOURCES
diff --git a/gnucash/report/standard-reports/test/test-portfolios.scm b/gnucash/report/standard-reports/test/test-portfolios.scm
new file mode 100644
index 000000000..6ce643e8e
--- /dev/null
+++ b/gnucash/report/standard-reports/test/test-portfolios.scm
@@ -0,0 +1,127 @@
+(use-modules (gnucash gnc-module))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report standard-reports portfolio))
+(use-modules (gnucash report standard-reports advanced-portfolio))
+(use-modules (gnucash report stylesheets))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (sxml simple))
+(use-modules (sxml xpath))
+(use-modules (system vm coverage))
+(use-modules (system vm vm))
+
+;; This is implementation testing for both the Portfolio and the
+;; Advanced Portfolio Report.
+
+(define portfolio-uuid "4a6b82e8678c4f3d9e85d9f09634ca89")
+(define advanced-uuid "21d7cfc59fc74f22887596ebde7e462d")
+
+;; Explicitly set locale to make the report output predictable
+(setlocale LC_ALL "C")
+
+(define (run-test)
+ (if #f
+ (coverage-test)
+ (run-test-proper)))
+
+(define (coverage-test)
+ (let ((currfile (dirname (current-filename))))
+ (add-to-load-path (string-take currfile (string-rindex currfile #\/))))
+ (call-with-values
+ (lambda () (with-code-coverage run-test-proper))
+ (lambda (data result)
+ (let ((port (open-output-file "/tmp/lcov.info")))
+ (coverage-data->lcov data port)
+ (close port)))))
+
+(define (run-test-proper)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-portfolios.scm")
+ (null-test "portfolio" portfolio-uuid)
+ (null-test "advanced-portfolio" advanced-uuid)
+ (portfolio-tests)
+ (advanced-tests)
+ (test-end "test-portfolios.scm"))
+
+(define (options->sxml uuid options test-title)
+ (gnc:options->sxml uuid options "test-apr" test-title))
+
+(define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+(define (teardown)
+ (gnc-pricedb-destroy
+ (gnc-pricedb-get-db
+ (gnc-get-current-book)))
+ (gnc-clear-current-session))
+
+(define (null-test variant uuid)
+ ;; This null-test tests for the presence of report.
+ (let ((options (gnc:make-report-options uuid)))
+ (test-assert (format #f "null-test ~a" variant)
+ (options->sxml uuid options "null-test"))))
+
+(define (portfolio-tests)
+ (test-group-with-cleanup "portfolio-tests"
+ (let* ((account-alist (create-stock-test-data))
+ (options (gnc:make-report-options portfolio-uuid)))
+ (set-option! options "General" "Price Source" 'pricedb-latest)
+ (let ((sxml (options->sxml portfolio-uuid options "latest")))
+ (test-equal "portfolio: pricedb-latest"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$252.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'pricedb-nearest)
+ (set-option! options "General" "Date" (cons 'absolute (gnc-dmy2time64 1 3 1980)))
+ (let ((sxml (options->sxml portfolio-uuid options "nearest")))
+ (test-equal "portfolio: pricedb-nearest"
+ '("AAPL" "AAPL" "NASDAQ" "2.00" "$200.00" "$400.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'average-cost)
+ (set-option! options "General" "Date" (cons 'absolute (gnc-dmy2time64 1 9 1980)))
+ (let ((sxml (options->sxml portfolio-uuid options "average-cost")))
+ (test-equal "portfolio: average-cost"
+ '("AAPL" "AAPL" "NASDAQ" "1.00" "$200.00" "$200.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'weighted-average)
+ (let ((sxml (options->sxml portfolio-uuid options "'weighted-average")))
+ (test-equal "portfolio: weighted-average"
+ '("AAPL" "AAPL" "NASDAQ" "1.00" "$233.33" "$233 + 1/3")
+ (sxml->table-row-col sxml 1 1 #f))))
+ (teardown)))
+
+(define (advanced-tests)
+ (test-group-with-cleanup "advanced-portfolio-tests"
+ (let ((account-alist (create-stock-test-data))
+ (options (gnc:make-report-options advanced-uuid)))
+ (let ((sxml (options->sxml advanced-uuid options "basic average")))
+ (test-equal "advanced: average basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$484.88" "$252.00" "$800.00"
+ "$553.00" "$227.88" "-$232.88" "-$5.00" "-0.63%" "$4.00"
+ "$10.00" "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Basis calculation method" 'fifo-basis)
+ (let ((sxml (options->sxml advanced-uuid options "basic fifo")))
+ (test-equal "advanced: fifo basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$543.94" "$252.00" "$800.00"
+ "$553.00" "$286.94" "-$291.94" "-$5.00" "-0.63%" "$4.00" "$10.00"
+ "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Basis calculation method" 'filo-basis)
+ (let ((sxml (options->sxml advanced-uuid options "basic filo")))
+ (test-equal "advanced: filo basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$400.00" "$252.00" "$800.00"
+ "$553.00" "$143.00" "-$148.00" "-$5.00" "-0.63%" "$4.00" "$10.00"
+ "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f))))
+ (teardown)))
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 84e23deed..3fbe5bd9f 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -833,3 +833,180 @@
"trans-payment-num-1"))
(vector inv-1 inv-2 inv-3 inv-4 inv-5 inv-6 inv-7 inv-8)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; various stock transactions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; This function aims to replicate the stock-split process in
+;; gnc_stock_split_assistant_finish in assistant-stock-split.c. It
+;; creates a 1 or 3-split transaction, and possibly a pricedb entry.
+(define (stock-split account date shares description
+ ;; price-amount may be #f
+ price-amount pricecurrency
+ ;; cash-in-lieu, cash-amount may be #f
+ cash-amount cash-memo cash-income cash-asset)
+ (let* ((book (gnc-get-current-book))
+ (accounts '())
+ (trans (xaccMallocTransaction book)))
+ (xaccTransBeginEdit trans)
+ (xaccTransSetCurrency trans (gnc-default-currency))
+ (xaccTransSetDatePostedSecsNormalized trans date)
+ (xaccTransSetDescription trans description)
+
+ (let ((stocksplit (xaccMallocSplit book)))
+ (xaccAccountBeginEdit account)
+ (set! accounts (cons account accounts))
+ (xaccSplitSetAccount stocksplit account)
+ (xaccSplitSetAmount stocksplit shares)
+ (xaccSplitMakeStockSplit stocksplit)
+ (xaccSplitSetAction stocksplit "Split")
+ (xaccSplitSetParent stocksplit trans))
+
+ ;; add pricedb
+ (when price-amount
+ (let ((price (gnc-price-create book)))
+ (gnc-price-begin-edit price)
+ (gnc-price-set-commodity price (xaccAccountGetCommodity account))
+ (gnc-price-set-currency price pricecurrency)
+ (gnc-price-set-time64 price date)
+ (gnc-price-set-source price PRICE-SOURCE-STOCK-SPLIT)
+ (gnc-price-set-typestr price "unknown")
+ (gnc-price-set-value price price-amount)
+ (gnc-price-commit-edit price)
+ (gnc-pricedb-add-price (gnc-pricedb-get-db book) price)))
+
+ ;; cash-in-lieu
+ (when cash-amount
+ (let ((asset-split (xaccMallocSplit book)))
+ (xaccAccountBeginEdit cash-asset)
+ (set! accounts (cons cash-asset accounts))
+ (xaccSplitSetAccount asset-split cash-asset)
+ (xaccSplitSetParent asset-split trans)
+ (xaccSplitSetAmount asset-split cash-amount)
+ (xaccSplitSetValue asset-split cash-amount)
+ (xaccSplitSetMemo asset-split cash-memo))
+
+ (let ((income-split (xaccMallocSplit book)))
+ (xaccAccountBeginEdit cash-income)
+ (set! accounts (cons cash-income accounts))
+ (xaccSplitSetAccount income-split cash-income)
+ (xaccSplitSetParent income-split trans)
+ (xaccSplitSetAmount income-split (- cash-amount))
+ (xaccSplitSetValue income-split (- cash-amount))
+ (xaccSplitSetMemo income-split cash-memo)))
+
+ (xaccTransCommitEdit trans)
+ (for-each xaccAccountCommitEdit accounts)
+ trans))
+
+(define-public (create-stock-test-data)
+ (define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Asset"
+ (list "Bank"))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+ (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
+ (list "Broker"
+ (list "AAPL" (list (cons 'type ACCT-TYPE-STOCK)))
+ (list "MSFT" (list (cons 'type ACCT-TYPE-STOCK)))
+ (list "TSLA" (list (cons 'type ACCT-TYPE-STOCK))))))
+ (let* ((env (create-test-env))
+ (book (gnc-get-current-book))
+ (comm-table (gnc-commodity-table-get-table book))
+ (AAPL (gnc-commodity-new book "Apple" "NASDAQ" "AAPL" "" 1))
+ (MSFT (gnc-commodity-new book "Microsoft" "NASDAQ" "MSFT" "" 1))
+ (TSLA (gnc-commodity-new book "Tesla Motors" "NASDAQ" "TSLA" "" 1))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank (cdr (assoc "Bank" account-alist)))
+ (inco (cdr (assoc "Income" account-alist)))
+ (expe (cdr (assoc "Expenses" account-alist)))
+ (equity (cdr (assoc "Equity" account-alist)))
+ (aapl (cdr (assoc "AAPL" account-alist)))
+ (msft (cdr (assoc "MSFT" account-alist)))
+ (tsla (cdr (assoc "TSLA" account-alist)))
+ (YEAR (gnc:time64-get-year (gnc:get-today))))
+
+ ;; Set account commodities
+ (gnc-commodity-table-insert comm-table AAPL)
+ (gnc-commodity-table-insert comm-table MSFT)
+ (gnc-commodity-table-insert comm-table TSLA)
+ (xaccAccountSetCommodity aapl AAPL)
+ (xaccAccountSetCommodity msft MSFT)
+ (xaccAccountSetCommodity tsla TSLA)
+
+ (env-transfer env 01 01 1980 equity bank 10000 #:description "seed money")
+
+ (env-create-multisplit-transaction
+ env 01 02 1980
+ (list (vector bank -100 -100)
+ (vector aapl 100 1))
+ #:description "buy 1 AAPL @ $100")
+
+ (env-create-multisplit-transaction
+ env 01 03 1980
+ (list (vector bank -200 -200)
+ (vector aapl 200 1))
+ #:description "buy 1 AAPL @ $200")
+
+ (env-create-multisplit-transaction
+ env 01 05 1980
+ (list (vector bank 390 390)
+ (vector aapl -400 -1)
+ (vector inco -300 -300)
+ (vector expe 10 10)
+ (vector aapl 300 0))
+ #:description "sell 1 AAPL @ $400 FIFO, brokerage fee = $10, into bank = $390")
+
+ ;; until 1.5.1980 the account has usual buy/sell txns only, no stock splits
+ ;; there's only 1 AAPL left, price $400
+
+ ;; on 1.10.1980: stock split, 1 AAPL -> 10 AAPL
+ ;; prev price was $400, now is $40
+ (stock-split aapl
+ (gnc-dmy2time64 1 10 1980)
+ 9 "first 1:10 stock split"
+ 40 (gnc-account-get-currency-or-parent aapl)
+ #f #f #f #f)
+
+ ;; on 1.11.1980: another stock split, 10 AAPL -> 100 AAPL
+ ;; prev price was $40, now is $4
+ (stock-split aapl
+ (gnc-dmy2time64 1 11 1980)
+ 90 "another 1:10 stock split"
+ 4 (gnc-account-get-currency-or-parent aapl)
+ #f #f #f #f)
+
+ ;; on 1.12.1980: 3:1 stock split, 100 AAPL -> 33 AAPL
+ ;; prev price was $4, now is $12, with cash-in-lieu $4
+ (stock-split aapl
+ (gnc-dmy2time64 1 12 1980)
+ -67 "3:1 stock split with cash-in-lieu $4"
+ 12 (gnc-account-get-currency-or-parent aapl)
+ 4 "cash-in-lieu" inco bank)
+
+ (env-create-multisplit-transaction
+ env 01 01 1981
+ (list (vector bank -500 -500)
+ (vector aapl 500 10))
+ #:description "buy 10 AAPL @ $5")
+
+ (env-create-multisplit-transaction
+ env 1 3 1981
+ (list (vector bank 3 3)
+ (vector aapl -3 -1/2)
+ (vector inco -5/2 -5/2)
+ (vector aapl 5/2 0))
+ #:description "sell 1/2 AAPL @ $6 FIFO, capgain = $2.50 into bank = $200")
+
+ ;; FIXME: spin off $150 from AAPL is coded correctly? there's no
+ ;; INCOME split?
+ (env-create-multisplit-transaction
+ env 1 4 1981
+ (list (vector bank 150 150)
+ (vector aapl -150 0))
+ #:description "spin-off $150")
+
+ account-alist))
+
commit 298724dd93c475e2b730679a66acbcdcd94bbb5e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Sep 24 23:03:27 2019 +0800
[portfolio] there's no report-currency. use currency.
diff --git a/gnucash/report/standard-reports/portfolio.scm b/gnucash/report/standard-reports/portfolio.scm
index 7e985eb3c..1aedcf1ef 100644
--- a/gnucash/report/standard-reports/portfolio.scm
+++ b/gnucash/report/standard-reports/portfolio.scm
@@ -196,7 +196,7 @@
(if (not (null? accounts))
(let* ((commodity-list (gnc:accounts-get-commodities
(gnc:accounts-and-all-descendants accounts)
- report-currency))
+ currency))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(exchange-fn (gnc:case-exchange-fn price-source currency to-date))
(price-fn
commit ee260d8e3a197a63b394d3a41e9ec502dcf92842
Author: Robert Fewell <14uBobIT at gmail.com>
Date: Mon Sep 23 13:28:34 2019 +0100
Bug 797416 - Enter key does not move to blank tx or next line
Caused by a previous commit that did not allow for just pressing the
enter key without changes to move to the next transaction. This was
part of a change to stop being asked to create a new account many times
when the transfer cell had been changed and declining it. To fix this
when gnc_split_reg_record returns false, test for the current cursor
changed flag being not set to proceed to do the move.
diff --git a/gnucash/gnome/gnc-split-reg.c b/gnucash/gnome/gnc-split-reg.c
index 5291e41bb..41ba0f628 100644
--- a/gnucash/gnome/gnc-split-reg.c
+++ b/gnucash/gnome/gnc-split-reg.c
@@ -2353,15 +2353,21 @@ gnc_split_reg_enter( GNCSplitReg *gsr, gboolean next_transaction )
}
}
}
-
/* First record the transaction. This will perform a refresh. */
if (!gnc_split_reg_record (gsr))
{
- /* make sure the sheet has the focus if the record is FALSE
+ /* we may come here from the transfer cell if we decline to create a
+ * new account, make sure the sheet has the focus if the record is FALSE
* which results in no cursor movement. */
gnc_split_reg_focus_on_sheet (gsr);
- LEAVE(" ");
- return;
+
+ /* if there are no changes, just enter was pressed, proceed to move
+ * other wise lets not move. */
+ if (gnc_table_current_cursor_changed (sr->table, FALSE))
+ {
+ LEAVE(" ");
+ return;
+ }
}
if (!goto_blank && next_transaction)
commit 9832fa397a5ba1ae898ce206baac7a09a5d3a9e2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Sep 22 18:46:12 2019 +0800
[window-report] show backtrace when report crashes
* exposes a SCM string last-captured-error containing last backtrace
* when rendering report-crash window, include it
diff --git a/gnucash/report/report-gnome/window-report.c b/gnucash/report/report-gnome/window-report.c
index d884df647..077650584 100644
--- a/gnucash/report/report-gnome/window-report.c
+++ b/gnucash/report/report-gnome/window-report.c
@@ -274,10 +274,16 @@ gnc_html_report_stream_cb (const char *location, char ** data, int *len)
if (!ok)
{
+ SCM captured = scm_c_eval_string ("gnc:last-captured-error");
+ gchar *captured_str = gnc_scm_to_utf8_string(captured);
+
*data = g_strdup_printf ("<html><body><h3>%s</h3>"
- "<p>%s</p></body></html>",
+ "<p>%s</p><pre>%s</pre></body></html>",
_("Report error"),
- _("An error occurred while running the report."));
+ _("An error occurred while running the report."),
+ captured_str);
+
+ g_free (captured_str);
/* Make sure the progress bar is finished, which will also
make the GUI sensitive again. Easier to do this via guile
diff --git a/libgnucash/app-utils/c-interface.scm b/libgnucash/app-utils/c-interface.scm
index 8dba2b985..8c0b74b46 100644
--- a/libgnucash/app-utils/c-interface.scm
+++ b/libgnucash/app-utils/c-interface.scm
@@ -63,14 +63,17 @@
(define (gnc:backtrace-if-exception proc . args)
(let* ((apply-result (gnc:apply-with-error-handling proc args))
(result (car apply-result))
- (error (cadr apply-result)))
+ (captured-error (cadr apply-result)))
(cond
- (error
- (display error (current-error-port))
+ (captured-error
+ (display captured-error (current-error-port))
+ (set! gnc:last-captured-error (gnc:html-string-sanitize captured-error))
(when (defined? 'gnc:warn)
- (gnc:warn error)))
+ (gnc:warn captured-error)))
(else result))))
+(define-public gnc:last-captured-error "")
+
;; This database can be used to store and retrieve translatable
;; strings. Strings that are returned by the lookup function are
;; translated with gettext.
commit a259ba4a3e26b4b50ba911f42a40087440a5d60d
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Sep 22 21:17:40 2019 +0800
[utilities] move gnc:html-string-sanitize to utilities.scm
diff --git a/gnucash/report/report-system/html-utilities.scm b/gnucash/report/report-system/html-utilities.scm
index e2b5d5934..5f9ab1ebb 100644
--- a/gnucash/report/report-system/html-utilities.scm
+++ b/gnucash/report/report-system/html-utilities.scm
@@ -870,18 +870,5 @@
"<link rel=\"stylesheet\" type=\"text/css\" href=\"file:///~a\" />\n"
(gnc-path-find-localized-html-file file)))
-;; function to sanitize strings prior to sending to html
-(define (gnc:html-string-sanitize str)
- (with-output-to-string
- (lambda ()
- (string-for-each
- (lambda (c)
- (display
- (case c
- ((#\&) "&")
- ((#\<) "<")
- ((#\>) ">")
- (else c))))
- str))))
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 4c2dd8b92..ceee70e11 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -122,7 +122,6 @@
(export gnc:html-make-options-link)
(export gnc:html-js-include)
(export gnc:html-css-include)
-(export gnc:html-string-sanitize)
;; report.scm
(export gnc:menuname-reports)
diff --git a/gnucash/report/report-system/test/test-html-utilities-srfi64.scm b/gnucash/report/report-system/test/test-html-utilities-srfi64.scm
index b973a44e9..c722a692b 100644
--- a/gnucash/report/report-system/test/test-html-utilities-srfi64.scm
+++ b/gnucash/report/report-system/test/test-html-utilities-srfi64.scm
@@ -12,44 +12,9 @@
(define (run-test)
(test-runner-factory gnc:test-runner)
(test-begin "test-html-utilities-srfi64.scm")
- (test-gnc:html-string-sanitize)
(test-gnc:assign-colors)
(test-end "test-html-utilities-srfi64.scm"))
-(define (test-gnc:html-string-sanitize)
- (test-begin "gnc:html-string-sanitize")
- (test-equal "null test"
- "abc"
- (gnc:html-string-sanitize "abc"))
-
- (test-equal "sanitize ©"
- "©"
- (gnc:html-string-sanitize "©"))
-
- (if (not (string=? (with-output-to-string (lambda () (display "🎃"))) "🎃"))
- (test-skip 2))
- (test-equal "emoji unchanged"
- "🎃"
- (gnc:html-string-sanitize "🎃"))
-
- (test-equal "complex string"
- "Smiley:\"🙂\" something"
- (gnc:html-string-sanitize "Smiley:\"🙂\" something"))
-
- (test-equal "sanitize <b>bold tags</b>"
- "<b>bold tags</b>"
- (gnc:html-string-sanitize "<b>bold tags</b>"))
-
- (test-equal "quotes are unchanged for html"
- "\""
- (gnc:html-string-sanitize "\""))
-
- (test-equal "backslash is unchanged for html"
- "\\"
- (gnc:html-string-sanitize "\\"))
-
- (test-end "gnc:html-string-sanitize"))
-
(define (test-gnc:assign-colors)
(test-begin "test-gnc:assign-colors")
(test-equal "assign-colors can request many colors"
diff --git a/libgnucash/scm/test/test-libgnucash-scm-utilities.scm b/libgnucash/scm/test/test-libgnucash-scm-utilities.scm
index 50903c431..2f5b1a295 100644
--- a/libgnucash/scm/test/test-libgnucash-scm-utilities.scm
+++ b/libgnucash/scm/test/test-libgnucash-scm-utilities.scm
@@ -10,6 +10,7 @@
(test-traverse-vec)
(test-substring-replace)
(test-sort-and-delete-duplicates)
+ (test-gnc:html-string-sanitize)
(test-gnc:list-flatten)
(test-begin "test-libgnucash-scm-utilities.scm"))
@@ -89,6 +90,40 @@
(sort-and-delete-duplicates '(3 1 2) <))
(test-end "sort-and-delete-duplicates"))
+(define (test-gnc:html-string-sanitize)
+ (test-begin "gnc:html-string-sanitize")
+ (test-equal "null test"
+ "abc"
+ (gnc:html-string-sanitize "abc"))
+
+ (test-equal "sanitize ©"
+ "©"
+ (gnc:html-string-sanitize "©"))
+
+ (if (not (string=? (with-output-to-string (lambda () (display "🎃"))) "🎃"))
+ (test-skip 2))
+ (test-equal "emoji unchanged"
+ "🎃"
+ (gnc:html-string-sanitize "🎃"))
+
+ (test-equal "complex string"
+ "Smiley:\"🙂\" something"
+ (gnc:html-string-sanitize "Smiley:\"🙂\" something"))
+
+ (test-equal "sanitize <b>bold tags</b>"
+ "<b>bold tags</b>"
+ (gnc:html-string-sanitize "<b>bold tags</b>"))
+
+ (test-equal "quotes are unchanged for html"
+ "\""
+ (gnc:html-string-sanitize "\""))
+
+ (test-equal "backslash is unchanged for html"
+ "\\"
+ (gnc:html-string-sanitize "\\"))
+
+ (test-end "gnc:html-string-sanitize"))
+
(define (test-gnc:list-flatten)
(test-equal "gnc:list-flatten null"
'()
diff --git a/libgnucash/scm/utilities.scm b/libgnucash/scm/utilities.scm
index 574097558..4bdc61ed8 100644
--- a/libgnucash/scm/utilities.scm
+++ b/libgnucash/scm/utilities.scm
@@ -172,6 +172,23 @@
s1 s2 s3 0 (string-length s1) (max 0 (1- start))
(and (positive? end-after) (+ (max 0 (1- start)) (1- end-after)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; function to sanitize strings. the resulting string can be safely
+;; added to html.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-public (gnc:html-string-sanitize str)
+ (with-output-to-string
+ (lambda ()
+ (string-for-each
+ (lambda (c)
+ (display
+ (case c
+ ((#\&) "&")
+ ((#\<) "<")
+ ((#\>) ">")
+ (else c))))
+ str))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; avoid using strftime, still broken in guile-2.2. see explanation at
;; https://lists.gnu.org/archive/html/bug-guile/2019-05/msg00003.html
Summary of changes:
gnucash/gnome/gnc-plugin-report-system.c | 13 +-
gnucash/gnome/gnc-split-reg.c | 14 +-
gnucash/report/html-utilities.scm | 13 --
gnucash/report/report.scm | 1 -
gnucash/report/reports/standard/portfolio.scm | 2 +-
.../report/reports/standard/test/CMakeLists.txt | 1 +
.../reports/standard/test/test-portfolios.scm | 127 +++++++++++++++
gnucash/report/test/test-html-utilities-srfi64.scm | 35 ----
libgnucash/app-utils/c-interface.scm | 11 +-
libgnucash/engine/test/test-engine-extras.scm | 177 +++++++++++++++++++++
.../scm/test/test-libgnucash-scm-utilities.scm | 35 ++++
libgnucash/scm/utilities.scm | 17 ++
12 files changed, 385 insertions(+), 61 deletions(-)
create mode 100644 gnucash/report/reports/standard/test/test-portfolios.scm
More information about the gnucash-changes
mailing list