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
This commit is contained in:
Matthew Flatt 2011-01-18 17:23:28 -07:00
parent 183323a2c5
commit 98822cf1f9
15 changed files with 95 additions and 50 deletions

View File

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

View File

@ -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]

View File

@ -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

View File

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

View File

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

View File

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

View File

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

View File

@ -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

View File

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

View File

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

View File

@ -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])))

View File

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

View File

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

View File

@ -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.

View File

@ -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].