adjust drracket to be more accomodating in the presence of hostile filesystems

original commit: 9fcc12b6a03f1a3eacea86b89af1c642fd621fb0

collects/framework/main.rkt

@@ -200,14 +200,19 @@
       any)
   (name-list val-list)
   @{Like @racket[put-preferences], but has more sophisticated error handling.
-    In particular, it
+    In particular, when it fails to grab a lock, it
     @itemize[
       @item{waits for three consecutive failures before informing the user}
       @item{gives the user the opportunity to ``steal'' the lockfile after the
             third failure, and}
-      @item{when failures occur, it remembers what its arguments were and if
+      @item{when lock failures occur, it remembers what its arguments were and if
             any preference save eventually succeeds, all of the past failures
-            are also written at that point.}]})
+            are also written at that point.}]
+    
+    In addition when an error is raised trying to save a preference to the preference
+    file, @racket[preferences:put-preferences/gui] logs the error using @racket[log-warning],
+    instead of raising an exception.
+    })
 
  (proc-doc/names
   preferences:get-preference/gui

collects/framework/preferences.rkt

@@ -89,7 +89,7 @@ the state transitions / contracts are:
     ;; first time reading this, check the file & unmarshall value, if
     ;; it's not there, use the default
     [(pref-default-set? p)
-     (let* (;; try to read the preferece from the preferences file
+     (let* (;; try to read the preference from the preferences file
             [v (read-pref-from-file p)]
             [v (if (eq? v none)
                  ;; no value read, take the default value
@@ -152,7 +152,7 @@ the state transitions / contracts are:
             value)]))
       ps values)
      ((preferences:low-level-put-preferences)
-      (map add-pref-prefix ps) 
+      (map add-pref-prefix ps)
       (map (λ (p value) (marshall-pref p value))
            ps
            values))
@@ -196,15 +196,15 @@ the state transitions / contracts are:
       (hash-set! callbacks
                  p 
                  (append 
-                  (hash-ref callbacks p (λ () null))
+                  (hash-ref callbacks p '())
                   (list new-cb)))
       (λ ()
         (hash-set!
          callbacks
          p
-         (let loop ([callbacks (hash-ref callbacks p (λ () null))])
+         (let loop ([callbacks (hash-ref callbacks p '())])
            (cond
-             [(null? callbacks) null]
+             [(null? callbacks) '()]
              [else 
               (let ([callback (car callbacks)])
                 (cond
@@ -216,7 +216,7 @@ the state transitions / contracts are:
 ;; check-callbacks : sym val -> void
 (define (check-callbacks p value)
   (let ([new-callbacks
-         (let loop ([callbacks (hash-ref callbacks p (λ () null))])
+         (let loop ([callbacks (hash-ref callbacks p '())])
            (cond
              [(null? callbacks) null]
              [else 
@@ -506,15 +506,22 @@ the state transitions / contracts are:
   (parameter/c ((listof symbol?) (listof any/c) . -> . any))
   put-preferences
   @{This parameter's value is called to save preference the preferences file.
-    Its interface should be just like mzlib's @racket[put-preferences].})
+    Its interface should be just like mzlib's @racket[put-preferences].
+    
+    The default value calls @racket[put-preferences] and, if there is an error,
+    then starts using a hash-table to save the preferences instead.
+    See also @racket[]})
  
  (parameter-doc
   preferences:low-level-get-preference
   (parameter/c (->* (symbol?) [(-> any)] any))
   get-preference
   @{This parameter's value is called to get a preference from the preferences
-    file. Its interface should be just like @racket[get-preference].})
- 
+    file. Its interface should be just like @racket[get-preference].
+    
+    The default value calls @racket[get-preferences] and, if there is an error,
+    then starts using a hash-table to save the preferences instead.})
+  
  (proc-doc/names
   preferences:snapshot? 
   (-> any/c boolean?)

collects/framework/private/preferences.rkt

@@ -85,7 +85,6 @@ the state transitions / contracts are:
   (define put-pref-retry-result #f)
   
   (define (put-preferences/gui new-ps new-vs)
-    
     ;; NOTE: old ones must come first in the list, 
     ;; or else multiple sets to the same preference
     ;; will save old values, instead of new ones.
@@ -96,6 +95,7 @@ the state transitions / contracts are:
     
     (define failed #f)
     (define (record-actual-failure)
+      (printf "recording a failure\n")
       (set! number-of-consecutive-failures (+ number-of-consecutive-failures 1))
       (set! past-failure-ps ps)
       (set! past-failure-vs vs)
@@ -155,12 +155,11 @@ the state transitions / contracts are:
        #f
        '(stop ok)))
     
-    (with-handlers ((exn? 
-                     (λ (x)
-                       (message-box
-                        (string-constant drscheme)
-                        (format (string-constant error-saving-preferences)
-                                (exn-message x))))))
+    (with-handlers ((exn:fail? 
+                     (λ (exn)
+                       (log-warning (format "preferences: failed to save ~a prefs:\n   ~a" 
+                                            ps
+                                            (exn-message exn))))))
       (begin0
         (put-preferences ps vs fail-func)
         (unless failed

collects/framework/splash.rkt

@@ -308,7 +308,10 @@
    (λ () default)
    #:timeout-lock-there (λ (path) default)))
 (define (splash-set-preference name value)
-  (put-preferences (list name) (list value) void))
+  (with-handlers ((exn:fail?
+                   (λ (exn)
+                     (log-warning (format "splash pref save: ~a" (exn-message exn))))))
+    (put-preferences (list name) (list value) void)))
 
 ;; only modified (or read) on the splash eventspace handler thread
 (define quit-on-close? #t)