diff --git a/collects/drracket/private/main.rkt b/collects/drracket/private/main.rkt index 3d9e6bc915..6270a460a4 100644 --- a/collects/drracket/private/main.rkt +++ b/collects/drracket/private/main.rkt @@ -521,8 +521,6 @@ lang (or settings (send lang default-settings))))))))) - ;; preferences initialization - (preferences:set-default 'drracket:online-compilation #t boolean?) (drr:set-default 'drracket:multi-file-search:recur? #t boolean?) diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index 3e40134067..547643f8ea 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -1689,9 +1689,7 @@ module browser threading seems wrong. #t)]))))) (define/override (make-root-area-container cls parent) - (let* ([saved-p (preferences:get 'drracket:module-browser-size-percentage)] - [saved-p2 (preferences:get 'drracket:logging-size-percentage)] - [_module-browser-parent-panel + (let* ([_module-browser-parent-panel (super make-root-area-container (make-two-way-prefs-dragable-panel% panel:horizontal-dragable% 'drracket:module-browser-size-percentage) @@ -1732,8 +1730,8 @@ module browser threading seems wrong. (send planet-status-parent-panel change-children (λ (l) (remq planet-status-panel l))) (unless (toolbar-shown?) (send transcript-parent-panel change-children (λ (l) '()))) - (preferences:set 'drracket:module-browser-size-percentage saved-p) - (preferences:set 'drracket:logging-size-percentage saved-p2) + (send logger-outer-panel enable-two-way-prefs) + (send _module-browser-parent-panel enable-two-way-prefs) root)) @@ -4651,15 +4649,21 @@ module browser threading seems wrong. (frame:basic-mixin frame%)))))))))))))))))) + (define-local-member-name enable-two-way-prefs) (define (make-two-way-prefs-dragable-panel% % pref-key) (class % (inherit get-percentages) + + (define save-prefs? #f) + (define/public (enable-two-way-prefs) (set! save-prefs? #t)) + (define/augment (after-percentage-change) - (let ([percentages (get-percentages)]) - (when (and (pair? percentages) - (pair? (cdr percentages)) - (null? (cddr percentages))) - (preferences:set pref-key (car percentages)))) + (when save-prefs? + (let ([percentages (get-percentages)]) + (when (and (pair? percentages) + (pair? (cdr percentages)) + (null? (cddr percentages))) + (preferences:set pref-key (car percentages))))) (inner (void) after-percentage-change)) (super-new))) diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index 4c3dc7ac75..88de9a1db1 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 db85ac27e1..3de7c46630 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 a048185d86..0299970262 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 b33fc09fa5..8e32f96b86 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)