From cd2a20832e9486f0566326ecab35795434952a30 Mon Sep 17 00:00:00 2001 From: Geert Janssens Date: Wed, 9 Oct 2019 12:49:26 +0200 Subject: [PATCH 01/10] Add a note in the documentation we require guile with regex support enabled. This is a minor nudge to accomodate Bug 412151 - Not handling exception when guile is compiled w/o regexp support In addition remove the paragraph suggesting we keep track of distributions in the README. We don't. --- README.dependencies | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/README.dependencies b/README.dependencies index 929aff1410..778c123873 100644 --- a/README.dependencies +++ b/README.dependencies @@ -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 Can use older if you pass -DALLOW_OLD_GETTEXT to cmake; From fc3a740c84f2e3433dacd4c96ec390f720f27f61 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 10 Oct 2019 20:17:11 +0800 Subject: [PATCH 02/10] [commodity-utilities] compact gnc:pricelist-price-find-nearest using (ice-9 match) --- .../report-system/commodity-utilities.scm | 23 ++++++++----------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm index 989c2d6a5d..c6e1f29bb0 100644 --- a/gnucash/report/report-system/commodity-utilities.scm +++ b/gnucash/report/report-system/commodity-utilities.scm @@ -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. @@ -297,19 +299,14 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.") ;; 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). From cbd864918325ae35653c6a78736c8dc557f2a004 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 10 Oct 2019 20:30:51 +0800 Subject: [PATCH 03/10] [html-table] dedupe & compact html-table column prepend/append * dedupe gnc:html-table-append-column! and gnc:html-table-prepend-column! * create internal fn to drive modifiers --- gnucash/report/report-system/html-table.scm | 95 ++++++--------------- 1 file changed, 26 insertions(+), 69 deletions(-) diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm index 755fa01516..e1f9187bbb 100644 --- a/gnucash/report/report-system/html-table.scm +++ b/gnucash/report/report-system/html-table.scm @@ -406,77 +406,34 @@ (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))))) + (table-column-driver table newcol (lambda (a b) (list-set-safe! b width a)))) (define (gnc:html-table-prepend-column! table newcol) - ;; returns a pair, the car of which is the prepending of newcol - ;; and existing-data, and the cdr is the remaining elements of newcol - (define (prepend-to-element newcol existing-data length-to-append) - (if (= length-to-append 0) - (cons '() newcol) - (let* - ((current-new (car newcol)) - (current-existing (car existing-data)) - (rest-new (cdr newcol)) - (rest-existing (cdr existing-data)) - (rest-result (prepend-to-element rest-new rest-existing - (- length-to-append 1)))) - (cons - (cons (cons current-new current-existing) (car rest-result)) - (cdr rest-result))))) - (issue-deprecation-warning "gnc:html-table-prepend-column! is unused.") - (let* ((existing-data (reverse (gnc:html-table-data table))) - (existing-length (length existing-data)) - (newcol-length (length newcol))) - (if (<= newcol-length existing-length) - (gnc:html-table-set-data! - table - (reverse (car (prepend-to-element - newcol - existing-data - newcol-length)))) - (let* ((temp-result (prepend-to-element - newcol - existing-data - existing-length)) - (joined-table-data (car temp-result)) - (remaining-elements (cdr temp-result))) - ;; Invariant maintained - table data in reverse order - (gnc:html-table-set-data! table (reverse joined-table-data)) - (for-each - (lambda (element) - (gnc:html-table-append-row! table (list element))) - remaining-elements) - #f)))) + (table-column-driver table newcol cons)) + +;; this is a helper function for gnc:html-table-append-column! and +;; gnc:html-table-prepend-column! use only +(define (table-column-driver table newcol add-fn) + (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 '()) From 39a7584e79ecec590ca30ad767ecb721e80e72b0 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 11 Oct 2019 23:55:16 +0800 Subject: [PATCH 04/10] [html-table] renderer detects neg amounts for first cell-data previous would only negate whereby table-cell has single monetary/amount. change to detect whereby table-cell has multiple items, and the first one is a negative monetary/amount. this is useful for the budget spreadsheet whereby a negative monetary may be followed by a footnote. --- gnucash/report/report-system/html-table.scm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm index e1f9187bbb..771b2dab3f 100644 --- a/gnucash/report/report-system/html-table.scm +++ b/gnucash/report/report-system/html-table.scm @@ -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)))) From c5f232755b66cefd318401127ce92c4ad44d703c Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 10 Oct 2019 21:25:44 +0800 Subject: [PATCH 05/10] [html-text] dedupe gnc:html-text-render-markup-noclose dedupe the following fns * gnc:html-text-render-markup-noclose * gnc:html-text-render-markup --- gnucash/report/report-system/html-text.scm | 27 ++++++---------------- 1 file changed, 7 insertions(+), 20 deletions(-) diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm index bd586be815..3b308b505d 100644 --- a/gnucash/report/report-system/html-text.scm +++ b/gnucash/report/report-system/html-text.scm @@ -221,34 +221,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)) - - From e4bb516b944f944613e4cfcead96fd480a9b9a79 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 12 Oct 2019 13:11:11 +0800 Subject: [PATCH 06/10] [html-text] compact gnc:html-text-set-style! --- gnucash/report/report-system/html-text.scm | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm index 3b308b505d..fd1f29ade6 100644 --- a/gnucash/report/report-system/html-text.scm +++ b/gnucash/report/report-system/html-text.scm @@ -60,13 +60,9 @@ (record-modifier '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) From 66e5bc8a58bdbae6fb0eae33395d41ec6b40c29d Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 10 Oct 2019 21:47:26 +0800 Subject: [PATCH 07/10] [html-style-info] compact gnc:html-markup-style-info-set! --- .../report/report-system/html-style-info.scm | 36 ++++++++----------- 1 file changed, 14 insertions(+), 22 deletions(-) diff --git a/gnucash/report/report-system/html-style-info.scm b/gnucash/report/report-system/html-style-info.scm index 50b0a7b760..ab8cd07fc7 100644 --- a/gnucash/report/report-system/html-style-info.scm +++ b/gnucash/report/report-system/html-style-info.scm @@ -21,6 +21,7 @@ ;; Boston, MA 02110-1301, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(use-modules (ice-9 match)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 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 field) style value) + (loop rest)) + + (else style)))) (define gnc:html-markup-style-info-tag (record-accessor 'tag)) From 8e64fa7f6595599c985f68d91f3d7195bae2f569 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 12 Oct 2019 13:18:02 +0800 Subject: [PATCH 08/10] [html-style-info] compact gnc:html-style-table-fetch --- .../report/report-system/html-style-info.scm | 34 ++++++++----------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/gnucash/report/report-system/html-style-info.scm b/gnucash/report/report-system/html-style-info.scm index ab8cd07fc7..38c166da8f 100644 --- a/gnucash/report/report-system/html-style-info.scm +++ b/gnucash/report/report-system/html-style-info.scm @@ -353,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)) - - - - From 530f778dbb90f6e24d8285212f46b6e598b711e3 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 11 Oct 2019 07:48:37 +0800 Subject: [PATCH 09/10] [trep-engine] disable regex if no regex in guile --- gnucash/report/report-system/trep-engine.scm | 42 ++++++++++++++------ 1 file changed, 29 insertions(+), 13 deletions(-) diff --git a/gnucash/report/report-system/trep-engine.scm b/gnucash/report/report-system/trep-engine.scm index eb1098ba34..fbcce9f052 100644 --- a/gnucash/report/report-system/trep-engine.scm +++ b/gnucash/report/report-system/trep-engine.scm @@ -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. From 4c790b2084f904a5b8db10e4d8d5a23449a10005 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 11 Oct 2019 21:26:49 +0800 Subject: [PATCH 10/10] Bug 412151 - Not handling exception when guile is compiled w/o regexp support disable qif-import and make-regexp if guile is compiled without regex --- .../qif-imp/assistant-qif-import.c | 7 ++++++ gnucash/import-export/qif-imp/qif-parse.scm | 24 +++++++++++++------ gnucash/report/report-system/eguile-gnc.scm | 8 ++++--- .../report-system/eguile-html-utilities.scm | 3 ++- 4 files changed, 31 insertions(+), 11 deletions(-) diff --git a/gnucash/import-export/qif-imp/assistant-qif-import.c b/gnucash/import-export/qif-imp/assistant-qif-import.c index 282400f075..ada03f855c 100644 --- a/gnucash/import-export/qif-imp/assistant-qif-import.c +++ b/gnucash/import-export/qif-imp/assistant-qif-import.c @@ -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); diff --git a/gnucash/import-export/qif-imp/qif-parse.scm b/gnucash/import-export/qif-imp/qif-parse.scm index c79959f918..0350a31a45 100644 --- a/gnucash/import-export/qif-imp/qif-parse.scm +++ b/gnucash/import-export/qif-imp/qif-parse.scm @@ -26,6 +26,8 @@ (use-modules (gnucash import-export 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 diff --git a/gnucash/report/report-system/eguile-gnc.scm b/gnucash/report/report-system/eguile-gnc.scm index 1731ca6aed..f37b95dd36 100644 --- a/gnucash/report/report-system/eguile-gnc.scm +++ b/gnucash/report/report-system/eguile-gnc.scm @@ -108,8 +108,8 @@ (#\& . "&")))) ;; 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) diff --git a/gnucash/report/report-system/eguile-html-utilities.scm b/gnucash/report/report-system/eguile-html-utilities.scm index d123f6109a..7ff8a94d67 100644 --- a/gnucash/report/report-system/eguile-html-utilities.scm +++ b/gnucash/report/report-system/eguile-html-utilities.scm @@ -88,7 +88,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.