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-12 22:42:22 +08:00
commit 0909321d72
10 changed files with 136 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
README.dependencies
View File

@ -54,17 +54,14 @@ required versions packaged, it was exceedingly painful for end users to
upgrade to the anticipated release, leading to a reputation that gnucash
still has.)
This document serves to keep track of the major distributions, the date of
their major release[s], and the relevant library versions as part of that
release (or an official package-upgrade path)
Libraries/Deps
--------------
required Version
-------- _______
glib2 2.40.0
gtk+3 3.14.0
guile 2.2.0 or 2.0.0
guile 2.2.0 or 2.0.0 Must be built with regex
support enabled
libxml2 2.5.10
gettext 0.19.6
libxslt, including xsltproc

7
gnucash/import-export/qif-imp/assistant-qif-import.c
View File

@ -3877,6 +3877,13 @@ gnc_file_qif_import (void)
{
QIFImportWindow *qif_win;
gint component_id;
SCM has_regex = scm_c_eval_string ("(defined? 'make-regexp)");
if (scm_is_false(has_regex) == 1)
{
gnc_warning_dialog(NULL, _("QIF import requires guile with regex support."));
return;
}
qif_win = g_new0 (QIFImportWindow, 1);

24
gnucash/import-export/qif-imp/qif-parse.scm
View File

@ -26,6 +26,8 @@
(use-modules (gnucash string))
(use-modules (srfi srfi-13))
(define regexp-enabled?
(defined? 'make-regexp))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-split:parse-category
;; this one just gets nastier and nastier.
@ -40,7 +42,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define qif-category-compiled-rexp
(make-regexp "^ *(\\[)?([^]/|]*)(]?)(/?)([^|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$"))
(and regexp-enabled?
(make-regexp "^ *(\\[)?([^]/|]*)(]?)(/?)([^|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$")))
(define (qif-split:parse-category self value)
;; example category regex matches (excluding initial 'L'):
;; field1
@ -267,13 +271,16 @@
;; of possibilities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define qif-date-compiled-rexp
(make-regexp "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+).*$|^ *([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]).*$"))
(and regexp-enabled?
(make-regexp "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+).*$|^ *([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]).*$")))
(define qif-date-mdy-compiled-rexp
(make-regexp "([0-9][0-9])([0-9][0-9])([0-9][0-9][0-9][0-9])"))
(and regexp-enabled?
(make-regexp "([0-9][0-9])([0-9][0-9])([0-9][0-9][0-9][0-9])")))
(define qif-date-ymd-compiled-rexp
(make-regexp "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])"))
(and regexp-enabled?
(make-regexp "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")))
(define (qif-parse:check-date-format date-string possible-formats)
(and (string? date-string)
@ -358,15 +365,18 @@
;; eg 1000.00 or 1,500.00 or 2'000.00
(define decimal-radix-regexp
(make-regexp "^ *[$]?[+-]?[$]?[0-9]+[+-]?$|^ *[$]?[+-]?[$]?[0-9]?[0-9]?[0-9]?([,'][0-9][0-9][0-9])*(\\.[0-9]*)?[+-]? *$|^ *[$]?[+-]?[$]?[0-9]+\\.[0-9]*[+-]? *$"))
(and regexp-enabled?
(make-regexp "^ *[$]?[+-]?[$]?[0-9]+[+-]?$|^ *[$]?[+-]?[$]?[0-9]?[0-9]?[0-9]?([,'][0-9][0-9][0-9])*(\\.[0-9]*)?[+-]? *$|^ *[$]?[+-]?[$]?[0-9]+\\.[0-9]*[+-]? *$")))
;; eg 5.000,00 or 4'500,00
(define comma-radix-regexp
(make-regexp "^ *[$]?[+-]?[$]?[0-9]+[+-]?$|^ *[$]?[+-]?[$]?[0-9]?[0-9]?[0-9]?([\\.'][0-9][0-9][0-9])*(,[0-9]*)?[+-]? *$|^ *[$]?[+-]?[$]?[0-9]+,[0-9]*[+-]? *$"))
(and regexp-enabled?
(make-regexp "^ *[$]?[+-]?[$]?[0-9]+[+-]?$|^ *[$]?[+-]?[$]?[0-9]?[0-9]?[0-9]?([\\.'][0-9][0-9][0-9])*(,[0-9]*)?[+-]? *$|^ *[$]?[+-]?[$]?[0-9]+,[0-9]*[+-]? *$")))
;; eg 456 or 123
(define integer-regexp
(make-regexp "^[$]?[+-]?[$]?[0-9]+[+-]? *$"))
(and regexp-enabled?
(make-regexp "^[$]?[+-]?[$]?[0-9]+[+-]? *$")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:check-number-format

23
gnucash/report/commodity-utilities.scm
View File

@ -20,6 +20,8 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (ice-9 match))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to get splits with interesting data from accounts.
@ -265,19 +267,14 @@
;; if pricelist was empty, #f.
(define (gnc:pricelist-price-find-nearest pricelist date)
(let lp ((pricelist pricelist))
(cond
((null? pricelist) #f)
((null? (cdr pricelist)) (cadr (car pricelist)))
(else
(let ((earlier (car pricelist))
(later (cadr pricelist)))
(cond
((< (car later) date)
(lp (cdr pricelist)))
((< (- date (car earlier)) (- (car later) date))
(cadr earlier))
(else
(cadr later))))))))
(match pricelist
(() #f)
(((date price)) price)
(((date1 price1) (date2 price2) . rest)
(cond
((< date2 date) (lp (cdr pricelist)))
((< (- date date1) (- date2 date)) price1)
(else price2))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to get one price at a given time (i.e. not time-variant).

3
gnucash/report/eguile-html-utilities.scm
View File

@ -85,7 +85,8 @@
;; (thanks to Peter Brett for this regexp and the use of match:prefix)
(define fontre
(make-regexp "([[:space:]]+(bold|semi-bold|book|regular|medium|light))?([[:space:]]+(normal|roman|italic|oblique))?([[:space:]]+(condensed))?[[:space:]]+([[:digit:]]+)" regexp/icase))
(and (defined? 'make-regexp)
(make-regexp "([[:space:]]+(bold|semi-bold|book|regular|medium|light))?([[:space:]]+(normal|roman|italic|oblique))?([[:space:]]+(condensed))?[[:space:]]+([[:digit:]]+)" regexp/icase)))
(define-public (font-name-to-style-info font-name)
;;; Convert a font name as return by a font option to CSS format.

8
gnucash/report/eguile.scm
View File

@ -108,8 +108,8 @@
(#\& . "&amp;"))))
;; regexps used to find start and end of code segments
(define startre (make-regexp "<\\?scm(:d)?[[:space:]]"))
(define endre (make-regexp "(^|[[:space:]])\\?>"))
(define startre (and (defined? 'make-regexp) (make-regexp "<\\?scm(:d)?[[:space:]]")))
(define endre (and (defined? 'make-regexp) (make-regexp "(^|[[:space:]])\\?>")))
;; Guile code to mark starting and stopping text or code modes
(define textstart "(display \"")
@ -170,7 +170,9 @@
(loop inp needle other code? "")))))
(display textstart)
(loop (current-input-port) startre endre #f "")
(if (defined? 'make-regexp)
(loop (current-input-port) startre endre #f "")
(display "eguile requires guile with regex."))
(display stop))
;end of (template->script)

70
gnucash/report/html-style-info.scm
View File

@ -21,6 +21,7 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (ice-9 match))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-markup-style-info> class
@ -68,28 +69,19 @@
(define (gnc:html-markup-style-info-set! style . rest)
(let loop ((arglist rest))
(if (and (list? arglist)
(not (null? arglist))
(not (null? (cdr arglist))))
(let* ((field (car arglist))
(value (cadr arglist)))
(if (eq? field 'attribute)
(if (list? value)
(gnc:html-markup-style-info-set-attribute!
style (car value)
(if (null? (cdr value))
#f
(cadr value))))
(begin
(if (memq field '(font-size font-face font-color))
(gnc:html-markup-style-info-set-closing-font-tag!
style
(not (eq? value #f))))
(let ((modifier
(record-modifier <html-markup-style-info> field)))
(modifier style value))))
(loop (cddr arglist)))))
style)
(match arglist
(('attribute (key . val) . rest)
(gnc:html-markup-style-info-set-attribute!
style key (and (pair? val) (car val)))
(loop rest))
((field value . rest)
(when (memq field '(font-size font-face font-color))
(gnc:html-markup-style-info-set-closing-font-tag! style (and value #t)))
((record-modifier <html-markup-style-info> field) style value)
(loop rest))
(else style))))
(define gnc:html-markup-style-info-tag
(record-accessor <html-markup-style-info> 'tag))
@ -361,32 +353,26 @@
(and (gnc:html-data-style-info? s)
(gnc:html-data-style-info-inheritable? s)))
s #f)))
(define (fetch-worker style antecedents)
(if (null? antecedents)
style
(let ((parent (car antecedents)))
(if (not parent)
(fetch-worker style (cdr antecedents))
(if (gnc:html-style-table-compiled? parent)
(gnc:html-style-info-merge
style
(hash-ref (gnc:html-style-table-inheritable parent) markup))
(fetch-worker
(gnc:html-style-info-merge
style (get-inheritable-style
(gnc:html-style-table-primary parent)))
(cdr antecedents)))))))
(cond
((null? antecedents) style)
((not (car antecedents)) (fetch-worker style (cdr antecedents)))
((gnc:html-style-table-compiled? (car antecedents))
(gnc:html-style-info-merge
style (hash-ref (gnc:html-style-table-inheritable (car antecedents)) markup)))
(else
(fetch-worker
(gnc:html-style-info-merge
style (get-inheritable-style
(gnc:html-style-table-primary (car antecedents))))
(cdr antecedents)))))
(if (and table (gnc:html-style-table-compiled? table))
(hash-ref (gnc:html-style-table-compiled table) markup)
(fetch-worker
(fetch-worker
(and table (hash-ref (gnc:html-style-table-primary table) markup))
antecedents)))
(define (gnc:html-style-table-set! table markup style-info)
(hash-set! (gnc:html-style-table-primary table) markup style-info))

62
gnucash/report/html-table.scm
View File

@ -139,15 +139,16 @@
(define (gnc:html-table-cell-render cell doc)
;; This function renders a html-table-cell to a document tree
;; segment. Note: if the html-table-cell datum is a negative number
;; or gnc:monetary, it fixes the tag eg. "number-cell" becomes
;; "number-cell-red". The number and gnc:monetary renderers do not
;; have an automatic -neg tag modifier. See bug 759005 and 797357.
;; segment. Note: if the first element in a html-table-cell data is
;; a negative number or gnc:monetary, it fixes the tag
;; eg. "number-cell" becomes "number-cell-red". The number and
;; gnc:monetary renderers do not have an automatic -neg tag
;; modifier. See bug 759005 and bug 797357.
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval))))
(cell-tag (gnc:html-table-cell-tag cell))
(cell-data (gnc:html-table-cell-data cell))
(tag (if (and (= 1 (length cell-data))
(tag (if (and (not (null? cell-data))
(not (string=? cell-tag "td"))
(or (and (gnc:gnc-monetary? (car cell-data))
(negative? (gnc:gnc-monetary-amount (car cell-data))))
@ -406,37 +407,26 @@
(gnc:html-table-set-cell-datum! table row col tc)))
(define (gnc:html-table-append-column! table newcol)
;; append the elements of newcol to each of the existing rows,
;; widening to width-to-make if necessary
(define (append-to-element newcol existing-data length-to-append colnum)
(if (= length-to-append 0)
(cons '() newcol)
(let ((result (append-to-element
(cdr newcol) (cdr existing-data) (1- length-to-append)
colnum)))
(cons (cons (list-set-safe! (car existing-data) colnum (car newcol))
(car result))
(cdr result)))))
(let* ((old-data (reverse (gnc:html-table-data table)))
(old-numrows (length old-data))
(old-numcols (apply max (cons 0 (map length old-data))))
(new-numrows (length newcol)))
(if (<= new-numrows old-numrows)
(gnc:html-table-set-data!
table
(reverse (car (append-to-element newcol old-data new-numrows old-numcols))))
(let ((res (append-to-element newcol old-data old-numrows old-numcols)))
;; Invariant maintained - table data in reverse order
(gnc:html-table-set-data! table (reverse (car res)))
(for-each
(lambda (element)
(gnc:html-table-append-row!
table (list-set-safe! '() old-numcols element)))
(cdr res))))))
(define width (apply max (cons 0 (map length (gnc:html-table-data table)))))
(define (add-fn a b) (list-set-safe! b width a))
(let lp ((newcol newcol)
(olddata (reverse (gnc:html-table-data table)))
(res '())
(numrows 0))
(cond
((null? newcol)
(gnc:html-table-set-num-rows-internal! table numrows)
(gnc:html-table-set-data! table res))
((null? olddata)
(lp (cdr newcol)
'()
(cons (add-fn (car newcol) '()) res)
(1+ numrows)))
(else
(lp (cdr newcol)
(cdr olddata)
(cons (add-fn (car newcol) (car olddata)) res)
(1+ numrows))))))
(define (gnc:html-table-render table doc)
(let* ((retval '())

37
gnucash/report/html-text.scm
View File

@ -60,13 +60,9 @@
(record-modifier <html-text> 'style))
(define (gnc:html-text-set-style! text tag . rest)
(let ((newstyle #f))
(if (and (= (length rest) 2)
(procedure? (car rest)))
(set! newstyle
(apply gnc:make-html-data-style-info rest))
(set! newstyle
(apply gnc:make-html-markup-style-info rest)))
(let ((newstyle (if (and (= (length rest) 2) (procedure? (car rest)))
(apply gnc:make-html-data-style-info rest)
(apply gnc:make-html-markup-style-info rest))))
(gnc:html-style-table-set! (gnc:html-text-style text) tag newstyle)))
(define (gnc:html-text-append! text . body)
@ -221,34 +217,21 @@
(gnc:html-style-table-uncompile (gnc:html-text-style p))
retval))
;; XXX It would be better to merge this with the original html-text-render-markup below it,
;; but that would require a fair amount of work to refactor so that it works correctly.
(define (gnc:html-text-render-markup-noclose doc markup attrib end-tag? . entities)
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval)))))
(push (gnc:html-document-markup-start doc markup end-tag? attrib))
(for-each
(for-each
(lambda (elt)
(cond ((procedure? elt)
(push (elt doc)))
(#t
(push (gnc:html-document-render-data doc elt)))))
(cond
((procedure? elt) (push (elt doc)))
(else (push (gnc:html-document-render-data doc elt)))))
entities)
retval))
(define (gnc:html-text-render-markup doc markup attrib end-tag? . entities)
(let* ((retval '())
(let* ((retval (apply gnc:html-text-render-markup-noclose doc markup
attrib end-tag? entities))
(push (lambda (l) (set! retval (cons l retval)))))
(push (gnc:html-document-markup-start doc markup end-tag? attrib))
(for-each
(lambda (elt)
(cond ((procedure? elt)
(push (elt doc)))
(#t
(push (gnc:html-document-render-data doc elt)))))
entities)
(if end-tag?
(push (gnc:html-document-markup-end doc markup)))
(if end-tag? (push (gnc:html-document-markup-end doc markup)))
retval))

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

@ -1936,11 +1936,13 @@ be excluded from periodic reporting.")
(let* ((document (gnc:make-html-document))
(account-matcher (opt-val pagename-filter optname-account-matcher))
(account-matcher-regexp (and (opt-val pagename-filter
optname-account-matcher-regex)
(catch 'regular-expression-syntax
(lambda () (make-regexp account-matcher))
(const 'invalid-regex))))
(account-matcher-regexp
(and (opt-val pagename-filter optname-account-matcher-regex)
(if (defined? 'make-regexp)
(catch 'regular-expression-syntax
(lambda () (make-regexp account-matcher))
(const 'invalid-account-regex))
'no-guile-regex-support)))
(c_account_0 (or custom-source-accounts
(opt-val gnc:pagename-accounts optname-accounts)))
(c_account_1 (filter
@ -1962,9 +1964,11 @@ be excluded from periodic reporting.")
(transaction-matcher (opt-val pagename-filter optname-transaction-matcher))
(transaction-matcher-regexp
(and (opt-val pagename-filter optname-transaction-matcher-regex)
(catch 'regular-expression-syntax
(lambda () (make-regexp transaction-matcher))
(const 'invalid-regex))))
(if (defined? 'make-regexp)
(catch 'regular-expression-syntax
(lambda () (make-regexp transaction-matcher))
(const 'invalid-transaction-regex))
'no-guile-regex-support)))
(reconcile-status-filter
(keylist-get-info reconcile-status-list
(opt-val pagename-filter optname-reconcile-status)
@ -2042,14 +2046,26 @@ be excluded from periodic reporting.")
(cond
((or (null? c_account_1)
(eq? account-matcher-regexp 'invalid-regex)
(eq? transaction-matcher-regexp 'invalid-regex))
(symbol? account-matcher-regexp)
(symbol? transaction-matcher-regexp))
;; error condition: no accounts specified or obtained after filtering
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj)))
(cond
((null? c_account_1)
(gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))
((symbol? account-matcher-regexp)
(gnc:html-make-generic-warning
report-title (gnc:report-id report-obj)
(string-append (_ "Error") " " (symbol->string account-matcher-regexp))
""))
((symbol? transaction-matcher-regexp)
(gnc:html-make-generic-warning
report-title (gnc:report-id report-obj)
(string-append (_ "Error") " " (symbol->string transaction-matcher-regexp))
""))))
;; if an empty-report-message is passed by a derived report to
;; the renderer, display it here.