Skip to content

Commit

Permalink
* options.scm: change gnc:make-option; add two new args, scm->kvp
Browse files Browse the repository at this point in the history 
	  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
  • Loading branch information
@derekatkins
derekatkins committed Jul 7, 2002
1 parent 9bd373a commit d461f68
Show file tree
Hide file tree
Showing 4 changed files with 201 additions and 6 deletions.
8 changes: 8 additions & 0 deletions ChangeLog
View file
@@ -1,3 +1,11 @@
2002-07-07 Derek Atkins <derek@ihtfp.com>

* 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 <derek@ihtfp.com>

* gw-kvp-spec.scm: wrap kvp_slot_set_slot_path_gslist(),
Expand Down
4 changes: 4 additions & 0 deletions src/app-utils/app-utils.scm
View file
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
170 changes: 164 additions & 6 deletions src/app-utils/options.scm
View file
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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-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 10))
(vector-ref option 12))
(define (gnc:option-data-fns option)
(vector-ref option 11))
(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)))
Expand Down Expand Up @@ -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"))))
Expand All @@ -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"))))
Expand Down Expand Up @@ -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"))))
Expand Down Expand Up @@ -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)))

Expand Down Expand Up @@ -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)))

Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)))

Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand All @@ -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)))

Expand All @@ -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)))

Expand Down Expand Up @@ -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)))
Expand Down Expand Up @@ -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)))
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)))

Expand Down

0 comments on commit d461f68

Please sign in to comment.