From ac98c07210b1bbe3e4ced080b155f05ceb2c995f Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 19 Nov 2007 22:52:19 +0000 Subject: [PATCH] opening a locked teaching language file now works properly svn: r7772 --- collects/drscheme/private/auto-language.ss | 7 +++---- collects/framework/private/text.ss | 12 +++++++++++- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/collects/drscheme/private/auto-language.ss b/collects/drscheme/private/auto-language.ss index 8cd640ad4f..4c9165888e 100644 --- a/collects/drscheme/private/auto-language.ss +++ b/collects/drscheme/private/auto-language.ss @@ -25,10 +25,9 @@ (when (equal? lang-spec spec-in-file) (set! found-language? lang) (set! settings (send lang metadata->settings str)) - (let ([locked? (send text is-locked?)]) - (when locked? (send text lock #f)) - (send text delete 0 (send text paragraph-start-position lines)) - (when locked? (send text lock #t)))))))))) + (send text while-unlocked + (λ () + (send text delete 0 (send text paragraph-start-position lines))))))))))) all-languages) ;; check to see if it looks like the module language. diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 23c9c44546..98b229939a 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -880,7 +880,8 @@ WARNING: printf is rebound in the body of the unit to always (define file<%> (interface (editor:file<%> basic<%>) - get-read-write?)) + get-read-write? + while-unlocked)) (define file-mixin (mixin (editor:file<%> basic<%>) (file<%>) @@ -896,6 +897,15 @@ WARNING: printf is rebound in the body of the unit to always #t)]) (set! read-write? can-edit?))) + (define/public (while-unlocked t) + (let ([unlocked? 'unint]) + (dynamic-wind + (λ () + (set! unlocked? read-write?) + (set! read-write? #t)) + (λ () (t)) + (λ () (set! read-write? unlocked?))))) + (define/augment (can-insert? x y) (and read-write? (inner #t can-insert? x y))) (define/augment (can-delete? x y)