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

@@ -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 () 'ctl))])
-                                         (lambda () (get-preference '|MrEd:defaultMenuPrefix| 
-                                                                    (lambda () 'ctl))))])
 				 (if (memq v '(meta ctl alt ctl-m))
 				     v
 				     'ctl))

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]

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

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)

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

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

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

collects/mred/private/wxme/undo.rkt

@@ -246,10 +246,8 @@
     (init       count)
     (init-field id
                 parity?)
-    (unless id
+    (unless id (set! id (mcons #f #f)))
-      (set! id (if parity?
+    ((if parity? set-mcar! set-mcdr!) id this)
-                   (cons this #f)
-                   (cons #f 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)
+          (mcar id)
-          (cdr id)))
+          (mcdr id)))
 
     (define/override (cancel)
       ;; Avoid double-frees by not doing anything

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

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

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

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)

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

collects/scribblings/gui/prefs.scrbl

@@ -4,15 +4,19 @@
 
 @title[#:tag "mredprefs"]{Preferences}
 
-GRacket supports a number of preferences for global configuration. The
+The @racketmodname[racket/gui/base] library supports a number of preferences for global configuration. The
- GRacket preferences are stored in the common file reported by
+ 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
+ @scheme[get-preference] and @scheme[put-preferences]. Except for the except the
- reads most preferences once at startup (all except the
+ @Resource{playcmd} preference, the @racketmodname[racket/gui/base] library
- @Resource{playcmd}).
+ 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.
+

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
+                          (make-handle-get-preference-locked 
-                                                             name
+                           0.01 name fail-thunk refresh-cache? filename
-                                                             fail-thunk
+                           #:lock-there timeout-lock-there)]
-                                                             refresh-cache?
+                         [#:timeout-lock-there timeout-lock-there 
-                                                             filename)]
+                                               (or/c (path? . -> . any) #f)
-                         [#:use-lock? use-lock? #t])
+                                               #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].