diff --git a/collects/framework/preferences.rkt b/collects/framework/preferences.rkt index 1a6d83a0..dbec9584 100644 --- a/collects/framework/preferences.rkt +++ b/collects/framework/preferences.rkt @@ -70,8 +70,8 @@ the state transitions / contracts are: ;; type pref = (make-pref any) (define-struct pref (value)) -;; type default = (make-default any (any -> bool)) -(define-struct default (value checker)) +;; type default = (make-default any (-> any bool) (listof symbol) (listof (-> any any))) +(define-struct default (value checker aliases rewrite-aliases)) ;; pref-callback : (make-pref-callback (union (weak-box (sym tst -> void)) (sym tst -> void))) ;; this is used as a wrapped to deal with the problem that different procedures might be eq?. @@ -93,8 +93,7 @@ the state transitions / contracts are: ;; it's not there, use the default [(pref-default-set? p) (let* (;; try to read the preferece from the preferences file - [v ((preferences:low-level-get-preference) - (add-pref-prefix p) (λ () none))] + [v (read-pref-from-file p)] [v (if (eq? v none) ;; no value read, take the default value (default-value (hash-ref defaults p)) @@ -109,6 +108,22 @@ the state transitions / contracts are: "tried to get a preference but no default set for ~e" p)])) +;; read-pref-from-file : symbol -> (or/c any none) +;; reads the preference saved in the low-level preferences +;; file, first checking 'p' and then checking the aliases (in order) +(define (read-pref-from-file p) + (let ([defaults (hash-ref defaults p)]) + (let loop ([syms (cons p (default-aliases defaults))] + [rewriters (cons values (default-rewrite-aliases defaults))]) + (cond + [(null? syms) none] + [else + (let/ec k + ((car rewriters) + ((preferences:low-level-get-preference) + (add-pref-prefix (car syms)) + (lambda () (k (loop (cdr syms) (cdr rewriters)))))))])))) + ;; set : symbol any -> void ;; updates the preference ;; exported @@ -221,15 +236,22 @@ the state transitions / contracts are: (λ (p def) (preferences:set p (default-value def))))) ;; set-default : (sym TST (TST -> boolean) -> void -(define (preferences:set-default p default-value checker) +(define (preferences:set-default p default-value checker + #:aliases [aliases '()] + #:rewrite-aliases [rewrite-aliases (map (lambda (x) values) aliases)]) (cond [(and (not (pref-default-set? p)) (pref-can-init? p)) (let ([default-okay? (checker default-value)]) (unless default-okay? (error 'set-default "~s: checker (~s) returns ~s for ~s, expected #t~n" - p checker default-okay? default-value)) - (hash-set! defaults p (make-default default-value checker)))] + p checker default-okay? default-value))) + + (unless (= (length aliases) (length rewrite-aliases)) + (error 'preferences:set-default + "expected equal length lists for the #:aliases and #:rewrite-aliases arguments, got ~e and ~e" + aliases rewrite-aliases)) + (hash-set! defaults p (make-default default-value checker aliases rewrite-aliases))] [(not (pref-can-init? p)) (error 'preferences:set-default "tried to call set-default for preference ~e but it cannot be configured any more" @@ -351,8 +373,12 @@ the state transitions / contracts are: if the preference has not been set.}) (proc-doc/names preferences:set-default - (symbol? any/c (any/c . -> . any) . -> . void?) - (symbol value test) + (->* (symbol? any/c (any/c . -> . any)) + (#:aliases (listof symbol?) + #:rewrite-aliases (listof (-> any/c any))) + void?) + ((symbol value test) + ((aliases '()) (rewrite-aliases (map (lambda (x) (values)) aliases)))) @{This function must be called every time your application starts up, before any call to @scheme[preferences:get] or @scheme[preferences:set] (for any given preference). @@ -364,11 +390,19 @@ the state transitions / contracts are: @scheme[value]. If the user has chosen a different setting, the user's setting will take precedence over the default value. - The last argument, @scheme[test] is used as a safeguard. That function is + The @scheme[test] argument is used as a safeguard. That function is called to determine if a preference read in from a file is a valid preference. If @scheme[test] returns @scheme[#t], then the preference is treated as valid. If @scheme[test] returns @scheme[#f] then the default is - used.}) + used. + + The @scheme[aliases] and @scheme[rewrite-aliases] arguments aids + in renaming preferences. If @scheme[aliases] is present, it is + expected to be a list of symbols that correspond to old versions + of the preferences. It defaults to @scheme['()]. If @scheme[rewrite-aliases] + is present, it is used to adjust the old values of the preferences + when they are present in the saved file.}) + (proc-doc/names preferences:set-un/marshall (symbol? (any/c . -> . printable/c) (printable/c . -> . any/c) . -> . void?) diff --git a/collects/framework/private/frame.rkt b/collects/framework/private/frame.rkt index d5ea51f8..8b1ec3bf 100644 --- a/collects/framework/private/frame.rkt +++ b/collects/framework/private/frame.rkt @@ -2061,8 +2061,10 @@ (unless hidden? (when find-edit (when old - (send old set-searching-state #f #f #f)) + (send old set-searching-state #f #f #f) + (send old set-search-anchor #f)) (when new + (send new set-search-anchor (send new get-start-position)) (search-parameters-changed))))))) (define/public-final (search-hits-changed) diff --git a/collects/tests/mred/auto.rktl b/collects/tests/mred/auto.rktl new file mode 100644 index 00000000..947989f7 --- /dev/null +++ b/collects/tests/mred/auto.rktl @@ -0,0 +1,5 @@ + +(load-relative "editor.rktl") +(load-relative "paramz.rktl") +(load-relative "dc.rktl") +(load-relative "windowing.rktl") diff --git a/collects/tests/mred/dc.rkt b/collects/tests/mred/dc.rktl similarity index 99% rename from collects/tests/mred/dc.rkt rename to collects/tests/mred/dc.rktl index 217f14e3..2ce39dbe 100644 --- a/collects/tests/mred/dc.rkt +++ b/collects/tests/mred/dc.rktl @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rktl") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DC Tests ;; diff --git a/collects/tests/mred/editor.rkt b/collects/tests/mred/editor.rktl similarity index 99% rename from collects/tests/mred/editor.rkt rename to collects/tests/mred/editor.rktl index 1e235a0d..7c498d20 100644 --- a/collects/tests/mred/editor.rkt +++ b/collects/tests/mred/editor.rktl @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rktl") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Editor Tests ;; diff --git a/collects/tests/mred/loadtest.rkt b/collects/tests/mred/loadtest.rktl similarity index 75% rename from collects/tests/mred/loadtest.rkt rename to collects/tests/mred/loadtest.rktl index d6014052..698e61e0 100644 --- a/collects/tests/mred/loadtest.rkt +++ b/collects/tests/mred/loadtest.rktl @@ -2,4 +2,4 @@ (unless (with-handlers ([exn:fail? (lambda (x) #f)]) (namespace-variable-binding 'SECTION) #t) - (load-relative "testing.ss")) + (load-relative "testing.rktl")) diff --git a/collects/tests/mred/mem.rkt b/collects/tests/mred/mem.rktl similarity index 100% rename from collects/tests/mred/mem.rkt rename to collects/tests/mred/mem.rktl diff --git a/collects/tests/mred/paramz.rkt b/collects/tests/mred/paramz.rktl similarity index 98% rename from collects/tests/mred/paramz.rkt rename to collects/tests/mred/paramz.rktl index a74786bf..02f362f3 100644 --- a/collects/tests/mred/paramz.rkt +++ b/collects/tests/mred/paramz.rktl @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rktl") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Yield Tests ;; diff --git a/collects/tests/mred/png.rkt b/collects/tests/mred/png.rktl similarity index 100% rename from collects/tests/mred/png.rkt rename to collects/tests/mred/png.rktl diff --git a/collects/tests/mred/testing.rkt b/collects/tests/mred/testing.rktl similarity index 100% rename from collects/tests/mred/testing.rkt rename to collects/tests/mred/testing.rktl diff --git a/collects/tests/mred/windowing.rkt b/collects/tests/mred/windowing.rktl similarity index 99% rename from collects/tests/mred/windowing.rkt rename to collects/tests/mred/windowing.rktl index 6cb61eeb..7ba37601 100644 --- a/collects/tests/mred/windowing.rkt +++ b/collects/tests/mred/windowing.rktl @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rktl") (define shorter? #t) diff --git a/collects/tests/racket/cache-image-snip-test.rkt b/collects/tests/racket/cache-image-snip-test.rktl similarity index 99% rename from collects/tests/racket/cache-image-snip-test.rkt rename to collects/tests/racket/cache-image-snip-test.rktl index 88606410..0bfa98b6 100644 --- a/collects/tests/racket/cache-image-snip-test.rkt +++ b/collects/tests/racket/cache-image-snip-test.rktl @@ -1,4 +1,4 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rktl") (require mrlib/cache-image-snip mzlib/unit)