[qif-utils] use srfi-13 instead of regexp functions

This commit is contained in:
Christopher Lam 2019-07-28 21:10:14 +08:00
parent fbb6a95600
commit db93aec58d
4 changed files with 29 additions and 70 deletions

View File

@ -569,7 +569,7 @@
(if (or (and (not acct-name) (if (or (and (not acct-name)
(not security) (not security)
payee (string? payee) payee (string? payee)
(string=? (string-remove-trailing-space payee) (string=? (string-trim-right payee)
"Opening Balance") "Opening Balance")
cat-is-acct?) cat-is-acct?)
(and acct-name (string? acct-name) (and acct-name (string? acct-name)

View File

@ -525,8 +525,8 @@
(if last-dot (if last-dot
last-dot last-dot
(string-length namestring))))) (string-length namestring)))))
(set! namestring (string-replace-char! namestring #\- #\space)) (set! namestring (gnc:string-replace-char namestring #\- #\space))
(set! namestring (string-replace-char! namestring #\_ #\space)) (set! namestring (gnc:string-replace-char namestring #\_ #\space))
namestring) namestring)
"QIF Import"))) "QIF Import")))

View File

@ -24,6 +24,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (gnucash import-export string)) (use-modules (gnucash import-export string))
(use-modules (srfi srfi-13))
(define qif-category-compiled-rexp (define qif-category-compiled-rexp
(make-regexp "^ *(\\[)?([^]/|]*)(]?)(/?)([^|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$")) (make-regexp "^ *(\\[)?([^]/|]*)(]?)(/?)([^|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$"))
@ -162,8 +163,7 @@
(define (qif-parse:parse-acct-type read-value errorproc errortype) (define (qif-parse:parse-acct-type read-value errorproc errortype)
(let ((mangled-string (let ((mangled-string
(string-downcase! (string-remove-trailing-space (string-downcase! (string-trim-both read-value))))
(string-remove-leading-space read-value)))))
(cond (cond
((string=? mangled-string "bank") ((string=? mangled-string "bank")
(list GNC-BANK-TYPE)) (list GNC-BANK-TYPE))
@ -197,8 +197,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-bang-field read-value) (define (qif-parse:parse-bang-field read-value)
(let ((bang-field (string-downcase! (let ((bang-field (string-downcase! (string-trim read-value))))
(string-remove-trailing-space read-value))))
;; The QIF files output by the WWW site of Credit Lyonnais ;; The QIF files output by the WWW site of Credit Lyonnais
;; begin by: !type bank ;; begin by: !type bank
;; instead of: !Type:bank ;; instead of: !Type:bank
@ -211,8 +210,8 @@
(define (qif-parse:parse-action-field read-value errorproc errortype) (define (qif-parse:parse-action-field read-value errorproc errortype)
(if read-value (if read-value
(let ((action-symbol (string-to-canonical-symbol read-value))) (begin
(case action-symbol (case (string->symbol (string-downcase (string-trim-both read-value)))
;; buy ;; buy
((buy cvrshrt kauf) ((buy cvrshrt kauf)
'buy) 'buy)
@ -579,7 +578,7 @@
(filtered-string (gnc:string-delete-chars value-string "$'+-"))) (filtered-string (gnc:string-delete-chars value-string "$'+-")))
(case format (case format
((decimal) ((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 (read-val (with-input-from-string read-string
(lambda () (read))))) (lambda () (read)))))
(if (number? read-val) (if (number? read-val)
@ -587,12 +586,12 @@
(if minus-index (- 0.0 read-val) (+ 0.0 read-val)) (if minus-index (- 0.0 read-val) (+ 0.0 read-val))
GNC-DENOM-AUTO GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS (logior (GNC-DENOM-SIGFIGS
(string-length (string-remove-char read-string #\.))) (string-length (gnc:string-delete-chars read-string ".")))
GNC-RND-ROUND)) GNC-RND-ROUND))
(gnc-numeric-zero)))) (gnc-numeric-zero))))
((comma) ((comma)
(let* ((read-string (gnc:string-replace-char (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 (read-val (with-input-from-string read-string
(lambda () (read))))) (lambda () (read)))))
@ -601,7 +600,7 @@
(if minus-index (- 0.0 read-val) (+ 0.0 read-val)) (if minus-index (- 0.0 read-val) (+ 0.0 read-val))
GNC-DENOM-AUTO GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS (logior (GNC-DENOM-SIGFIGS
(string-length (string-remove-char read-string #\.))) (string-length (gnc:string-delete-chars read-string ".")))
GNC-RND-ROUND)) GNC-RND-ROUND))
(gnc-numeric-zero)))) (gnc-numeric-zero))))
((integer) ((integer)

View File

@ -24,72 +24,34 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (ice-9 regex)) (use-modules (srfi srfi-13))
(define qif-import:paused #f) (define qif-import:paused #f)
(define qif-import:canceled #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) (define (string-remove-trailing-space str)
(let ((match (regexp-exec remove-trailing-space-rexp str))) (issue-deprecation-warning "string-remove-trailing-space - use string-trim-right")
(if match (string-trim-right str))
(string-copy (match:substring match 1))
"")))
(define (string-remove-leading-space str) (define (string-remove-leading-space str)
(let ((match (regexp-exec remove-leading-space-rexp str))) (issue-deprecation-warning "string-remove-leading-space - use string-trim")
(if match (string-trim str))
(string-copy (match:substring match 1))
"")))
(define (string-remove-char str char) (define (string-remove-char str char)
(let ((rexpstr (issue-deprecation-warning "string-remove-char - use gnc:string-delete-chars")
(case char (gnc:string-delete-chars s (list 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))))
(define (string-replace-char! str old new) (define (string-replace-char! str old new)
(let ((rexpstr (issue-deprecation-warning "string-replace-char! - use gnc:string-replace-char")
(if (not (eq? old #\.)) (gnc:string-replace-char str old new))
(make-string 1 old)
"\\."))
(newstr (make-string 1 new)))
(regexp-substitute/global #f rexpstr str 'pre newstr 'post)))
(define (string-to-canonical-symbol str) (define (string-to-canonical-symbol str)
(issue-deprecation-warning "string-to-canonical-symbol - inline instead")
(string->symbol (string->symbol
(string-downcase (string-downcase
(string-remove-leading-space (string-remove-leading-space
(string-remove-trailing-space str))))) (string-remove-trailing-space str)))))
(define (qif-import:log progress-dialog proc str) (define (qif-import:log progress-dialog proc str)
(if progress-dialog (if progress-dialog
(gnc-progress-dialog-append-log progress-dialog (string-append str "\n")) (gnc-progress-dialog-append-log progress-dialog (string-append str "\n"))
@ -103,15 +65,13 @@
(set! qif-import:canceled #t)) (set! qif-import:canceled #t))
(define (qif-import:toggle-pause progress-dialog) (define (qif-import:toggle-pause progress-dialog)
(if qif-import:paused (cond
(begin (qif-import:paused
(set! qif-import:paused #f) (set! qif-import:paused #f)
(if progress-dialog (when progress-dialog (gnc-progress-dialog-resume progress-dialog)))
(gnc-progress-dialog-resume progress-dialog))) (else
(begin
(set! qif-import:paused #t) (set! qif-import:paused #t)
(if progress-dialog (when progress-dialog (gnc-progress-dialog-pause progress-dialog)))))
(gnc-progress-dialog-pause progress-dialog)))))
(define (qif-import:check-pause progress-dialog) (define (qif-import:check-pause progress-dialog)
(while (and qif-import:paused (not qif-import:canceled)) (while (and qif-import:paused (not qif-import:canceled))