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:
parent
183323a2c5
commit
98822cf1f9
|
@ -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))
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))))))))))))
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
28
collects/racket/snip/private/prefs.rkt
Normal file
28
collects/racket/snip/private/prefs.rkt
Normal 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))))
|
|
@ -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])))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
)
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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].
|
||||
|
|
Loading…
Reference in New Issue
Block a user