From db93aec58d32e871b7d7f17840d9bdec6ee07cc6 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 28 Jul 2019 21:10:14 +0800 Subject: [PATCH] [qif-utils] use srfi-13 instead of regexp functions --- gnucash/import-export/qif-imp/qif-file.scm | 2 +- gnucash/import-export/qif-imp/qif-objects.scm | 4 +- gnucash/import-export/qif-imp/qif-parse.scm | 19 +++-- gnucash/import-export/qif-imp/qif-utils.scm | 74 +++++-------------- 4 files changed, 29 insertions(+), 70 deletions(-) diff --git a/gnucash/import-export/qif-imp/qif-file.scm b/gnucash/import-export/qif-imp/qif-file.scm index f053daa2ef..ad73f2a99b 100644 --- a/gnucash/import-export/qif-imp/qif-file.scm +++ b/gnucash/import-export/qif-imp/qif-file.scm @@ -569,7 +569,7 @@ (if (or (and (not acct-name) (not security) payee (string? payee) - (string=? (string-remove-trailing-space payee) + (string=? (string-trim-right payee) "Opening Balance") cat-is-acct?) (and acct-name (string? acct-name) diff --git a/gnucash/import-export/qif-imp/qif-objects.scm b/gnucash/import-export/qif-imp/qif-objects.scm index d4be4d92cf..1eaf8cd861 100644 --- a/gnucash/import-export/qif-imp/qif-objects.scm +++ b/gnucash/import-export/qif-imp/qif-objects.scm @@ -525,8 +525,8 @@ (if last-dot last-dot (string-length namestring))))) - (set! namestring (string-replace-char! namestring #\- #\space)) - (set! namestring (string-replace-char! namestring #\_ #\space)) + (set! namestring (gnc:string-replace-char namestring #\- #\space)) + (set! namestring (gnc:string-replace-char namestring #\_ #\space)) namestring) "QIF Import"))) diff --git a/gnucash/import-export/qif-imp/qif-parse.scm b/gnucash/import-export/qif-imp/qif-parse.scm index 1a636694dd..3c12c9d7e1 100644 --- a/gnucash/import-export/qif-imp/qif-parse.scm +++ b/gnucash/import-export/qif-imp/qif-parse.scm @@ -24,6 +24,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (use-modules (gnucash import-export string)) +(use-modules (srfi srfi-13)) (define qif-category-compiled-rexp (make-regexp "^ *(\\[)?([^]/|]*)(]?)(/?)([^|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$")) @@ -162,8 +163,7 @@ (define (qif-parse:parse-acct-type read-value errorproc errortype) (let ((mangled-string - (string-downcase! (string-remove-trailing-space - (string-remove-leading-space read-value))))) + (string-downcase! (string-trim-both read-value)))) (cond ((string=? mangled-string "bank") (list GNC-BANK-TYPE)) @@ -197,8 +197,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (qif-parse:parse-bang-field read-value) - (let ((bang-field (string-downcase! - (string-remove-trailing-space read-value)))) + (let ((bang-field (string-downcase! (string-trim read-value)))) ;; The QIF files output by the WWW site of Credit Lyonnais ;; begin by: !type bank ;; instead of: !Type:bank @@ -211,8 +210,8 @@ (define (qif-parse:parse-action-field read-value errorproc errortype) (if read-value - (let ((action-symbol (string-to-canonical-symbol read-value))) - (case action-symbol + (begin + (case (string->symbol (string-downcase (string-trim-both read-value))) ;; buy ((buy cvrshrt kauf) 'buy) @@ -579,7 +578,7 @@ (filtered-string (gnc:string-delete-chars value-string "$'+-"))) (case format ((decimal) - (let* ((read-string (string-remove-char filtered-string #\,)) + (let* ((read-string (gnc:string-delete-chars filtered-string ",")) (read-val (with-input-from-string read-string (lambda () (read))))) (if (number? read-val) @@ -587,12 +586,12 @@ (if minus-index (- 0.0 read-val) (+ 0.0 read-val)) GNC-DENOM-AUTO (logior (GNC-DENOM-SIGFIGS - (string-length (string-remove-char read-string #\.))) + (string-length (gnc:string-delete-chars read-string "."))) GNC-RND-ROUND)) (gnc-numeric-zero)))) ((comma) (let* ((read-string (gnc:string-replace-char - (string-remove-char filtered-string #\.) + (gnc:string-delete-chars filtered-string ".") #\, #\.)) (read-val (with-input-from-string read-string (lambda () (read))))) @@ -601,7 +600,7 @@ (if minus-index (- 0.0 read-val) (+ 0.0 read-val)) GNC-DENOM-AUTO (logior (GNC-DENOM-SIGFIGS - (string-length (string-remove-char read-string #\.))) + (string-length (gnc:string-delete-chars read-string "."))) GNC-RND-ROUND)) (gnc-numeric-zero)))) ((integer) diff --git a/gnucash/import-export/qif-imp/qif-utils.scm b/gnucash/import-export/qif-imp/qif-utils.scm index 845994cb00..9c4359697a 100644 --- a/gnucash/import-export/qif-imp/qif-utils.scm +++ b/gnucash/import-export/qif-imp/qif-utils.scm @@ -24,72 +24,34 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(use-modules (ice-9 regex)) +(use-modules (srfi srfi-13)) (define qif-import:paused #f) (define qif-import:canceled #f) -(define (simple-filter pred list) - (let ((retval '())) - (map (lambda (elt) - (if (pred elt) - (set! retval (cons elt retval)))) - list) - (reverse retval))) - -(define remove-trailing-space-rexp - (make-regexp "^(.*[^ ]+) *$")) - -(define remove-leading-space-rexp - (make-regexp "^ *([^ ].*)$")) - (define (string-remove-trailing-space str) - (let ((match (regexp-exec remove-trailing-space-rexp str))) - (if match - (string-copy (match:substring match 1)) - ""))) + (issue-deprecation-warning "string-remove-trailing-space - use string-trim-right") + (string-trim-right str)) (define (string-remove-leading-space str) - (let ((match (regexp-exec remove-leading-space-rexp str))) - (if match - (string-copy (match:substring match 1)) - ""))) + (issue-deprecation-warning "string-remove-leading-space - use string-trim") + (string-trim str)) (define (string-remove-char str char) - (let ((rexpstr - (case char - ((#\.) "\\.") - ((#\^) "\\^") - ((#\$) "\\$") - ((#\*) "\\*") - ((#\+) "\\+") - ((#\\) "\\\\") - ((#\?) "\\?") - (else - (make-string 1 char))))) - (regexp-substitute/global #f rexpstr str 'pre 'post))) - - -(define (string-char-count str char) - (length (simple-filter (lambda (elt) (eq? elt char)) - (string->list str)))) - + (issue-deprecation-warning "string-remove-char - use gnc:string-delete-chars") + (gnc:string-delete-chars s (list char))) (define (string-replace-char! str old new) - (let ((rexpstr - (if (not (eq? old #\.)) - (make-string 1 old) - "\\.")) - (newstr (make-string 1 new))) - (regexp-substitute/global #f rexpstr str 'pre newstr 'post))) + (issue-deprecation-warning "string-replace-char! - use gnc:string-replace-char") + (gnc:string-replace-char str old new)) (define (string-to-canonical-symbol str) + (issue-deprecation-warning "string-to-canonical-symbol - inline instead") (string->symbol (string-downcase (string-remove-leading-space (string-remove-trailing-space str))))) - (define (qif-import:log progress-dialog proc str) (if progress-dialog (gnc-progress-dialog-append-log progress-dialog (string-append str "\n")) @@ -103,15 +65,13 @@ (set! qif-import:canceled #t)) (define (qif-import:toggle-pause progress-dialog) - (if qif-import:paused - (begin - (set! qif-import:paused #f) - (if progress-dialog - (gnc-progress-dialog-resume progress-dialog))) - (begin - (set! qif-import:paused #t) - (if progress-dialog - (gnc-progress-dialog-pause progress-dialog))))) + (cond + (qif-import:paused + (set! qif-import:paused #f) + (when progress-dialog (gnc-progress-dialog-resume progress-dialog))) + (else + (set! qif-import:paused #t) + (when progress-dialog (gnc-progress-dialog-pause progress-dialog))))) (define (qif-import:check-pause progress-dialog) (while (and qif-import:paused (not qif-import:canceled))