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:
Christopher Lam 2019-10-31 23:30:13 +08:00
commit f89691f73c
16 changed files with 484 additions and 1035 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

File diff suppressed because it is too large Load Diff

7
gnucash/gnome-utils/gnc-tree-model-account.h
View File

@ -1,6 +1,6 @@
/*
* gnc-tree-model-account.h -- GtkTreeModel implementation to
* display accounts in a GtkTreeView.
* display accounts in a GtkTreeView.
*
* Copyright (C) 2003 Jan Arne Petersen <jpetersen@uni-bonn.de>
* Copyright (C) 2003 David Hampton <hampton@employees.org>
@ -122,6 +122,11 @@ typedef struct
*/
GType gnc_tree_model_account_get_type (void);
/** Clear the tree model account cached values.
*
* @param model A pointer to the account tree model.
*/
void gnc_tree_model_account_clear_cache (GncTreeModelAccount *model);
/** @name Account Tree Model Constructors
@{ */

11
gnucash/gnome-utils/gnc-tree-view-account.c
View File

@ -1076,6 +1076,17 @@ gnc_tree_view_account_count_children (GncTreeViewAccount *view,
return num_children;
}
void
gnc_tree_view_account_clear_model_cache (GncTreeViewAccount *view)
{
GtkTreeModel *model, *f_model, *s_model;
s_model = gtk_tree_view_get_model (GTK_TREE_VIEW(view));
f_model = gtk_tree_model_sort_get_model (GTK_TREE_MODEL_SORT(s_model));
model = gtk_tree_model_filter_get_model (GTK_TREE_MODEL_FILTER(f_model));
gnc_tree_model_account_clear_cache (GNC_TREE_MODEL_ACCOUNT(model));
}
/************************************************************/
/* Account Tree View Filter Functions */

7
gnucash/gnome-utils/gnc-tree-view-account.h
View File

