suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Robby Findler 2011-08-27 16:37:17 -05:00
parent 8fd388fde1
commit 9fcc12b6a0
6 changed files with 48 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/drracket/private/main.rkt
View File

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

24
collects/drracket/private/unit.rkt
View File

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

11
collects/framework/main.rkt
View File

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

25
collects/framework/preferences.rkt
View File

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

13
collects/framework/private/preferences.rkt
View File

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

5
collects/framework/splash.rkt
View File

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