From d461f68d6f93659172b509e46f8e68321e42ffb4 Mon Sep 17 00:00:00 2001 From: Derek Atkins Date: Sun, 7 Jul 2002 20:52:40 +0000 Subject: [PATCH] * options.scm: change gnc:make-option; add two new args, scm->kvp and kvp->scp. Implement these two methods for most of the options. * app-utils.scm: export the kvp->scm and scm->kvp procedures * business-options.scm: Implement the kvp->scm and scm->kvp methods for the business options. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7094 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 8 + src/app-utils/app-utils.scm | 4 + src/app-utils/options.scm | 172 +++++++++++++++++- .../business-gnome/business-options.scm | 25 +++ 4 files changed, 202 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0786c7c87b..e96d92298e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2002-07-07 Derek Atkins + + * options.scm: change gnc:make-option; add two new args, scm->kvp + and kvp->scp. Implement these two methods for most of the options. + * app-utils.scm: export the kvp->scm and scm->kvp procedures + * business-options.scm: Implement the kvp->scm and scm->kvp methods + for the business options. + 2002-07-06 Derek Atkins * gw-kvp-spec.scm: wrap kvp_slot_set_slot_path_gslist(), diff --git a/src/app-utils/app-utils.scm b/src/app-utils/app-utils.scm index f82addd49b..a71f1feb3d 100644 --- a/src/app-utils/app-utils.scm +++ b/src/app-utils/app-utils.scm @@ -25,6 +25,8 @@ (export gnc:option-setter) (export gnc:option-default-getter) (export gnc:option-generate-restore-form) +(export gnc:option-scm->kvp) +(export gnc:option-kvp->scm) (export gnc:option-value-validator) (export gnc:option-data) (export gnc:option-data-fns) @@ -85,6 +87,8 @@ (export gnc:options-for-each-general) (export gnc:lookup-option) (export gnc:generate-restore-forms) +(export gnc:options-scm->kvp) +(export gnc:options-kvp->scm) (export gnc:options-clear-changes) (export gnc:options-touch) (export gnc:options-run-callbacks) diff --git a/src/app-utils/options.scm b/src/app-utils/options.scm index 1693f2db2c..2f09c4a95f 100644 --- a/src/app-utils/options.scm +++ b/src/app-utils/options.scm @@ -35,6 +35,11 @@ ;; option. The function should restore the option to the original ;; value. generate-restore-form + ;; the scm->kvp and kvp->scm functions should save and load + ;; the option to a kvp. The arguments to these function will be + ;; a kvp-frame and a base key-path list for this option. + scm->kvp + kvp->scm ;; Validation func should accept a value and return (#t value) ;; on success, and (#f "failure-message") on failure. If #t, ;; the supplied value will be used by the gui to set the option. @@ -82,6 +87,8 @@ (if changed-callback (changed-callback))) default-getter generate-restore-form + scm->kvp + kvp->scm value-validator option-data option-data-fns @@ -107,20 +114,24 @@ (vector-ref option 7)) (define (gnc:option-generate-restore-form option) (vector-ref option 8)) -(define (gnc:option-value-validator option) +(define (gnc:option-scm->kvp option) (vector-ref option 9)) -(define (gnc:option-data option) - (vector-ref option 10)) -(define (gnc:option-data-fns option) +(define (gnc:option-kvp->scm option) + (vector-ref option 10)) +(define (gnc:option-value-validator option) (vector-ref option 11)) +(define (gnc:option-data option) + (vector-ref option 12)) +(define (gnc:option-data-fns option) + (vector-ref option 13)) (define (gnc:option-set-changed-callback option callback) - (let ((cb-setter (vector-ref option 12))) + (let ((cb-setter (vector-ref option 14))) (cb-setter callback))) (define (gnc:option-strings-getter option) - (vector-ref option 13)) + (vector-ref option 15)) (define (gnc:option-widget-changed-proc option) - (vector-ref option 14)) + (vector-ref option 16)) (define (gnc:option-value option) (let ((getter (gnc:option-getter option))) @@ -185,6 +196,11 @@ (lambda (x) (set! value x)) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value v)))) (lambda (x) (cond ((string? x)(list #t x)) (else (list #f "string-option: not a string")))) @@ -204,6 +220,11 @@ (lambda (x) (set! value x)) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value v)))) (lambda (x) (cond ((string? x)(list #t x)) (else (list #f "text-option: not a string")))) @@ -233,6 +254,11 @@ (lambda (x) (set! value x)) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value v)))) (lambda (x) (cond ((string? x)(list #t x)) (else (list #f "font-option: not a string")))) @@ -267,6 +293,11 @@ (lambda (x) (set! value (currency->scm x))) (lambda () (scm->currency default-value)) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value v)))) (lambda (x) (list #t x)) #f #f #f #f))) @@ -304,6 +335,14 @@ (set! value (commodity->scm x)))) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) + (gnc:kvp-frame-set-slot-path f (cadr value) (append p '("ns"))) + (gnc:kvp-frame-set-slot-path f (caddr value) (append p '("monic")))) + (lambda (f p) + (let ((ns (gnc:kvp-frame-get-slot-path f (append p '("ns")))) + (monic (gnc:kvp-frame-get-slot-path f (append p '("monic"))))) + (if (and ns monic (string? ns) (string? monic)) + (set! value (list 'commodity-scm ns monic))))) (lambda (x) (list #t x)) #f #f #f #f))) @@ -355,6 +394,11 @@ (setter-function-called-cb x))) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (boolean? v) (not (equal? v default-value))) + (set! value v)))) (lambda (x) (if (boolean? x) (list #t x) @@ -373,6 +417,8 @@ (lambda (x) (set! value x)) (lambda () default-value) (gnc:restore-form-generator (lambda () (gnc:value->string value))) + #f + #f (lambda (x) (if (string? x) (begin @@ -419,6 +465,20 @@ (gnc:error "Illegal date value set:" date))) default-getter (gnc:restore-form-generator value->string) + (lambda (f p) + (gnc:kvp-frame-set-slot-path f (symbol->string (car value)) + (append p '("type"))) + (gnc:kvp-frame-set-slot-path f + (if (symbol? (cdr value)) + (symbol->string (cdr value)) + (cdr value)) + (append p '("value")))) + (lambda (f p) + (let ((t (gnc:kvp-frame-get-slot-path f (append p '("type")))) + (v (gnc:kvp-frame-get-slot-path f (append p '("value"))))) + (if (and t v (string? t)) + (set! value (cons (string->symbol t) + (if (string? v) (string->symbol v) v)))))) (lambda (date) (if (date-legal date) (list #t date) @@ -542,6 +602,32 @@ (gnc:error "Illegal account list value set")))) (lambda () (map convert-to-account (default-getter))) (gnc:restore-form-generator value->string) + (lambda (f p) + (define (save-acc list count) + (if (not (null? list)) + (let ((key (string-append "acc" (gnc:value->string count)))) + (gnc:kvp-frame-set-slot-path f (car list) (append p (list key))) + (save-acc (cdr list) (+ 1 count))))) + + (if option-set + (begin + (gnc:kvp-frame-set-slot-path f (length option) + (append p '("len"))) + (save-acc option 0)))) + (lambda (f p) + (let ((len (gnc:kvp-frame-get-slot-path f (append p '("len"))))) + (define (load-acc count) + (if (< count len) + (let* ((key (string-append "acc" (gnc:value->string count))) + (guid (gnc:kvp-frame-get-slot-path + f (append p (list key))))) + (cons guid (load-acc (+ count 1)))) + '())) + + (if (and len (integer? len)) + (begin + (set! option (load-acc 0)) + (set! option-set #t))))) validator (cons multiple-selection acct-type-list) #f #f #f))) @@ -616,6 +702,11 @@ (gnc:error "Illegal Multichoice option set"))) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f (symbol->string value) p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value (string->symbol v))))) (lambda (x) (if (multichoice-legal x ok-values) (list #t x) @@ -697,6 +788,11 @@ (gnc:error "Illegal Radiobutton option set"))) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f (symbol->string value) p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value (string->symbol v))))) (lambda (x) (if (radiobutton-legal x ok-values) (list #t x) @@ -754,6 +850,26 @@ (gnc:error "Illegal list option set"))) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) + (define (save-item list count) + (if (not (null? list)) + (let ((key (string-append "item" (gnc:value->string count)))) + (gnc:kvp-frame-set-slot-path f (car list) (append p (list key))) + (save-item (cdr list) (+ 1 count))))) + (gnc:kvp-frame-set-slot-path f (length value) (append p '("len"))) + (save-item value 0)) + (lambda (f p) + (let ((len (gnc:kvp-frame-get-slot-path f (append p '("len"))))) + (define (load-item count) + (if (< count len) + (let* ((key (string-append "item" (gnc:value->string count))) + (val (gnc:kvp-frame-get-slot-path + f (append p (list key))))) + (cons val (load-item (+ count 1)))) + '())) + + (if (and len (integer? len)) + (set! value (load-item 0))))) (lambda (x) (if (list-legal x) (list #t x) @@ -786,6 +902,11 @@ (lambda (x) (set! value x)) (lambda () default-value) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f (symbol->string value) p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (number? v)) + (set! value v)))) (lambda (x) (cond ((not (number? x)) (list #f "number-range-option: not a number")) ((and (>= value lower-bound) @@ -808,6 +929,8 @@ (lambda (x) (set! value x)) (lambda () default-value) (gnc:restore-form-generator value->string) + #f + #f (lambda (x) (list #t x)) #f #f #f #f))) @@ -829,6 +952,8 @@ default-value (gnc:query->scm default-value))) (gnc:restore-form-generator value->string) + #f + #f (lambda (x) (list #t x)) #f #f #f #f))) @@ -875,6 +1000,8 @@ (lambda (x) (set! value (canonicalize x))) (lambda () (canonicalize default-value)) (gnc:restore-form-generator value->string) + #f + #f validate-color (list range use-alpha) #f #f #f))) @@ -1005,6 +1132,29 @@ (call-with-output-string generate-forms)) + (define (scm->kvp kvp-frame key-path) + (options-for-each + (lambda (option) + (let ((value (gnc:option-value option)) + (default-value (gnc:option-default-value option))) + (if (not (equal? value default-value)) + (let ((section (gnc:option-section option)) + (name (gnc:option-name option)) + (save-fcn (gnc:option-scm->kvp option))) + (if save-fcn + (save-fcn kvp-frame (append key-path + (list section name)))))))))) + + (define (kvp->scm kvp-frame key-path) + (options-for-each + (lambda (option) + (let ((section (gnc:option-section option)) + (name (gnc:option-name option)) + (load-fcn (gnc:option-kvp->scm option))) + (if load-fcn + (load-fcn kcp-frame (append key-path + (list section name)))))))) + (define (register-callback section name callback) (let ((id last-callback-id) (data (list section name callback))) @@ -1065,6 +1215,8 @@ ((for-each) options-for-each) ((for-each-general) options-for-each-general) ((generate-restore-forms) generate-restore-forms) + ((scm->kvp) scm->kvp) + ((kvp->scm) kvp->scm) ((touch) touch) ((clear-changes) clear-changes) ((run-callbacks) run-callbacks) @@ -1099,6 +1251,12 @@ (define (gnc:generate-restore-forms options options-string) ((options 'generate-restore-forms) options-string)) +(define (gnc:options-scm->kvp options kvp-frame key-path) + ((options 'scm->kvp) kvp-frame key-path)) + +(define (gnc:options-kvp->scm options kvp-frame key-path) + ((options 'kvp->scm) kvp-frame key-path)) + (define (gnc:options-clear-changes options) ((options 'clear-changes))) diff --git a/src/business/business-gnome/business-options.scm b/src/business/business-gnome/business-options.scm index d88cea537b..02b8b24868 100644 --- a/src/business/business-gnome/business-options.scm +++ b/src/business/business-gnome/business-options.scm @@ -71,6 +71,11 @@ (gnc:error "Illegal invoice value set")))) (lambda () (convert-to-invoice (default-getter))) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value v)))) validator #f #f #f #f))) @@ -125,6 +130,11 @@ (gnc:error "Illegal customer value set")))) (lambda () (convert-to-customer (default-getter))) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value v)))) validator #f #f #f #f))) @@ -179,6 +189,11 @@ (gnc:error "Illegal vendor value set")))) (lambda () (convert-to-vendor (default-getter))) (gnc:restore-form-generator value->string) + (lambda (f p) (gnc:kvp-frame-set-slot-path f value p)) + (lambda (f p) + (let ((v (gnc:kvp-frame-get-slot-path f p))) + (if (and v (string? v)) + (set! value v)))) validator #f #f #f #f))) @@ -267,6 +282,16 @@ (gnc:error "Illegal owner value set")))) (lambda () (convert-to-owner (default-getter))) (gnc:restore-form-generator value->string) + (lambda (f p) + (gnc:kvp-frame-set-slot-path f (symbol->string (car value)) + (append p '("type"))) + (gnc:kvp-frame-set-slot-path f (cdr value) + (append p '("value")))) + (lambda (f p) + (let ((t (gnc:kvp-frame-get-slot-path f (append p '("type")))) + (v (gnc:kvp-frame-get-slot-path f (append p '("value"))))) + (if (and t v (string? t) (string? v)) + (set! value (cons (string->symbol t) v))))) validator owner-type #f #f #f))))