@ -346,6 +346,13 @@ void gnc_tree_view_account_refilter (GncTreeViewAccount *view);
gint gnc_tree_view_account_count_children (GncTreeViewAccount *view,
Account *account);
/** This function clears the tree model account cache so the values will
* be updated/refreshed.
*
* @param view A pointer to an account tree view.
*
*/
void gnc_tree_view_account_clear_model_cache (GncTreeViewAccount *view);
/** This function returns the account associated with the specified

2
gnucash/gnome/dialog-price-edit-db.c
View File

@ -205,6 +205,7 @@ gnc_prices_dialog_remove_clicked (GtkWidget *widget, gpointer data)
g_list_foreach(price_list, (GFunc)remove_helper, pdb_dialog->price_db);
}
g_list_free(price_list);
gnc_gui_refresh_all ();
LEAVE(" ");
}
@ -504,6 +505,7 @@ gnc_prices_dialog_remove_old_clicked (GtkWidget *widget, gpointer data)
}
g_list_free (comm_list);
}
gnc_gui_refresh_all ();
gtk_widget_destroy (pdb_dialog->remove_dialog);
LEAVE(" ");
}

4
gnucash/gnome/gnc-plugin-page-account-tree.c
View File

@ -602,6 +602,8 @@ gnc_plugin_page_account_refresh_cb (GHashTable *changes, gpointer user_data)
return;
priv = GNC_PLUGIN_PAGE_ACCOUNT_TREE_GET_PRIVATE(page);
gnc_tree_view_account_clear_model_cache (GNC_TREE_VIEW_ACCOUNT(priv->tree_view));
gtk_widget_queue_draw(priv->widget);
}
@ -1671,6 +1673,8 @@ gnc_plugin_page_account_tree_cmd_refresh (GtkAction *action,
g_return_if_fail(GNC_IS_PLUGIN_PAGE_ACCOUNT_TREE(page));
priv = GNC_PLUGIN_PAGE_ACCOUNT_TREE_GET_PRIVATE(page);
gnc_tree_view_account_clear_model_cache (GNC_TREE_VIEW_ACCOUNT(priv->tree_view));
gtk_widget_queue_draw (priv->widget);
}

27
gnucash/report/html-style-sheet.scm
View File

@ -21,6 +21,7 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (ice-9 match))
(use-modules (gnucash gettext))
(define *gnc:_style-sheet-templates_* (make-hash-table 23))
@ -67,23 +68,15 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:define-html-style-sheet . args)
(let ((ss
((record-constructor <html-style-sheet-template>) #f #f #f #f)))
(let loop ((left args))
(if (and (list? left)
(not (null? left))
(not (null? (cdr left))))
(let* ((field (car left))
(value (cadr left))
(mod (record-modifier <html-style-sheet-template> field)))
(mod ss value)
(loop (cddr left)))))
;; store the style sheet template
(hash-set! *gnc:_style-sheet-templates_*
(gnc:html-style-sheet-template-name ss)
ss)))
(let loop ((args args)
(ss ((record-constructor <html-style-sheet-template>) #f #f #f #f)))
(match args
((field value . rest)
((record-modifier <html-style-sheet-template> field) ss value)
(loop rest ss))
(else ;; store the style sheet template
(hash-set! *gnc:_style-sheet-templates_*
(gnc:html-style-sheet-template-name ss) ss)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-style-sheet> methods

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

@ -959,15 +959,8 @@
(format #f "[~a]"
(gnc:monetary->string mon)))
(define (owner->str owner)
(define owner-alist
(list (cons GNC-OWNER-NONE "None")
(cons GNC-OWNER-UNDEFINED "Undefined")
(cons GNC-OWNER-JOB "Job")
(cons GNC-OWNER-CUSTOMER "Cust")
(cons GNC-OWNER-VENDOR "Vend")
(cons GNC-OWNER-EMPLOYEE "Emp")))
(format #f "[~a:~a]"
(or (assv-ref owner-alist (gncOwnerGetType owner)) "Owner")
(gncOwnerGetTypeString owner)
(gncOwnerGetName owner)))
(define (invoice->str inv)
(format #f "~a<Post:~a,Owner:~a,Notes:~a,Total:~a>"
@ -978,6 +971,13 @@
(monetary->string (gnc:make-gnc-monetary
(gncInvoiceGetCurrency inv)
(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)))
(gnc-lot-get-title lot)
(gnc-lot-get-notes lot)
(gnc-lot-get-balance lot)
(gnc-lot-count-splits lot)))
(define (try proc)
;; Try proc with d as a parameter, catching exceptions to return
;; #f to the (or) evaluator below.
@ -1008,6 +1008,7 @@
(try gnc-budget-get-name)
(try owner->str)
(try invoice->str)
(try lot->str)
(object->string d)))
(define (pair->num pair)

24
gnucash/report/reports/aging.scm
View File

@ -29,6 +29,9 @@
(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(eval-when (compile load eval expand)
(load-extension "libgncmod-gnome-utils" "scm_init_sw_gnome_utils_module"))
(use-modules (sw_gnome_utils))
(gnc:module-load "gnucash/report" 0)
@ -211,15 +214,18 @@
(if (not (gnc-commodity-equiv
this-currency
(company-get-currency company-info)))
(let ((error-str
(string-append "IGNORING TRANSACTION!\n" "Invoice Owner: " (gncOwnerGetName owner)
"\nTransaction GUID:" (gncTransGetGuid transaction)
"\nTransaction Currency" (gnc-commodity-get-mnemonic this-currency)
"\nClient Currency" (gnc-ommodity-get-mnemonic(company-get-currency company-info)))))
(gnc-error-dialog '() error-str)
(gnc:error error-str)
(cons #f (format
(_ "Transactions relating to '~a' contain \
(let ((error-str
(string-append "IGNORING TRANSACTION!\n" "Invoice Owner: " (gnc:strify owner)
"\nTransaction:" (gnc:strify transaction)
"\nSplits are:\n"
(string-join
(map gnc:strify (xaccTransGetSplitList transaction))
"\n")
"\nTransaction Currency:" (gnc:strify this-currency)
"\nClient Currency:" (gnc:strify (company-get-currency company-info)))))
(gnc-error-dialog '() error-str)
(gnc:error error-str)
(cons #f (format #f (_ "Transactions relating to '~a' contain \
more than one currency. This report is not designed to cope with this possibility.") (gncOwnerGetName owner))))
(begin
(gnc:debug "it's an old company")

6
gnucash/report/stylesheets/CMakeLists.txt
View File

@ -1,9 +1,7 @@
set(stylesheets_SCHEME
plain.scm
fancy.scm
footer.scm
easy.scm
head-or-tail.scm
)
@ -25,8 +23,8 @@ gnc_add_scheme_targets(scm-report-stylesheets-1
)
# Module interfaces deprecated in 4.x, will be removed for 5.x
gnc_add_scheme_deprecated_module ("gnucash report stylesheet-easy" "gnucash report stylesheets easy" "scm-report-stylesheets-1" "")
gnc_add_scheme_deprecated_module ("gnucash report stylesheet-fancy" "gnucash report stylesheets fancy" "scm-report-stylesheets-1" "")
gnc_add_scheme_deprecated_module ("gnucash report stylesheet-easy" "gnucash report stylesheets footer" "scm-report-stylesheets-1" "")
gnc_add_scheme_deprecated_module ("gnucash report stylesheet-fancy" "gnucash report stylesheets footer" "scm-report-stylesheets-1" "")
gnc_add_scheme_deprecated_module ("gnucash report stylesheet-footer" "gnucash report stylesheets footer" "scm-report-stylesheets-1" "")
gnc_add_scheme_deprecated_module ("gnucash report stylesheet-head-or-tail" "gnucash report stylesheets head-or-tail" "scm-report-stylesheets-1" "")
gnc_add_scheme_deprecated_module ("gnucash report stylesheet-plain" "gnucash report stylesheets plain" "scm-report-stylesheets-1" "")

394
gnucash/report/stylesheets/easy.scm
View File

@ -1,394 +0,0 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stylesheet-easy.scm: stylesheet with nicer formatting for
;; printing and easier configurability
;;
;; Copyright 2004 James Strandboge <jstrand1@rochester.rr.com>
;;
;; 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@gnu.org
;;
;; Based on work from:
;; stylesheet-header.scm
;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report stylesheets easy))
(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(gnc:module-load "gnucash/html" 0)
(gnc:module-load "gnucash/report" 0)
(define (easy-options)
(let* ((options (gnc:new-options))
(opt-register
(lambda (opt)
(gnc:register-option options opt))))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Preparer") "a"
(N_ "Name of person preparing the report.")
""))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for.")
""))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Show preparer info") "c"
(N_ "Name of organization or company.")
#f))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Enable Links") "d"
(N_ "Enable hyperlinks in reports.")
#t))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Background Tile") "a" (N_ "Background tile for reports.")
""))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Heading Banner") "b" (N_ "Banner for top of report.")
""))
(opt-register
(gnc:make-multichoice-option
(N_ "Images")
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left
(list (vector 'left
(N_ "Left")
(N_ "Align the banner to the left."))
(vector 'center
(N_ "Center")
(N_ "Align the banner in the center."))
(vector 'right
(N_ "Right")
(N_ "Align the banner to the right."))
)))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Logo") "d" (N_ "Company logo image.")
""))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Link Color") "c" (N_ "Link text color.")
(list #xb2 #x22 #x22 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Table Cell Color") "c" (N_ "Default background for table cells.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Alternate Table Cell Color") "d"
(N_ "Default alternate background for table cells.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Subheading/Subtotal Cell Color") "e"
(N_ "Default color for subtotal rows.")
(list #xee #xe8 #xaa #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Sub-subheading/total Cell Color") "f"
(N_ "Color for subsubtotals.")
(list #xfa #xfa #xd2 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Grand Total Cell Color") "g"
(N_ "Color for grand totals.")
(list #xff #xff #x00 #xff)
255 #f))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell spacing") "a" (N_ "Space between table cells.")
1 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.")
1 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.")
1 0 20 0 1))
(register-font-options options)
options))
(define (easy-renderer options doc)
(let* ((ssdoc (gnc:make-html-document))
(opt-val
(lambda (section name)
(gnc:option-value
(gnc:lookup-option options section name))))
(color-val
(lambda (section name)
(gnc:color-option->html
(gnc:lookup-option options section name))))
(preparer (opt-val "General" "Preparer"))
(prepared-for (opt-val "General" "Prepared for"))
(show-preparer? (opt-val "General" "Show preparer info"))
(links? (opt-val "General" "Enable Links"))
(bgcolor (color-val "Colors" "Background Color"))
(textcolor (color-val "Colors" "Text Color"))
(linkcolor (color-val "Colors" "Link Color"))
(normal-row-color (color-val "Colors" "Table Cell Color"))
(alternate-row-color (color-val "Colors" "Alternate Table Cell Color"))
(primary-subheading-color
(color-val "Colors" "Subheading/Subtotal Cell Color"))
(secondary-subheading-color
(color-val "Colors" "Sub-subheading/total Cell Color"))
(grand-total-color (color-val "Colors" "Grand Total Cell Color"))
(bgpixmap (opt-val "Images" "Background Tile"))
(headpixmap (opt-val "Images" "Heading Banner"))
(logopixmap (opt-val "Images" "Logo"))
(align (gnc:value->string (opt-val "Images" "Heading Alignment")))
(spacing (opt-val "Tables" "Table cell spacing"))
(padding (opt-val "Tables" "Table cell padding"))
(border (opt-val "Tables" "Table border width"))
(headcolumn 0))
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor)
'attribute (list "link" linkcolor))
;;;;
;;;;
;;;;
(gnc:html-document-set-style!
ssdoc "column-heading-left"
'tag "th"
'attribute (list "class" "column-heading-left"))
(gnc:html-document-set-style!
ssdoc "column-heading-center"
'tag "th"
'attribute (list "class" "column-heading-center"))
(gnc:html-document-set-style!
ssdoc "column-heading-right"
'tag "th"
'attribute (list "class" "column-heading-right"))
(gnc:html-document-set-style!
ssdoc "date-cell"
'tag "td"
'attribute (list "class" "date-cell"))
(gnc:html-document-set-style!
ssdoc "anchor-cell"
'tag "td"
'attribute (list "class" "anchor-cell"))
(gnc:html-document-set-style!
ssdoc "number-cell"
'tag "td"
'attribute (list "class" "number-cell"))
(gnc:html-document-set-style!
ssdoc "number-cell-neg"
'tag "td"
'attribute (list "class" "number-cell neg"))
(gnc:html-document-set-style!
ssdoc "number-header"
'tag "th"
'attribute (list "class" "number-header"))
(gnc:html-document-set-style!
ssdoc "text-cell"
'tag "td"
'attribute (list "class" "text-cell"))
(gnc:html-document-set-style!
ssdoc "total-number-cell"
'tag '("td")
'attribute (list "class" "total-number-cell"))
(gnc:html-document-set-style!
ssdoc "total-number-cell-neg"
'tag '("td")
'attribute (list "class" "total-number-cell neg"))
(gnc:html-document-set-style!
ssdoc "total-label-cell"
'tag '("td")
'attribute (list "class" "total-label-cell"))
(gnc:html-document-set-style!
ssdoc "centered-label-cell"
'tag '("td")
'attribute (list "class" "centered-label-cell"))
(if (and bgpixmap
(not (string=? bgpixmap "")))
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap))))
(gnc:html-document-set-style!
ssdoc "table"
'attribute (list "border" border)
'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding))
(gnc:html-document-set-style!
ssdoc "normal-row"
'attribute (list "bgcolor" normal-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color)
'tag "tr")
;; don't surround marked-up links with <a> </a>
(if (not links?)
(gnc:html-document-set-style!
ssdoc "a" 'tag ""))
(add-css-information-to-doc options ssdoc doc)
(let ((t (gnc:make-html-table)))
;; we don't want a bevel for this table, but we don't want
;; that to propagate
(gnc:html-table-set-style!
t "table"
'attribute (list "border" 0)
'attribute (list "style" "margin-left:auto; margin-right:auto")
'inheritable? #f)
;; set the header column to be the 2nd when we have a logo
;; do this so that when logo is not present, the document
;; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1))
(let* ((headline (or (gnc:html-document-headline doc)
(gnc:html-document-title doc))))
(gnc:html-table-set-cell!
t 1 headcolumn
(if show-preparer?
;; title plus preparer info
(gnc:make-html-text
(gnc:html-markup-h3 headline)
(gnc:html-markup-br)
(_ "Prepared by: ")
(gnc:html-markup-b preparer)
(gnc:html-markup-br)
(_ "Prepared for: ")
(gnc:html-markup-b prepared-for)
(gnc:html-markup-br)
(_ "Date: ")
(qof-print-date
(current-time)))
;; title only
(gnc:make-html-text
(gnc:html-markup-h3 headline))))
)
;; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0))
(gnc:html-table-set-cell!
t 0 0
(gnc:make-html-text
(gnc:html-markup-img (make-file-url logopixmap)))))
(if (and headpixmap (> (string-length headpixmap) 0))
(let* ((div (gnc:html-markup-img (make-file-url headpixmap)))
(cell (gnc:make-html-table-cell (gnc:make-html-text div))))
(gnc:html-table-cell-set-style! cell "td" 'attribute `("align" ,align))
(gnc:html-table-set-cell! t 0 headcolumn cell))
(gnc:html-table-set-cell! t 0 headcolumn (gnc:make-html-text " ")))
(apply
gnc:html-table-set-cell!
t 2 headcolumn
(gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t))
ssdoc))
(gnc:define-html-style-sheet
'version 1
'name (N_ "Easy")
'renderer easy-renderer
'options-generator easy-options)
(gnc:make-html-style-sheet "Easy" (N_ "Easy"))

388
gnucash/report/stylesheets/fancy.scm
View File

@ -1,388 +0,0 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stylesheet-header.scm : stylesheet with nicer layout
;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
;;
;; 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@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report stylesheets fancy))
(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(gnc:module-load "gnucash/html" 0)
(gnc:module-load "gnucash/report" 0)
(define (fancy-options)
(let* ((options (gnc:new-options))
(opt-register
(lambda (opt)
(gnc:register-option options opt))))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Preparer") "a"
(N_ "Name of person preparing the report.")
""))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for.")
""))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Show preparer info") "c"
(N_ "Name of organization or company.")
#f))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Enable Links") "d"
(N_ "Enable hyperlinks in reports.")
#t))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Background Tile") "a" (N_ "Background tile for reports.")
""))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Heading Banner") "b" (N_ "Banner for top of report.")
""))
(opt-register
(gnc:make-multichoice-option
(N_ "Images")
(N_ "Heading Alignment") "c" (N_ "Banner for top of report.")
'left
(list (vector 'left
(N_ "Left")
(N_ "Align the banner to the left."))
(vector 'center
(N_ "Center")
(N_ "Align the banner in the center."))
(vector 'right
(N_ "Right")
(N_ "Align the banner to the right."))
)))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
(N_ "Logo") "d" (N_ "Company logo image.")
""))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Link Color") "c" (N_ "Link text color.")
(list #xb2 #x22 #x22 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Table Cell Color") "c" (N_ "Default background for table cells.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Alternate Table Cell Color") "d"
(N_ "Default alternate background for table cells.")
(list #xff #xff #xff #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Subheading/Subtotal Cell Color") "e"
(N_ "Default color for subtotal rows.")
(list #xee #xe8 #xaa #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Sub-subheading/total Cell Color") "f"
(N_ "Color for subsubtotals.")
(list #xfa #xfa #xd2 #xff)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Grand Total Cell Color") "g"
(N_ "Color for grand totals.")
(list #xff #xff #x00 #xff)
255 #f))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell spacing") "a" (N_ "Space between table cells.")
1 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell padding") "b" (N_ "Space between table cell edge and content.")
1 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table border width") "c" (N_ "Bevel depth on tables.")
1 0 20 0 1))
(register-font-options options)
options))
(define (fancy-renderer options doc)
(let* ((ssdoc (gnc:make-html-document))
(opt-val
(lambda (section name)
(gnc:option-value
(gnc:lookup-option options section name))))
(color-val
(lambda (section name)
(gnc:color-option->html
(gnc:lookup-option options section name))))
(preparer (opt-val "General" "Preparer"))
(prepared-for (opt-val "General" "Prepared for"))
(show-preparer? (opt-val "General" "Show preparer info"))
(links? (opt-val "General" "Enable Links"))
(bgcolor (color-val "Colors" "Background Color"))
(textcolor (color-val "Colors" "Text Color"))
(linkcolor (color-val "Colors" "Link Color"))
(normal-row-color (color-val "Colors" "Table Cell Color"))
(alternate-row-color (color-val "Colors" "Alternate Table Cell Color"))
(primary-subheading-color
(color-val "Colors" "Subheading/Subtotal Cell Color"))
(secondary-subheading-color
(color-val "Colors" "Sub-subheading/total Cell Color"))
(grand-total-color (color-val "Colors" "Grand Total Cell Color"))
(bgpixmap (opt-val "Images" "Background Tile"))
(headpixmap (opt-val "Images" "Heading Banner"))
(logopixmap (opt-val "Images" "Logo"))
(align (gnc:value->string (opt-val "Images" "Heading Alignment")))
(spacing (opt-val "Tables" "Table cell spacing"))
(padding (opt-val "Tables" "Table cell padding"))
(border (opt-val "Tables" "Table border width"))
(headcolumn 0))
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor)
'attribute (list "link" linkcolor))
;;;;
;;;;
;;;;
(gnc:html-document-set-style!
ssdoc "column-heading-left"
'tag "th"
'attribute (list "class" "column-heading-left"))
(gnc:html-document-set-style!
ssdoc "column-heading-center"
'tag "th"
'attribute (list "class" "column-heading-center"))
(gnc:html-document-set-style!
ssdoc "column-heading-right"
'tag "th"
'attribute (list "class" "column-heading-right"))
(gnc:html-document-set-style!
ssdoc "date-cell"
'tag "td"
'attribute (list "class" "date-cell"))
(gnc:html-document-set-style!
ssdoc "anchor-cell"
'tag "td"
'attribute (list "class" "anchor-cell"))
(gnc:html-document-set-style!
ssdoc "number-cell"
'tag "td"
'attribute (list "class" "number-cell"))
(gnc:html-document-set-style!
ssdoc "number-cell-neg"
'tag "td"
'attribute (list "class" "number-cell neg"))
(gnc:html-document-set-style!
ssdoc "number-header"
'tag "th"
'attribute (list "class" "number-header"))
(gnc:html-document-set-style!
ssdoc "text-cell"
'tag "td"
'attribute (list "class" "text-cell"))
(gnc:html-document-set-style!
ssdoc "total-number-cell"
'tag '("td")
'attribute (list "class" "total-number-cell"))
(gnc:html-document-set-style!
ssdoc "total-number-cell-neg"
'tag '("td")
'attribute (list "class" "total-number-cell neg"))
(gnc:html-document-set-style!
ssdoc "total-label-cell"
'tag '("td")
'attribute (list "class" "total-label-cell"))
(gnc:html-document-set-style!
ssdoc "centered-label-cell"
'tag '("td")
'attribute (list "class" "centered-label-cell"))
(if (and bgpixmap
(not (string=? bgpixmap "")))
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "background" (make-file-url bgpixmap))))
(gnc:html-document-set-style!
ssdoc "table"
'attribute (list "border" border)
'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding))
(gnc:html-document-set-style!
ssdoc "normal-row"
'attribute (list "bgcolor" normal-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color)
'tag "tr")
;; don't surround marked-up links with <a> </a>
(if (not links?)
(gnc:html-document-set-style!
ssdoc "a" 'tag ""))
(add-css-information-to-doc options ssdoc doc)
(let ((t (gnc:make-html-table)))
;; we don't want a bevel for this table, but we don't want
;; that to propagate
(gnc:html-table-set-style!
t "table"
'attribute (list "border" 0)
'attribute (list "style" "margin-left:auto; margin-right:auto")
'inheritable? #f)
;; set the header column to be the 2nd when we have a logo
;; do this so that when logo is not present, the document
;; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1))
(let* ((headline (or (gnc:html-document-headline doc)
(gnc:html-document-title doc))))
(gnc:html-table-set-cell!
t 1 headcolumn
(if show-preparer?
;; title plus preparer info
(gnc:make-html-text
(gnc:html-markup-h3 headline)
(gnc:html-markup-br)
(_ "Prepared by: ")
(gnc:html-markup-b preparer)
(gnc:html-markup-br)
(_ "Prepared for: ")
(gnc:html-markup-b prepared-for)
(gnc:html-markup-br)
(_ "Date: ")
(qof-print-date
(current-time)))
;; title only
(gnc:make-html-text
(gnc:html-markup-h3 headline))))
)
;; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0))
(gnc:html-table-set-cell!
t 0 0
(gnc:make-html-text
(gnc:html-markup-img (make-file-url logopixmap)))))
(if (and headpixmap (> (string-length headpixmap) 0))
(let* ((div (gnc:html-markup-img (make-file-url headpixmap)))
(cell (gnc:make-html-table-cell (gnc:make-html-text div))))
(gnc:html-table-cell-set-style! cell "td" 'attribute `("align" ,align))
(gnc:html-table-set-cell! t 0 headcolumn cell))
(gnc:html-table-set-cell! t 0 headcolumn (gnc:make-html-text " ")))
(apply
gnc:html-table-set-cell!
t 2 headcolumn
(gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t))
ssdoc))
(gnc:define-html-style-sheet
'version 1.01
'name (N_ "Fancy")
'renderer fancy-renderer
'options-generator fancy-options)
(gnc:make-html-style-sheet "Fancy" (N_ "Technicolor"))

64
gnucash/report/stylesheets/footer.scm
View File

@ -27,6 +27,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;; Merged with easy/fancy/footer stylesheets
;; by Christopher Lam in 2019
;; Modified by Graham Billiau to include a text footer
;; with small adjustments by Frank H. Ellenberger 2010
;
@ -41,36 +43,40 @@
(gnc:module-load "gnucash/html" 0)
(gnc:module-load "gnucash/report" 0)
(define (footer-options)
(define (easy-fancy-footer-options)
(let* ((options (gnc:new-options))
(opt-register
(lambda (opt)
(gnc:register-option options opt))))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Preparer") "a"
(N_ "Name of person preparing the report.")
""))
(opt-register
(gnc:make-string-option
(N_ "General")
(N_ "Prepared for") "b"
(N_ "Name of organization or company prepared for.")
""))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Show preparer info") "c"
(N_ "Name of organization or company.")
#f))
(opt-register
(gnc:make-simple-boolean-option
(N_ "General")
(N_ "Enable Links") "d"
(N_ "Enable hyperlinks in reports.")
#t))
;; FIXME: put this in a more sensible tab like Text or Header/Footer
(opt-register
(gnc:make-text-option
(N_ "General")
@ -83,12 +89,14 @@
(N_ "Images")
(N_ "Background Tile") "a" (N_ "Background tile for reports.")
""))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
;;; Translators: Banner is an image like Logo.
(N_ "Heading Banner") "b" (N_ "Banner for top of report.")
""))
(opt-register
(gnc:make-multichoice-option
(N_ "Images")
@ -102,8 +110,8 @@
(N_ "Align the banner in the center."))
(vector 'right
(N_ "Right")
(N_ "Align the banner to the right."))
)))
(N_ "Align the banner to the right.")))))
(opt-register
(gnc:make-pixmap-option
(N_ "Images")
@ -191,7 +199,7 @@
options))
(define (footer-renderer options doc)
(define (easy-fancy-footer-renderer options doc)
(let* ((ssdoc (gnc:make-html-document))
(opt-val
(lambda (section name)
@ -222,8 +230,7 @@
(align (gnc:value->string (opt-val "Images" "Heading Alignment")))
(spacing (opt-val "Tables" "Table cell spacing"))
(padding (opt-val "Tables" "Table cell padding"))
(border (opt-val "Tables" "Table border width"))
(headcolumn 0))
(border (opt-val "Tables" "Table border width")))
(gnc:html-document-set-style!
ssdoc "body"
@ -314,18 +321,22 @@
ssdoc "normal-row"
'attribute (list "bgcolor" normal-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color)
@ -338,7 +349,13 @@
(add-css-information-to-doc options ssdoc doc)
(let ((t (gnc:make-html-table)))
(let ((t (gnc:make-html-table))
;; set the header column to be the 2nd when we have a logo
;; do this so that when logo is not present, the document is
;; perfectly centered
(headcolumn (if (and logopixmap (> (string-length logopixmap) 0))
1 0)))
;; we don't want a bevel for this table, but we don't want
;; that to propagate
(gnc:html-table-set-style!
@ -347,12 +364,6 @@
'attribute (list "style" "margin-left:auto; margin-right:auto")
'inheritable? #f)
;; set the header column to be the 2nd when we have a logo
;; do this so that when logo is not present, the document
;; is perfectly centered
(if (and logopixmap (> (string-length logopixmap) 0))
(set! headcolumn 1))
(let* ((headline (or (gnc:html-document-headline doc)
(gnc:html-document-title doc))))
@ -375,8 +386,7 @@
;; title only
(gnc:make-html-text
(gnc:html-markup-h3 headline))))
)
(gnc:html-markup-h3 headline)))))
;; only setup an image if we specified one
(if (and logopixmap (> (string-length logopixmap) 0))
@ -396,9 +406,9 @@
gnc:html-table-set-cell!
t 2 headcolumn
(gnc:html-document-objects doc))
(gnc:html-document-add-object! ssdoc t)
;; I think this is the correct place to put the footer
(gnc:html-table-set-cell!
t 3 headcolumn
(gnc:make-html-text footer-text)))
@ -406,8 +416,22 @@
(gnc:define-html-style-sheet
'version 1
'name (N_ "Footer")
'renderer footer-renderer
'options-generator footer-options)
'name (N_ "Easy")
'renderer easy-fancy-footer-renderer
'options-generator easy-fancy-footer-options)
(gnc:define-html-style-sheet
'version 1.01
'name (N_ "Fancy")
'renderer easy-fancy-footer-renderer
'options-generator easy-fancy-footer-options)
(gnc:define-html-style-sheet
'version 1
'name (N_ "Footer")
'renderer easy-fancy-footer-renderer
'options-generator easy-fancy-footer-options)
(gnc:make-html-style-sheet "Easy" (N_ "Easy"))
(gnc:make-html-style-sheet "Fancy" (N_ "Technicolor"))
(gnc:make-html-style-sheet "Footer" (N_ "Footer"))

23
libgnucash/engine/gncOwner.c
View File

@ -204,6 +204,29 @@ GncOwnerType gncOwnerGetType (const GncOwner *owner)
return owner->type;
}
const char * gncOwnerGetTypeString (const GncOwner *owner)
{
GncOwnerType type = gncOwnerGetType(owner);
switch (type)
{
case GNC_OWNER_NONE:
return "None";
case GNC_OWNER_UNDEFINED:
return "Undefined";
case GNC_OWNER_CUSTOMER:
return "Customer";
case GNC_OWNER_JOB:
return "Job";
case GNC_OWNER_VENDOR:
return "Vendor";
case GNC_OWNER_EMPLOYEE:
return "Employee";
default:
PWARN ("Unknown owner type");
return NULL;
}
}
QofIdTypeConst
qofOwnerGetType(const GncOwner *owner)
{

2
libgnucash/engine/gncOwner.h
View File

@ -65,6 +65,8 @@ to QOF as they can be used by objects like GncInvoice.
*/
/** return the type for the collection. */
QofIdTypeConst qofOwnerGetType(const GncOwner *owner);
/** return the type for the owner as an untranslated string. */
const char * gncOwnerGetTypeString (const GncOwner *owner);
/** return the owner itself as an entity. */
QofInstance* qofOwnerGetOwner (const GncOwner *owner);
/** set the owner from the entity. */

2
po/POTFILES.in
View File

@ -495,8 +495,6 @@ gnucash/report/reports/support/receipt.eguile.scm
gnucash/report/reports/support/taxinvoice.eguile.scm
gnucash/report/report.scm
gnucash/report/report-utilities.scm
gnucash/report/stylesheets/easy.scm
gnucash/report/stylesheets/fancy.scm
gnucash/report/stylesheets/footer.scm
gnucash/report/stylesheets/head-or-tail.scm
gnucash/report/stylesheets/plain.scm