From 1b29fd590b236e4ee249fa3c5033e9cc7ff6d50d Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 20 Jan 2011 14:04:01 -0600 Subject: [PATCH] adjusted test-engine to use the framework preferences library so that drracket still starts up when there is a locked preference file under windows --- collects/test-engine/test-display.scm | 11 ++++------- collects/test-engine/test-tool.scm | 25 +++++++++++++++---------- 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/collects/test-engine/test-display.scm b/collects/test-engine/test-display.scm index e10211d7d3..402f449d98 100644 --- a/collects/test-engine/test-display.scm +++ b/collects/test-engine/test-display.scm @@ -31,8 +31,7 @@ (define (docked?) (and drscheme-frame - (get-preference 'test:test-window:docked? - (lambda () (put-preferences '(test:test-window:docked?) '(#f)) #f)))) + (preferences:get 'test-engine:test-window:docked?))) (define/public (report-success) (when current-rep @@ -489,8 +488,7 @@ (lambda (b c) (when (eq? 'button (send c get-event-type)) (send this show #f) - (put-preferences '(test:test-window:docked?) - '(#t)) + (preferences:set 'test-engine:test-window:docked? #t) (switch-func)))) (make-object grow-box-spacer-pane% button-panel))) @@ -543,7 +541,7 @@ button-panel (lambda (b c) (when (eq? 'button (send c get-event-type)) - (put-preferences '(test:test-window:docked?) '(#f)) + (preferences:set 'test-engine:test-window:docked? #f) (send frame undock-tests)))) (define/public (update-editor e) @@ -555,8 +553,7 @@ (define/public (remove) (let ([parent (get-parent)]) - (put-preferences '(test:test-dock-size) - (list (send parent get-percentages))) + (preferences:set 'test-engine:test-dock-size (send parent get-percentages)) (send parent delete-child this))))) (provide test-panel% test-window% test-display%) diff --git a/collects/test-engine/test-tool.scm b/collects/test-engine/test-tool.scm index ad978c2b04..0cf2959f5e 100644 --- a/collects/test-engine/test-tool.scm +++ b/collects/test-engine/test-tool.scm @@ -5,6 +5,12 @@ (require "test-display.scm") (provide tool@) +(preferences:set-default 'test-engine:test-dock-size + '(2/3 1/3) + (λ (x) (and (list? x) (= (length x) 2) (andmap number? x) (= 1 (apply + x))))) +(preferences:set-default 'test-engine:test-window:docked? #f boolean?) +(preferences:set-default 'test-engine:enable? #t boolean?) + (define tool@ (unit (import drscheme:tool^) (export drscheme:tool-exports^) @@ -71,9 +77,8 @@ (send test-panel update-editor editor) (unless (send test-panel is-shown?) (send test-frame add-child test-panel) - (let ([test-box-size - (get-preference 'test:test-dock-size (lambda () '(2/3 1/3)))]) - (send test-frame set-percentages test-box-size)))) + (send test-frame set-percentages + (get-preference 'test-engine:test-dock-size)))) (define test-panel null) (define test-frame null) @@ -107,7 +112,7 @@ (define/augment (on-tab-change from-tab to-tab) (let ([test-editor (send to-tab get-test-editor)] [panel-shown? (send test-panel is-shown?)] - [dock? (get-preference 'test:test-window:docked? (lambda () #f))]) + [dock? (preferences:get 'test-engine:test-window:docked?)]) (cond [(and test-editor panel-shown? dock?) (send test-panel update-editor test-editor)] [(and test-editor dock?) @@ -135,14 +140,14 @@ (send this set-label undock-label)) (set! docked? (not docked?))) (define/public (dock-report) - (unless docked? (dock-tests) (put-preferences '(test:test-window:docked?) '(#t)))) + (unless docked? (dock-tests) (preferences:set 'test-engine:test-window:docked? #t))) (define/public (undock-report) - (when docked? (undock-tests) (put-preferences '(test:test-window:docked?) '(#f)))) + (when docked? (undock-tests) (preferences:set 'test-engine:test-window:docked? #f))) (super-instantiate ()))) (define/override (add-show-menu-items show-menu) (super add-show-menu-items show-menu) - (let ([dock? (get-preference 'test:test-window:docked? (lambda () #t))]) + (let ([dock? (preferences:get 'test-engine:test-window:docked?)]) (when (eq? dock-menu-item 'not-init) (set! dock-menu-item (make-object dock-menu-item% @@ -171,14 +176,14 @@ (unless enabled? (set! enabled? #t) (send this set-label disable-label) - (put-preferences '(tests:enable?) '(#t)))) + (preferences:set 'test-engine:enable? #t))) (define/public (disable-tests) (when enabled? (set! enabled? #f) (send this set-label enable-label) - (put-preferences '(tests:enable?) '(#f)))) + (preferences:set 'test-engine:enable? #t))) (super-instantiate ()))] - [enable? (get-preference 'tests:enable? (lambda () #t))] + [enable? (preferences:get 'test-engine:enable?)] [enable-menu-item (make-object enable-menu-item% (if enable? disable-label enable-label) language-menu