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:
parent
fbb6a95600
commit
db93aec58d
@ -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)
|
||||||
|
@ -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")))
|
||||||
|
|
||||||
|
@ -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)
|
||||||
|
@ -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))
|
||||||
|
Loading…
Reference in New Issue
Block a user