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")