From 28406b9a763d31ae976df5eb152c2de3095e3304 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 8 Mar 2016 09:29:03 -0600
Subject: [PATCH] remove the restriction that new preferences can be registered
only before a snapshot is grabbed
also improve the docs a little bit and some Rackety
---
gui-lib/framework/preferences.rkt | 26 ++++---
gui-lib/framework/private/preferences.rkt | 87 ++++++++++++-----------
gui-lib/info.rkt | 4 +-
3 files changed, 63 insertions(+), 54 deletions(-)
diff --git a/gui-lib/framework/preferences.rkt b/gui-lib/framework/preferences.rkt
index 5d50e3bc..32c1e762 100644
--- a/gui-lib/framework/preferences.rkt
+++ b/gui-lib/framework/preferences.rkt
@@ -58,8 +58,7 @@ the state transitions / contracts are:
(define (pref-un/marshall-set? pref) (hash-has-key? marshall-unmarshall pref))
(define (preferences:default-set? pref) (hash-has-key? defaults pref))
(define (pref-can-init? pref)
- (and (not snapshot-grabbed?)
- (not (hash-has-key? preferences pref))))
+ (not (hash-has-key? preferences pref)))
;; type un/marshall = (make-un/marshall (any -> prinable) (printable -> any))
(define-struct un/marshall (marshall unmarshall))
@@ -343,9 +342,7 @@ the state transitions / contracts are:
value))))
(define-struct preferences:snapshot (x))
-(define snapshot-grabbed? #f)
(define (preferences:get-prefs-snapshot)
- (set! snapshot-grabbed? #t)
(make-preferences:snapshot
(hash-map defaults
(λ (k v) (cons k (copy-pref-value k (preferences:get k)))))))
@@ -374,12 +371,12 @@ the state transitions / contracts are:
(symbol value)
@{Sets the preference
@racket[symbol] to @racket[value]. It should be called when the
- users requests a change to a preference.
+ user requests a change to a preference.
@racket[preferences:set] immediately writes the preference value to disk.
It raises an exception matching
@racket[exn:unknown-preference?]
- if the preference's default has not been set.
+ if the preference's default has not been set
See also @racket[preferences:set-default].})
@@ -419,7 +416,8 @@ the state transitions / contracts are:
This function raises an exception matching
@racket[exn:unknown-preference?]
- if the preference has not been set.})
+ if the preference default has not been set via
+ @racket[preferences:set-default].})
(proc-doc/names
preferences:set-default
(->* (symbol? any/c (any/c . -> . any))
@@ -437,6 +435,8 @@ the state transitions / contracts are:
This sets the default value of the preference @racket[symbol] to
@racket[value]. If the user has chosen a different setting,
+ (reflected via a call to @racket[preferences:set], possibly
+ in a different run of your program),
the user's setting will take precedence over the default value.
The @racket[test] argument is used as a safeguard. That function is
@@ -450,7 +450,11 @@ the state transitions / contracts are:
expected to be a list of symbols that correspond to old versions
of the preferences. It defaults to @racket['()]. If @racket[rewrite-aliases]
is present, it is used to adjust the old values of the preferences
- when they are present in the saved file.})
+ when they are present in the saved file.
+
+ @history[#:changed "1.23" @list{Allow @racket[preferences:set-default]
+ to be called even after a snapshot has been grabbed.}]
+ })
(proc-doc/names
preferences:default-set?
@@ -566,7 +570,9 @@ the state transitions / contracts are:
preferences:restore-prefs-snapshot
(-> preferences:snapshot? void?)
(snapshot)
- @{Restores the preferences saved in @racket[snapshot].
+ @{Restores the preferences saved in @racket[snapshot], updating
+ all of the preferences values to the ones they had at the time
+ that @racket[preferences:get-prefs-snapshot] was called.
See also @racket[preferences:get-prefs-snapshot].})
@@ -574,7 +580,7 @@ the state transitions / contracts are:
preferences:get-prefs-snapshot
(-> preferences:snapshot?)
()
- @{Caches all of the current values of the preferences and returns them.
+ @{Caches all of the current values of the known preferences and returns them.
For any preference that has marshalling and unmarshalling set
(see @racket[preferences:set-un/marshall]), the preference value is
copied by passing it through the marshalling and unmarshalling process.
diff --git a/gui-lib/framework/private/preferences.rkt b/gui-lib/framework/private/preferences.rkt
index 7ea6e2fb..0eadf7f8 100644
--- a/gui-lib/framework/private/preferences.rkt
+++ b/gui-lib/framework/private/preferences.rkt
@@ -502,52 +502,55 @@ the state transitions / contracts are:
'framework:line-spacing-add-gap?
(string-constant add-spacing-between-lines))
- (let ([hp (new horizontal-panel% [parent editor-panel] [stretchable-height #f])]
- [init-pref (preferences:get 'framework:column-guide-width)])
- (define on-cb
- (new check-box%
- [parent hp]
- [label (string-constant maximum-char-width-guide-pref-check-box)]
- [value (car init-pref)]
- [callback
- (λ (x y)
- (update-pref)
- (update-tf-bkg)
- (send tf enable (send on-cb get-value)))]))
- (define tf
- (new text-field%
- [label #f]
- [parent hp]
- [init-value (format "~a" (cadr init-pref))]
- [callback
- (λ (x y)
- (update-pref)
- (update-tf-bkg))]))
- (define (update-tf-bkg)
- (send tf set-field-background
- (send the-color-database find-color
- (cond
- [(not (send on-cb get-value)) "gray"]
- [(good-val? (string->number (send tf get-value)))
- "white"]
- [else
- "yellow"]))))
- (define (good-val? n)
- (and (exact-integer? n)
- (>= n 2)))
- (define (update-pref)
- (define current (preferences:get 'framework:column-guide-width))
- (define candidate-num (string->number (send tf get-value)))
- (preferences:set 'framework:column-guide-width
- (list (send on-cb get-value)
- (if (good-val? candidate-num)
- candidate-num
- (cadr current)))))
- (update-tf-bkg))
+ (add-number editor-panel
+ 'framework:column-guide-width
+ (string-constant maximum-char-width-guide-pref-check-box)
+ (λ (n) (and (exact-integer? n) (>= n 2))))
(editor-panel-procs editor-panel))))])
(add-editor-checkbox-panel)))
+(define (add-number editor-panel pref-name label good-val?)
+ (define hp (new horizontal-panel% [parent editor-panel] [stretchable-height #f]))
+ (define init-pref (preferences:get pref-name))
+ (define on-cb
+ (new check-box%
+ [parent hp]
+ [label label]
+ [value (car init-pref)]
+ [callback
+ (λ (x y)
+ (update-pref)
+ (update-tf-bkg)
+ (send tf enable (send on-cb get-value)))]))
+ (define tf
+ (new text-field%
+ [label #f]
+ [parent hp]
+ [init-value (format "~a" (cadr init-pref))]
+ [callback
+ (λ (x y)
+ (update-pref)
+ (update-tf-bkg))]))
+ (define (update-tf-bkg)
+ (send tf set-field-background
+ (send the-color-database find-color
+ (cond
+ [(not (send on-cb get-value)) "gray"]
+ [(good-val? (string->number (send tf get-value)))
+ "white"]
+ [else
+ "yellow"]))))
+ (define (update-pref)
+ (define current (preferences:get pref-name))
+ (define candidate-num (string->number (send tf get-value)))
+ (preferences:set pref-name
+ (list (send on-cb get-value)
+ (if (good-val? candidate-num)
+ candidate-num
+ (cadr current)))))
+ (update-tf-bkg))
+
(define (add-general-checkbox-panel) (add-general-checkbox-panel/real))
(define (add-general-checkbox-panel/real)
(set! add-general-checkbox-panel/real void)
diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt
index 408a2501..9eda0148 100644
--- a/gui-lib/info.rkt
+++ b/gui-lib/info.rkt
@@ -12,7 +12,7 @@
"pict-lib"
"scheme-lib"
"scribble-lib"
- "string-constants-lib"
+ ["string-constants-lib" #:version "1.7"]
"option-contract-lib"
"2d-lib"
"compatibility-lib"
@@ -30,4 +30,4 @@
(define pkg-authors '(mflatt robby))
-(define version "1.22")
+(define version "1.23")