From 98822cf1f989efd7c22f5d9587a65aeee29f26c0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 18 Jan 2011 17:23:28 -0700 Subject: [PATCH] adjust `racket/gui' and dependencies to survive a locked preference file - adds a `#:timeout-lock-there' argument to `get-preference' - fixes preference looup in `racket/gui' - make preference names consistently use `GRacket' and consistently fall back on `MrEd' names - fix Emacs-style undo mode while we're at it --- collects/mred/private/const.rkt | 7 ++--- collects/mred/private/misc.rkt | 5 ++-- collects/mred/private/path-dialog.rkt | 5 ++-- collects/mred/private/wxlitem.rkt | 3 +- collects/mred/private/wxme/editor-canvas.rkt | 3 +- collects/mred/private/wxme/editor.rkt | 9 +++--- collects/mred/private/wxme/text.rkt | 3 +- collects/mred/private/wxme/undo.rkt | 14 +++++----- collects/racket/file.rkt | 4 ++- collects/racket/snip/private/prefs.rkt | 28 +++++++++++++++++++ collects/racket/snip/private/style.rkt | 5 ++-- collects/scribblings/draw/blurbs.rkt | 9 ------ collects/scribblings/gui/blurbs.rkt | 10 +++++-- collects/scribblings/gui/prefs.scrbl | 25 +++++++++++------ .../scribblings/reference/filesystem.scrbl | 15 ++++++---- 15 files changed, 95 insertions(+), 50 deletions(-) create mode 100644 collects/racket/snip/private/prefs.rkt diff --git a/collects/mred/private/const.rkt b/collects/mred/private/const.rkt index d341e73072..85f68a167f 100644 --- a/collects/mred/private/const.rkt +++ b/collects/mred/private/const.rkt @@ -1,6 +1,7 @@ (module const mzscheme (require mzlib/class mzlib/file + racket/snip/private/prefs (prefix wx: "kernel.ss")) (provide (protect (all-defined))) @@ -38,11 +39,9 @@ (define arrow-cursor (make-object wx:cursor% 'arrow)) (define default-x-prefix (if (eq? 'unix (system-type)) - (let ([v (get-preference + (let ([v (get-preference* '|GRacket:defaultMenuPrefix| - ;; on fail, fall back to old name of pref: - (lambda () (get-preference '|MrEd:defaultMenuPrefix| - (lambda () 'ctl))))]) + (lambda () 'ctl))]) (if (memq v '(meta ctl alt ctl-m)) v 'ctl)) diff --git a/collects/mred/private/misc.rkt b/collects/mred/private/misc.rkt index 5c4ac6332b..0df2060609 100644 --- a/collects/mred/private/misc.rkt +++ b/collects/mred/private/misc.rkt @@ -2,7 +2,8 @@ (require mzlib/class mzlib/file mzlib/process - (prefix wx: "kernel.ss")) + (prefix wx: "kernel.ss") + racket/snip/private/prefs) (provide file-creator-and-type hide-cursor-until-moved @@ -63,7 +64,7 @@ (delay (let* (;; check user-set preference first ;; (can be a string with `~a', or a name of an executable) - [cmd (get-preference '|MrEd:playcmd| (lambda () #f))] + [cmd (get-preference* '|GRacket:playcmd| (lambda () #f))] [cmd (cond [(not (string? cmd)) #f] [(regexp-match? #rx"~[aA]" cmd) cmd] [(find-executable-path cmd) => values] diff --git a/collects/mred/private/path-dialog.rkt b/collects/mred/private/path-dialog.rkt index 219919606d..d5250287d0 100644 --- a/collects/mred/private/path-dialog.rkt +++ b/collects/mred/private/path-dialog.rkt @@ -2,6 +2,7 @@ (require mzlib/class mzlib/list mzlib/string mzlib/file (prefix wx: "kernel.ss") (prefix wx: racket/snip) + racket/snip/private/prefs "helper.ss" "mrtop.ss" "mritem.ss" "mrpanel.ss" "mrtextfield.ss" "messagebox.ss" "mrmenu.ss" (only scheme/base compose)) (provide path-dialog%) @@ -199,7 +200,7 @@ (if put? "Save File" "Open File")))) (define size - (let ([s (get-preference 'mred:path-dialog:size (lambda () #f))]) + (let ([s (get-preference* 'mred:path-dialog:size (lambda () #f))]) (or (and (list? s) (= 2 (length s)) (andmap integer? s) s) '(300 300)))) @@ -521,7 +522,7 @@ (let ([new (list width height)]) (unless (equal? new size) (set! size new) - (put-preferences '(mred:path-dialog:size) (list size))))) + (put-preferences* '(mred:path-dialog:size) (list size))))) ;;----------------------------------------------------------------------- ;; Delayed Filename Completion diff --git a/collects/mred/private/wxlitem.rkt b/collects/mred/private/wxlitem.rkt index 9b14bcac54..0dbad4c0de 100644 --- a/collects/mred/private/wxlitem.rkt +++ b/collects/mred/private/wxlitem.rkt @@ -3,6 +3,7 @@ mzlib/class100 mzlib/file (only racket/base remq) + racket/snip/private/prefs (prefix wx: "kernel.ss") "lock.ss" "helper.ss" @@ -126,7 +127,7 @@ (private [scroll (lambda (dir) (unless list-box-wheel-step - (set! list-box-wheel-step (get-preference '|MrEd:wheelStep| (lambda () 3))) + (set! list-box-wheel-step (get-preference* '|GRacket:wheelStep| (lambda () 3))) (unless (and (number? list-box-wheel-step) (exact? list-box-wheel-step) (integer? list-box-wheel-step) diff --git a/collects/mred/private/wxme/editor-canvas.rkt b/collects/mred/private/wxme/editor-canvas.rkt index 43bafcb4ed..a04a42389c 100644 --- a/collects/mred/private/wxme/editor-canvas.rkt +++ b/collects/mred/private/wxme/editor-canvas.rkt @@ -5,6 +5,7 @@ "editor.ss" "editor-admin.ss" "private.ss" + racket/snip/private/prefs racket/snip/private/private (only-in "cycle.ss" popup-menu%) (only-in "../helper.ss" queue-window-callback) @@ -131,7 +132,7 @@ ;; ---------------------------------------- (define default-wheel-amt - (let ([v (get-preference 'MrEd:wheelStep)]) + (let ([v (get-preference* 'GRacket:wheelStep)]) (if (exact-integer? v) (max 3 (min 1000 v)) 3))) diff --git a/collects/mred/private/wxme/editor.rkt b/collects/mred/private/wxme/editor.rkt index ef04aba583..63d4a4019e 100644 --- a/collects/mred/private/wxme/editor.rkt +++ b/collects/mred/private/wxme/editor.rkt @@ -9,6 +9,7 @@ racket/snip/private/private racket/snip/private/style racket/snip/private/snip-flags + racket/snip/private/prefs "editor-admin.ss" "stream.ss" "undo.ss" @@ -108,7 +109,7 @@ ;; ---------------------------------------- -(define emacs-style-undo? (and (get-preference 'MrEd:emacs-undo) #t)) +(define emacs-style-undo? (and (get-preference* 'GRacket:emacs-undo) #t)) (define (max-undo-value? v) (or (exact-nonnegative-integer? v) (eq? v 'forever))) @@ -863,7 +864,7 @@ (let loop ([e redochanges-end]) (unless (= redochanges-start e) (let ([e (modulo (+ e -1 redochanges-size) redochanges-size)]) - (append-undo (vector-ref redochanges (send (vector-ref redochanges e) inverse)) #f) + (append-undo (send (vector-ref redochanges e) inverse) #f) (loop e)))) (let loop () (unless (= redochanges-start redochanges-end) @@ -969,12 +970,12 @@ cnt (loop e (add1 cnt))))))]) (when (positive? cnt) - (let ([cu (new composite-record% [cnt cnt] [id id] [parity (not parity)])]) + (let ([cu (new composite-record% [count cnt] [id id] [parity? (not parity)])]) (for ([i (in-range cnt)]) (let ([e (modulo (+ (- end cnt) i size) size)]) (send cu add-undo i (vector-ref c e)) (vector-set! c e #f))) - (let ([e (modulo (+ (- end cnt) cnt size) size)]) + (let ([e (modulo (+ (- end cnt) size) size)]) (vector-set! c e cu) (set! redochanges-end (modulo (add1 e) size)))))))))))) diff --git a/collects/mred/private/wxme/text.rkt b/collects/mred/private/wxme/text.rkt index 67462c398e..d29faf081e 100644 --- a/collects/mred/private/wxme/text.rkt +++ b/collects/mred/private/wxme/text.rkt @@ -8,6 +8,7 @@ "mline.ss" "private.ss" racket/snip/private/private + racket/snip/private/prefs "editor.ss" "editor-data.rkt" "undo.ss" @@ -50,7 +51,7 @@ (define ZERO-LINE-WIDTH 0.1) (define show-outline-for-inactive? - (and (get-preference 'MrEd:outline-inactive-selection) #t)) + (and (get-preference* 'GRacket:outline-inactive-selection) #t)) (define caret-pen (send the-pen-list find-or-create-pen "BLACK" 1 'xor)) (define outline-pen (send the-pen-list find-or-create-pen "BLACK" 0 'transparent)) diff --git a/collects/mred/private/wxme/undo.rkt b/collects/mred/private/wxme/undo.rkt index f8c3625845..c266260af3 100644 --- a/collects/mred/private/wxme/undo.rkt +++ b/collects/mred/private/wxme/undo.rkt @@ -246,10 +246,8 @@ (init count) (init-field id parity?) - (unless id - (set! id (if parity? - (cons this #f) - (cons #f this)))) + (unless id (set! id (mcons #f #f))) + ((if parity? set-mcar! set-mcdr!) id this) (define seq (make-vector count)) (super-new) @@ -259,7 +257,7 @@ (define/override (undo editor) (for ([c (in-vector seq)]) - (send c undo)) + (send c undo editor)) #f) (define/override (drop-set-unmodified) @@ -284,10 +282,12 @@ (init-field id parity?) + (super-new) + (define/private (get) (if parity? - (car id) - (cdr id))) + (mcar id) + (mcdr id))) (define/override (cancel) ;; Avoid double-frees by not doing anything diff --git a/collects/racket/file.rkt b/collects/racket/file.rkt index dc3c350c38..aa26740bb3 100644 --- a/collects/racket/file.rkt +++ b/collects/racket/file.rkt @@ -302,13 +302,15 @@ (define (get-preference name [fail-thunk (lambda () #f)] [refresh-cache? 'timestamp] [filename #f] + #:timeout-lock-there [timeout-lock-there #f] #:lock-there [lock-there (make-handle-get-preference-locked 0.01 name fail-thunk refresh-cache? - filename)] + filename + #:lock-there timeout-lock-there)] #:use-lock? [use-lock? #t]) (unless (symbol? name) (raise-type-error 'get-preference "symbol" name)) diff --git a/collects/racket/snip/private/prefs.rkt b/collects/racket/snip/private/prefs.rkt new file mode 100644 index 0000000000..a6e4cdd369 --- /dev/null +++ b/collects/racket/snip/private/prefs.rkt @@ -0,0 +1,28 @@ +#lang racket/base +(require racket/file) + +(provide get-preference* + put-preferences*) + +(define (old-name sym) + (string->symbol + (regexp-replace #rx"gracket" + (regexp-replace #rx"^GRacket" + (symbol->string sym) + "MrEd") + "mred"))) + +(define (get-preference* sym [fail-thunk (lambda () #f)]) + (get-preference + sym + ;; on fail, fall back to old name of pref: + (lambda () (get-preference (old-name sym) + fail-thunk + #:timeout-lock-there (lambda (fn) (fail-thunk)))) + #:timeout-lock-there (lambda (fn) (fail-thunk)))) + +(define (put-preferences* syms vals) + (put-preferences syms + vals + ;; Locked? Too bad. + (lambda (fn) (void)))) diff --git a/collects/racket/snip/private/style.rkt b/collects/racket/snip/private/style.rkt index ffe0f9d990..1b1e7dc463 100644 --- a/collects/racket/snip/private/style.rkt +++ b/collects/racket/snip/private/style.rkt @@ -5,7 +5,8 @@ racket/draw racket/draw/private/syntax racket/draw/private/font-syms - racket/snip/private/private) + racket/snip/private/private + "prefs.rkt") (provide mult-color<%> add-color<%> @@ -22,7 +23,7 @@ (define editor-stream-out% object%) (define default-size - (or (get-preference 'MrEd:default-font-size) + (or (get-preference* 'MrEd:default-font-size) (case (system-type) [(windows) 10] [else 12]))) diff --git a/collects/scribblings/draw/blurbs.rkt b/collects/scribblings/draw/blurbs.rkt index a3a91dab81..5ab77556fc 100644 --- a/collects/scribblings/draw/blurbs.rkt +++ b/collects/scribblings/draw/blurbs.rkt @@ -44,15 +44,6 @@ (define (res-sym s) (string->symbol (string-append "GRacket:" s))) - (define (Resource s) - @elem{@to-element[`(quote ,(res-sym s))] - preference}) - (define (ResourceFirst s) ; fixme -- add index - (let ([r (Resource s)]) - (index* (list (format "~a preference" (res-sym s))) - (list r) - r))) - (define (boxisfill which what) @elem{The @|which| box is filled with @|what|.}) (define (boxisfillnull which what) diff --git a/collects/scribblings/gui/blurbs.rkt b/collects/scribblings/gui/blurbs.rkt index 1ee2286921..eb97d645b8 100644 --- a/collects/scribblings/gui/blurbs.rkt +++ b/collects/scribblings/gui/blurbs.rkt @@ -9,8 +9,6 @@ (for-syntax scheme/base) (only-in scribblings/draw/blurbs res-sym - Resource - ResourceFirst boxisfill boxisfillnull MismatchExn)) @@ -263,5 +261,13 @@ information@|details|, even if the editor currently has delayed refreshing (see (define (slant . s) (make-element "slant" (decode-content s))) + (define (Resource s) + @elem{@to-element[`(quote ,(res-sym s))] + preference}) + (define (ResourceFirst s) ; fixme -- add index + (let ([r (Resource s)]) + (index* (list (format "~a preference" (res-sym s))) + (list r) + r))) ) diff --git a/collects/scribblings/gui/prefs.scrbl b/collects/scribblings/gui/prefs.scrbl index ae69442625..b4a7b9963a 100644 --- a/collects/scribblings/gui/prefs.scrbl +++ b/collects/scribblings/gui/prefs.scrbl @@ -4,15 +4,19 @@ @title[#:tag "mredprefs"]{Preferences} -GRacket supports a number of preferences for global configuration. The - GRacket preferences are stored in the common file reported by +The @racketmodname[racket/gui/base] library supports a number of preferences for global configuration. The + preferences are stored in the common file reported by @scheme[find-system-path] for @indexed-scheme['pref-file], and preference values can be retrieved and changed through - @scheme[get-preference] and @scheme[put-preferences]. However, GRacket - reads most preferences once at startup (all except the - @Resource{playcmd}). + @scheme[get-preference] and @scheme[put-preferences]. Except for the except the + @Resource{playcmd} preference, the @racketmodname[racket/gui/base] library + reads each of the preferences below once at startup. -The following are the (case-sensitive) preference names used by GRacket: +@emph{Beware:} The preferences file is read in case-insensitive mode (for + historical reasons), so the symbols listed below must be surrounded with + @litchar{|}. + +The following are the preference names used by GRacket: @itemize[ @@ -27,14 +31,14 @@ The following are the (case-sensitive) preference names used by GRacket: @scheme['alt], underlined mnemonics (introduced by @litchar{&} in menu labels) are suppressed.} - @item{@ResourceFirst{emacsUndo} --- a true value makes undo in + @item{@ResourceFirst{emacs-undo} --- a true value makes undo in editors work as in Emacs (i.e., undo operations are themselves kept in the undo stack).} @item{@ResourceFirst{wheelStep} --- sets the default mouse-wheel step size of @scheme[editor-canvas%] objects.} - @item{@ResourceFirst{outlineInactiveSelection} --- a true value + @item{@ResourceFirst{outline-inactive-selection} --- a true value causes selections in text editors to be shown with an outline of the selected region when the editor does no have the keyboard focus.} @@ -46,3 +50,8 @@ The following are the (case-sensitive) preference names used by GRacket: events.} ] + +In each of the above cases, if no preference value is found using the +@schemeidfont{GRacket}-prefixed name, a @schemeidfont{MrEd}-prefixed +name is tried for backward compatibility. + diff --git a/collects/scribblings/reference/filesystem.scrbl b/collects/scribblings/reference/filesystem.scrbl index 8992e642a5..6a6a0bb7a1 100644 --- a/collects/scribblings/reference/filesystem.scrbl +++ b/collects/scribblings/reference/filesystem.scrbl @@ -858,15 +858,16 @@ needed.} [failure-thunk (-> any) (lambda () #f)] [flush-mode any/c 'timestamp] [filename (or/c string-path? #f) #f] + [#:use-lock? use-lock? any/c #t] [#:lock-there lock-there (or/c (path? . -> . any) #f) - (make-handle-get-preference-locked 0.01 - name - fail-thunk - refresh-cache? - filename)] - [#:use-lock? use-lock? #t]) + (make-handle-get-preference-locked + 0.01 name fail-thunk refresh-cache? filename + #:lock-there timeout-lock-there)] + [#:timeout-lock-there timeout-lock-there + (or/c (path? . -> . any) #f) + #f]) any]{ Extracts a preference value from the file designated by @@ -906,6 +907,8 @@ preferences file cannot be read because the lock is unavailable, @racket[lock-there] is @racket[#f], an exception is raised. The default @racket[lock-there] handler retries about 5 times (with increasing delays between each attempt) before raising an exception. +The @racket[timeout-lock-there] argument is used only be the default +@racket[lock-there] value. See also @racket[put-preferences]. For a more elaborate preference system, see @racket[preferences:get].