mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[qif-utils] use srfi-13 instead of regexp functions
This commit is contained in:
Christopher Lam
parent
fbb6a95600
commit
db93aec58d
@ -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)
|
||||
|
||||
@ -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")))
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user