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

opening a locked teaching language file now works properly

Browse Source 
svn: r7772
This commit is contained in:
Robby Findler 2007-11-19 22:52:19 +00:00
parent 0f700b8531
commit ac98c07210
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/drscheme/private/auto-language.ss
View File

@ -25,10 +25,9 @@
(when (equal? lang-spec spec-in-file) (when (equal? lang-spec spec-in-file)
(set! found-language? lang) (set! found-language? lang)
(set! settings (send lang metadata->settings str)) (set! settings (send lang metadata->settings str))
(let ([locked? (send text is-locked?)]) (send text while-unlocked
(when locked? (send text lock #f)) (λ ()
(send text delete 0 (send text paragraph-start-position lines)) (send text delete 0 (send text paragraph-start-position lines)))))))))))
(when locked? (send text lock #t))))))))))
all-languages) all-languages)
;; check to see if it looks like the module language. ;; check to see if it looks like the module language.

12
collects/framework/private/text.ss
View File

@ -880,7 +880,8 @@ WARNING: printf is rebound in the body of the unit to always
(define file<%> (define file<%>
(interface (editor:file<%> basic<%>) (interface (editor:file<%> basic<%>)
get-read-write?)) get-read-write?
while-unlocked))
(define file-mixin (define file-mixin
(mixin (editor:file<%> basic<%>) (file<%>) (mixin (editor:file<%> basic<%>) (file<%>)
@ -896,6 +897,15 @@ WARNING: printf is rebound in the body of the unit to always
#t)]) #t)])
(set! read-write? can-edit?))) (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) (define/augment (can-insert? x y)
(and read-write? (inner #t can-insert? x y))) (and read-write? (inner #t can-insert? x y)))
(define/augment (can-delete? x y) (define/augment (can-delete? x y)