diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index 4c3dc7ac..88de9a1d 100644 --- a/collects/framework/main.rkt +++ b/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 diff --git a/collects/framework/preferences.rkt b/collects/framework/preferences.rkt index db85ac27..3de7c466 100644 --- a/collects/framework/preferences.rkt +++ b/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?) diff --git a/collects/framework/private/preferences.rkt b/collects/framework/private/preferences.rkt index a048185d..02999702 100644 --- a/collects/framework/private/preferences.rkt +++ b/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 diff --git a/collects/framework/splash.rkt b/collects/framework/splash.rkt index b33fc09f..8e32f96b 100644 --- a/collects/framework/splash.rkt +++ b/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)