gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Tue Jul 30 09:56:35 EDT 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/db93aec5 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/fbb6a956 (commit)
	from  https://github.com/Gnucash/gnucash/commit/76ba1331 (commit)



commit db93aec58d32e871b7d7f17840d9bdec6ee07cc6
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 28 21:10:14 2019 +0800

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

diff --git a/gnucash/import-export/qif-imp/qif-file.scm b/gnucash/import-export/qif-imp/qif-file.scm
index f053daa2e..ad73f2a99 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 d4be4d92c..1eaf8cd86 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 1a636694d..3c12c9d7e 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 845994cb0..9c4359697 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))

commit fbb6a956002776aaee143bf0fc0524706ab1ac91
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jul 28 20:01:38 2019 +0800

    [simple-obj] deprecate this module
    
    * it's only a wrapper for make-record-type
    * use record-types directly in modules

diff --git a/gnucash/import-export/qif-imp/qif-guess-map.scm b/gnucash/import-export/qif-imp/qif-guess-map.scm
index 12802086e..f19ab0c52 100644
--- a/gnucash/import-export/qif-imp/qif-guess-map.scm
+++ b/gnucash/import-export/qif-imp/qif-guess-map.scm
@@ -39,6 +39,14 @@
 (define GNC-RECEIVABLE-TYPE 11)
 (define GNC-PAYABLE-TYPE 12)
 
+(define (record-fields->list record)
+  (let ((type (record-type-descriptor record)))
+    (map
+     (lambda (field) ((record-accessor type field) record))
+     (record-type-fields type))))
+
+(define (list->record-fields lst type)
+  (apply (record-constructor type) lst))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  qif-import:load-map-prefs
@@ -180,7 +188,7 @@
   (let ((table '()))
     (hash-fold
      (lambda (key value p)
-       (set! table (cons (cons key (simple-obj-to-list value)) table))
+       (set! table (cons (cons key (record-fields->list value)) table))
        #f) #f hashtab)
     (write table)))
 
@@ -192,7 +200,7 @@
     (for-each
      (lambda (entry)
        (let ((key (car entry))
-             (value (simple-obj-from-list (cdr entry) <qif-map-entry>)))
+             (value (list->record-fields (cdr entry) <qif-map-entry>)))
 
          ;; If the account separator has changed, fix the account name.
          (if changed-sep?
diff --git a/gnucash/import-export/qif-imp/qif-objects.scm b/gnucash/import-export/qif-imp/qif-objects.scm
index 0f1a7aa5c..d4be4d92c 100644
--- a/gnucash/import-export/qif-imp/qif-objects.scm
+++ b/gnucash/import-export/qif-imp/qif-objects.scm
@@ -24,6 +24,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
+(define (construct class)
+  (apply (record-constructor class)
+         (map (const #f) (record-type-fields class))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  qif-file class 
@@ -34,7 +37,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-file>
-  (make-simple-class 
+  (make-record-type
    'qif-file 
    '(path                 ;; where file was loaded 
      y2k-threshold
@@ -47,43 +50,43 @@
   (record-predicate <qif-file>))
 
 (define qif-file:path 
-  (simple-obj-getter <qif-file> 'path))
+  (record-accessor <qif-file> 'path))
 
 (define qif-file:set-path! 
-  (simple-obj-setter <qif-file> 'path))
+  (record-modifier <qif-file> 'path))
 
 (define qif-file:y2k-threshold 
-  (simple-obj-getter <qif-file> 'y2k-threshold))
+  (record-accessor <qif-file> 'y2k-threshold))
 
 (define qif-file:set-y2k-threshold!
-  (simple-obj-setter <qif-file> 'y2k-threshold))
+  (record-modifier <qif-file> 'y2k-threshold))
 
 (define qif-file:cats 
-  (simple-obj-getter <qif-file> 'cats))
+  (record-accessor <qif-file> 'cats))
 
 (define qif-file:set-cats!
-  (simple-obj-setter <qif-file> 'cats))
+  (record-modifier <qif-file> 'cats))
 
 (define qif-file:classes 
-  (simple-obj-getter <qif-file> 'classes))
+  (record-accessor <qif-file> 'classes))
 
 (define qif-file:set-classes!
-  (simple-obj-setter <qif-file> 'classes))
+  (record-modifier <qif-file> 'classes))
 
 (define qif-file:xtns 
-  (simple-obj-getter <qif-file> 'xtns))
+  (record-accessor <qif-file> 'xtns))
 
 (define qif-file:set-xtns!
-  (simple-obj-setter <qif-file> 'xtns))
+  (record-modifier <qif-file> 'xtns))
 
 (define qif-file:accounts 
-  (simple-obj-getter <qif-file> 'accounts))
+  (record-accessor <qif-file> 'accounts))
 
 (define qif-file:set-accounts!
-  (simple-obj-setter <qif-file> 'accounts))
+  (record-modifier <qif-file> 'accounts))
 
 (define (make-qif-file) 
-  (let ((self (make-simple-obj <qif-file>)))
+  (let ((self (construct <qif-file>)))
     (qif-file:set-y2k-threshold! self 50)
     (qif-file:set-xtns! self '())
     (qif-file:set-accounts! self '())
@@ -97,16 +100,16 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-split>
-  (make-simple-class 
+  (make-record-type
    'qif-split
    '(category class memo amount category-is-account? matching-cleared mark
               miscx-category miscx-is-account? miscx-class)))
 
 (define qif-split:category 
-  (simple-obj-getter <qif-split> 'category))
+  (record-accessor <qif-split> 'category))
 
 (define qif-split:set-category-private!
-  (simple-obj-setter <qif-split> 'category))
+  (record-modifier <qif-split> 'category))
 
 (define (qif-split:set-category! self value)
   (let* ((cat-info 
@@ -125,61 +128,61 @@
     (qif-split:set-miscx-class! self miscx-class)))
     
 (define qif-split:class 
-  (simple-obj-getter <qif-split> 'class))
+  (record-accessor <qif-split> 'class))
 
 (define qif-split:set-class!
-  (simple-obj-setter <qif-split> 'class))
+  (record-modifier <qif-split> 'class))
 
 (define qif-split:memo 
-  (simple-obj-getter <qif-split> 'memo))
+  (record-accessor <qif-split> 'memo))
 
 (define qif-split:set-memo! 
-  (simple-obj-setter <qif-split> 'memo))
+  (record-modifier <qif-split> 'memo))
 
 (define qif-split:amount 
-  (simple-obj-getter <qif-split> 'amount))
+  (record-accessor <qif-split> 'amount))
 
 (define qif-split:set-amount! 
-  (simple-obj-setter <qif-split> 'amount))
+  (record-modifier <qif-split> 'amount))
 
 (define qif-split:mark 
-  (simple-obj-getter <qif-split> 'mark))
+  (record-accessor <qif-split> 'mark))
 
 (define qif-split:set-mark! 
-  (simple-obj-setter <qif-split> 'mark))
+  (record-modifier <qif-split> 'mark))
 
 (define qif-split:matching-cleared 
-  (simple-obj-getter <qif-split> 'matching-cleared))
+  (record-accessor <qif-split> 'matching-cleared))
 
 (define qif-split:set-matching-cleared! 
-  (simple-obj-setter <qif-split> 'matching-cleared))
+  (record-modifier <qif-split> 'matching-cleared))
 
 (define qif-split:category-is-account? 
-  (simple-obj-getter <qif-split> 'category-is-account?))
+  (record-accessor <qif-split> 'category-is-account?))
 
 (define qif-split:set-category-is-account?! 
-  (simple-obj-setter <qif-split> 'category-is-account?))
+  (record-modifier <qif-split> 'category-is-account?))
 
 (define qif-split:miscx-is-account? 
-  (simple-obj-getter <qif-split> 'miscx-is-account?))
+  (record-accessor <qif-split> 'miscx-is-account?))
 
 (define qif-split:set-miscx-is-account?!
-  (simple-obj-setter <qif-split> 'miscx-is-account?))
+  (record-modifier <qif-split> 'miscx-is-account?))
 
 (define qif-split:miscx-category 
-  (simple-obj-getter <qif-split> 'miscx-category))
+  (record-accessor <qif-split> 'miscx-category))
 
 (define qif-split:set-miscx-category!
-  (simple-obj-setter <qif-split> 'miscx-category))
+  (record-modifier <qif-split> 'miscx-category))
 
 (define qif-split:miscx-class 
-  (simple-obj-getter <qif-split> 'miscx-class))
+  (record-accessor <qif-split> 'miscx-class))
 
 (define qif-split:set-miscx-class!
-  (simple-obj-setter <qif-split> 'miscx-class))
+  (record-modifier <qif-split> 'miscx-class))
 
 (define (make-qif-split)
-  (let ((self (make-simple-obj <qif-split>)))
+  (let ((self (construct <qif-split>)))
     (qif-split:set-category! self "")
     self))
 
@@ -200,7 +203,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-xtn>
-  (make-simple-class 
+  (make-record-type
    'qif-xtn
    '(date payee address number action cleared  
           from-acct share-price num-shares security-name commission 
@@ -210,97 +213,97 @@
   (record-predicate <qif-xtn>))
 
 (define qif-xtn:date
-  (simple-obj-getter <qif-xtn> 'date))
+  (record-accessor <qif-xtn> 'date))
 
 (define qif-xtn:set-date! 
-  (simple-obj-setter <qif-xtn> 'date))
+  (record-modifier <qif-xtn> 'date))
 
 (define qif-xtn:payee
-  (simple-obj-getter <qif-xtn> 'payee))
+  (record-accessor <qif-xtn> 'payee))
 
 (define qif-xtn:set-payee! 
-  (simple-obj-setter <qif-xtn> 'payee))
+  (record-modifier <qif-xtn> 'payee))
 
 (define qif-xtn:address
-  (simple-obj-getter <qif-xtn> 'address))
+  (record-accessor <qif-xtn> 'address))
 
 (define qif-xtn:set-address! 
-  (simple-obj-setter <qif-xtn> 'address))
+  (record-modifier <qif-xtn> 'address))
 
 (define qif-xtn:number
-  (simple-obj-getter <qif-xtn> 'number))
+  (record-accessor <qif-xtn> 'number))
 
 (define qif-xtn:set-number! 
-  (simple-obj-setter <qif-xtn> 'number))
+  (record-modifier <qif-xtn> 'number))
 
 (define qif-xtn:action
-  (simple-obj-getter <qif-xtn> 'action))
+  (record-accessor <qif-xtn> 'action))
 
 (define qif-xtn:set-action! 
-  (simple-obj-setter <qif-xtn> 'action))
+  (record-modifier <qif-xtn> 'action))
 
 (define qif-xtn:cleared
-  (simple-obj-getter <qif-xtn> 'cleared))
+  (record-accessor <qif-xtn> 'cleared))
 
 (define qif-xtn:set-cleared! 
-  (simple-obj-setter <qif-xtn> 'cleared))
+  (record-modifier <qif-xtn> 'cleared))
 
 (define qif-xtn:from-acct
-  (simple-obj-getter <qif-xtn> 'from-acct))
+  (record-accessor <qif-xtn> 'from-acct))
 
 (define qif-xtn:set-from-acct! 
-  (simple-obj-setter <qif-xtn> 'from-acct))
+  (record-modifier <qif-xtn> 'from-acct))
 
 (define qif-xtn:share-price
-  (simple-obj-getter <qif-xtn> 'share-price))
+  (record-accessor <qif-xtn> 'share-price))
 
 (define qif-xtn:set-share-price! 
-  (simple-obj-setter <qif-xtn> 'share-price))
+  (record-modifier <qif-xtn> 'share-price))
 
 (define qif-xtn:num-shares
-  (simple-obj-getter <qif-xtn> 'num-shares))
+  (record-accessor <qif-xtn> 'num-shares))
 
 (define qif-xtn:set-num-shares! 
-  (simple-obj-setter <qif-xtn> 'num-shares))
+  (record-modifier <qif-xtn> 'num-shares))
 
 (define qif-xtn:security-name
-  (simple-obj-getter <qif-xtn> 'security-name))
+  (record-accessor <qif-xtn> 'security-name))
 
 (define qif-xtn:set-security-name! 
-  (simple-obj-setter <qif-xtn> 'security-name))
+  (record-modifier <qif-xtn> 'security-name))
 
 (define qif-xtn:commission
-  (simple-obj-getter <qif-xtn> 'commission))
+  (record-accessor <qif-xtn> 'commission))
 
 (define qif-xtn:set-commission! 
-  (simple-obj-setter <qif-xtn> 'commission))
+  (record-modifier <qif-xtn> 'commission))
 
 (define qif-xtn:default-split
-  (simple-obj-getter <qif-xtn> 'default-split))
+  (record-accessor <qif-xtn> 'default-split))
 
 (define qif-xtn:set-default-split! 
-  (simple-obj-setter <qif-xtn> 'default-split))
+  (record-modifier <qif-xtn> 'default-split))
 
 (define qif-xtn:splits
-  (simple-obj-getter <qif-xtn> 'splits))
+  (record-accessor <qif-xtn> 'splits))
 
 (define qif-xtn:set-splits! 
-  (simple-obj-setter <qif-xtn> 'splits))
+  (record-modifier <qif-xtn> 'splits))
 
 (define qif-xtn:mark
-  (simple-obj-getter <qif-xtn> 'mark))
+  (record-accessor <qif-xtn> 'mark))
 
 (define qif-xtn:set-mark! 
-  (simple-obj-setter <qif-xtn> 'mark))
+  (record-modifier <qif-xtn> 'mark))
 
 (define (make-qif-xtn)
-  (let ((self (make-simple-obj <qif-xtn>)))
+  (let ((self (construct <qif-xtn>)))
     (qif-xtn:set-mark! self #f)
     (qif-xtn:set-splits! self '())
     self))
 
 (define (qif-xtn:print self)
-  (simple-obj-print self))
+  (write self))
 
 
 (define (qif-xtn:split-amounts self)
@@ -340,42 +343,42 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-acct>
-  (make-simple-class 
+  (make-record-type
    'qif-acct
    '(name type description limit budget)))
 
 (define qif-acct:name
-  (simple-obj-getter <qif-acct> 'name))
+  (record-accessor <qif-acct> 'name))
 
 (define qif-acct:set-name! 
-  (simple-obj-setter <qif-acct> 'name))
+  (record-modifier <qif-acct> 'name))
 
 (define qif-acct:type
-  (simple-obj-getter <qif-acct> 'type))
+  (record-accessor <qif-acct> 'type))
 
 (define qif-acct:set-type! 
-  (simple-obj-setter <qif-acct> 'type))
+  (record-modifier <qif-acct> 'type))
 
 (define qif-acct:description
-  (simple-obj-getter <qif-acct> 'description))
+  (record-accessor <qif-acct> 'description))
 
 (define qif-acct:set-description! 
-  (simple-obj-setter <qif-acct> 'description))
+  (record-modifier <qif-acct> 'description))
 
 (define qif-acct:limit
-  (simple-obj-getter <qif-acct> 'limit))
+  (record-accessor <qif-acct> 'limit))
 
 (define qif-acct:set-limit! 
-  (simple-obj-setter <qif-acct> 'limit))
+  (record-modifier <qif-acct> 'limit))
 
 (define qif-acct:budget
-  (simple-obj-getter <qif-acct> 'budget))
+  (record-accessor <qif-acct> 'budget))
 
 (define qif-acct:set-budget! 
-  (simple-obj-setter <qif-acct> 'budget))
+  (record-modifier <qif-acct> 'budget))
 
 (define (make-qif-acct)
-  (let ((retval (make-simple-obj <qif-acct>)))
+  (let ((retval (construct <qif-acct>)))
     (qif-acct:set-type! retval "Bank")
     (qif-acct:set-name! retval "Default Account")
     retval))
@@ -384,7 +387,7 @@
   (record-predicate <qif-acct>))
 
 (define (qif-acct:print self)
-  (simple-obj-print self))
+  (write self))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  <qif-class>
@@ -393,27 +396,27 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-class>
-  (make-simple-class
+  (make-record-type
    'qif-class
    '(name description)))
 
 (define qif-class:name
-  (simple-obj-getter <qif-class> 'name))
+  (record-accessor <qif-class> 'name))
 
 (define qif-class:set-name! 
-  (simple-obj-setter <qif-class> 'name))
+  (record-modifier <qif-class> 'name))
 
 (define qif-class:description
-  (simple-obj-getter <qif-class> 'description))
+  (record-accessor <qif-class> 'description))
 
 (define qif-class:set-description! 
-  (simple-obj-setter <qif-class> 'description))
+  (record-modifier <qif-class> 'description))
 
 (define (qif-class:print self)
-  (simple-obj-print self))
+  (write self))
 
 (define (make-qif-class)
-  (make-simple-obj <qif-class>))
+  (construct <qif-class>))
 
 (define qif-class? 
   (record-predicate <qif-class>))
@@ -431,60 +434,60 @@
 
 
 (define <qif-cat>
-  (make-simple-class 
+  (make-record-type
    'qif-cat
    '(name description taxable expense-cat income-cat tax-class budget-amt)))
 
 (define qif-cat:name
-  (simple-obj-getter <qif-cat> 'name))
+  (record-accessor <qif-cat> 'name))
 
 (define qif-cat:set-name! 
-  (simple-obj-setter <qif-cat> 'name))
+  (record-modifier <qif-cat> 'name))
 
 (define qif-cat:description
-  (simple-obj-getter <qif-cat> 'description))
+  (record-accessor <qif-cat> 'description))
 
 (define qif-cat:set-description! 
-  (simple-obj-setter <qif-cat> 'description))
+  (record-modifier <qif-cat> 'description))
 
 (define qif-cat:taxable
-  (simple-obj-getter <qif-cat> 'taxable))
+  (record-accessor <qif-cat> 'taxable))
 
 (define qif-cat:set-taxable! 
-  (simple-obj-setter <qif-cat> 'taxable))
+  (record-modifier <qif-cat> 'taxable))
 
 (define qif-cat:expense-cat
-  (simple-obj-getter <qif-cat> 'expense-cat))
+  (record-accessor <qif-cat> 'expense-cat))
 
 (define qif-cat:set-expense-cat! 
-  (simple-obj-setter <qif-cat> 'expense-cat))
+  (record-modifier <qif-cat> 'expense-cat))
 
 (define qif-cat:income-cat
-  (simple-obj-getter <qif-cat> 'income-cat))
+  (record-accessor <qif-cat> 'income-cat))
 
 (define qif-cat:set-income-cat! 
-  (simple-obj-setter <qif-cat> 'income-cat))
+  (record-modifier <qif-cat> 'income-cat))
 
 (define qif-cat:tax-class
-  (simple-obj-getter <qif-cat> 'tax-class))
+  (record-accessor <qif-cat> 'tax-class))
 
 (define qif-cat:set-tax-class! 
-  (simple-obj-setter <qif-cat> 'tax-class))
+  (record-modifier <qif-cat> 'tax-class))
 
 (define qif-cat:budget-amt
-  (simple-obj-getter <qif-cat> 'budget-amt))
+  (record-accessor <qif-cat> 'budget-amt))
 
 (define qif-cat:set-budget-amt! 
-  (simple-obj-setter <qif-cat> 'budget-amt))
+  (record-modifier <qif-cat> 'budget-amt))
 
 (define (make-qif-cat) 
-  (make-simple-obj <qif-cat>))
+  (construct <qif-cat>))
 
 (define qif-cat? 
   (record-predicate <qif-cat>))
 
 (define (qif-cat:print self)
-  (simple-obj-print self))
+  (write self))
 
 (define (qif-file:add-xtn! self xtn)
   (qif-file:set-xtns! self 
@@ -535,7 +538,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-map-entry>
-  (make-simple-class
+  (make-record-type
    'qif-map-entry
    '(qif-name       ;; set while parsing file 
      allowed-types  ;; set while parsing file 
@@ -545,7 +548,7 @@
      display?)))    ;; set when non-zero transactions 
 
 (define (make-qif-map-entry)
-  (make-simple-obj <qif-map-entry>))
+  (construct <qif-map-entry>))
 
 (define (qif-map-entry:clone orig)
   (let ((me (make-qif-map-entry)))
@@ -586,40 +589,40 @@
 
 
 (define qif-map-entry:qif-name
-  (simple-obj-getter <qif-map-entry> 'qif-name))
+  (record-accessor <qif-map-entry> 'qif-name))
 
 (define qif-map-entry:set-qif-name!
-  (simple-obj-setter <qif-map-entry> 'qif-name))
+  (record-modifier <qif-map-entry> 'qif-name))
 
 (define qif-map-entry:allowed-types
-  (simple-obj-getter <qif-map-entry> 'allowed-types))
+  (record-accessor <qif-map-entry> 'allowed-types))
 
 (define qif-map-entry:set-allowed-types!
-  (simple-obj-setter <qif-map-entry> 'allowed-types))
+  (record-modifier <qif-map-entry> 'allowed-types))
 
 (define qif-map-entry:description
-  (simple-obj-getter <qif-map-entry> 'description))
+  (record-accessor <qif-map-entry> 'description))
 
 (define qif-map-entry:set-description!
-  (simple-obj-setter <qif-map-entry> 'description))
+  (record-modifier <qif-map-entry> 'description))
 
 (define qif-map-entry:gnc-name
-  (simple-obj-getter <qif-map-entry> 'gnc-name))
+  (record-accessor <qif-map-entry> 'gnc-name))
 
 (define qif-map-entry:set-gnc-name!
-  (simple-obj-setter <qif-map-entry> 'gnc-name))
+  (record-modifier <qif-map-entry> 'gnc-name))
 
 (define qif-map-entry:new-acct?
-  (simple-obj-getter <qif-map-entry> 'new-acct?))
+  (record-accessor <qif-map-entry> 'new-acct?))
 
 (define qif-map-entry:set-new-acct?!
-  (simple-obj-setter <qif-map-entry> 'new-acct?))
+  (record-modifier <qif-map-entry> 'new-acct?))
 
 (define qif-map-entry:display?
-  (simple-obj-getter <qif-map-entry> 'display?))
+  (record-accessor <qif-map-entry> 'display?))
 
 (define qif-map-entry:set-display?!
-  (simple-obj-setter <qif-map-entry> 'display?))
+  (record-modifier <qif-map-entry> 'display?))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -630,51 +633,51 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-stock-symbol>
-  (make-simple-class
+  (make-record-type
    'qif-stock-symbol
    '(name symbol type)))
 
 (define qif-stock-symbol:name
-  (simple-obj-getter <qif-stock-symbol> 'name))
+  (record-accessor <qif-stock-symbol> 'name))
 
 (define qif-stock-symbol:set-name! 
-  (simple-obj-setter <qif-stock-symbol> 'name))
+  (record-modifier <qif-stock-symbol> 'name))
 
 (define qif-stock-symbol:symbol
-  (simple-obj-getter <qif-stock-symbol> 'symbol))
+  (record-accessor <qif-stock-symbol> 'symbol))
 
 (define qif-stock-symbol:set-symbol! 
-  (simple-obj-setter <qif-stock-symbol> 'symbol))
+  (record-modifier <qif-stock-symbol> 'symbol))
 
 (define qif-stock-symbol:type
-  (simple-obj-getter <qif-stock-symbol> 'type))
+  (record-accessor <qif-stock-symbol> 'type))
 
 (define qif-stock-symbol:set-type! 
-  (simple-obj-setter <qif-stock-symbol> 'type))
+  (record-modifier <qif-stock-symbol> 'type))
 
 (define (qif-stock-symbol:print self)
-  (simple-obj-print self))
+  (write self))
 
 (define (make-qif-stock-symbol)
-  (let ((retval (make-simple-obj <qif-stock-symbol>)))
+  (let ((retval (construct <qif-stock-symbol>)))
     (qif-stock-symbol:set-name! retval "")
     (qif-stock-symbol:set-symbol! retval "")
     (qif-stock-symbol:set-type! retval "")
     retval))
 
 (define <qif-ticker-map>
-  (make-simple-class
+  (make-record-type
    'qif-ticker-map
    '(stocks)))
 
 (define qif-ticker-map:ticker-map
-  (simple-obj-getter <qif-ticker-map> 'stocks))
+  (record-accessor <qif-ticker-map> 'stocks))
 
 (define qif-ticker-map:set-ticker-map!
-  (simple-obj-setter <qif-ticker-map> 'stocks))
+  (record-modifier <qif-ticker-map> 'stocks))
 
 (define (make-ticker-map) 
-  (let ((self (make-simple-obj <qif-ticker-map>)))
+  (let ((self (construct <qif-ticker-map>)))
     (qif-ticker-map:set-ticker-map! self '())
     self))
 
diff --git a/libgnucash/app-utils/app-utils.scm b/libgnucash/app-utils/app-utils.scm
index f4437a2af..ca789412e 100644
--- a/libgnucash/app-utils/app-utils.scm
+++ b/libgnucash/app-utils/app-utils.scm
@@ -270,23 +270,23 @@
 (re-export HOOK-REPORT)
 
 ;; simple-obj
-(export make-simple-class)
-(export simple-obj-getter)
-(export simple-obj-setter)
-(export simple-obj-print)
-(export simple-obj-to-list)
-(export simple-obj-from-list)
-(export make-simple-obj)
+(export make-simple-class)              ;deprecate
+(export simple-obj-getter)              ;deprecate
+(export simple-obj-setter)              ;deprecate
+(export simple-obj-print)               ;deprecate
+(export simple-obj-to-list)             ;deprecate
+(export simple-obj-from-list)           ;deprecate
+(export make-simple-obj)                ;deprecate
 
 (define gnc:*kvp-option-path* (list KVP-OPTION-PATH))
 (export gnc:*kvp-option-path*)
 
 (load-from-path "c-interface")
 (load-from-path "options")
-(load-from-path "hooks")
+(load-from-path "hooks")                ;deprecate
 (load-from-path "prefs")
 (load-from-path "date-utilities")
-(load-from-path "simple-obj")
+(load-from-path "simple-obj")           ;deprecate
 
 ;; Business options
 (define gnc:*business-label* (N_ "Business"))
diff --git a/libgnucash/app-utils/simple-obj.scm b/libgnucash/app-utils/simple-obj.scm
index bb32ad3fa..9e502fa11 100644
--- a/libgnucash/app-utils/simple-obj.scm
+++ b/libgnucash/app-utils/simple-obj.scm
@@ -23,7 +23,6 @@
 ;; Boston, MA  02110-1301,  USA       gnu at gnu.org
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-
 ;;  this is an extremely rudimentary object system.  Each object is a
 ;;  cons cell, where the car is a symbol with the class name and the
 ;;  cdr is a vector of the slots.  
@@ -41,18 +40,23 @@
 
 ;; the 'simple-class' class.  
 (define (make-simple-class class-symbol slot-names) 
+  (issue-deprecation-warning "make-simple-class is deprecated. use make-record-type.")
   (make-record-type (symbol->string class-symbol) slot-names))
 
 (define (simple-obj-getter class slot)  
+  (issue-deprecation-warning "simple-obj-getter is deprecated. use record-accessor.")
   (record-accessor class slot))
 
 (define (simple-obj-setter class slot)
+  (issue-deprecation-warning "simple-obj-setter is deprecated. use record-modifier.")
   (record-modifier class slot))
 
 (define (simple-obj-print obj)
+  (issue-deprecation-warning "simple-obj-print is deprecated. use write.")
   (write obj))
 
 (define (simple-obj-to-list obj)
+  (issue-deprecation-warning "simple-obj-to-list is deprecated. use record-type->list in qif-guess-map.scm")
   (let ((retval '()))
     (for-each 
      (lambda (slot)
@@ -62,6 +66,7 @@
     (reverse retval)))
 
 (define (simple-obj-from-list list type)
+  (issue-deprecation-warning "simple-obj-from-list-obj is deprecated. use list->record-type in qif-guess-map.scm")
   (let ((retval (make-simple-obj type)))
     (for-each 
      (lambda (slot)
@@ -73,6 +78,7 @@
 
 
 (define (make-simple-obj class)
+  (issue-deprecation-warning "make-simple-obj is deprecated. use construct in qif-objects.scm")
   (let ((ctor (record-constructor class))
         (field-defaults 
          (map (lambda (v) #f) (record-type-fields class))))



Summary of changes:
 gnucash/import-export/qif-imp/qif-file.scm      |   2 +-
 gnucash/import-export/qif-imp/qif-guess-map.scm |  12 +-
 gnucash/import-export/qif-imp/qif-objects.scm   | 269 ++++++++++++------------
 gnucash/import-export/qif-imp/qif-parse.scm     |  19 +-
 gnucash/import-export/qif-imp/qif-utils.scm     |  74 ++-----
 libgnucash/app-utils/app-utils.scm              |  18 +-
 libgnucash/app-utils/simple-obj.scm             |   8 +-
 7 files changed, 189 insertions(+), 213 deletions(-)



More information about the gnucash-changes mailing list