diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index 972ce239..aedba614 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -2,15 +2,13 @@ (module editor mzscheme (require (lib "unitsig.ss") (lib "class.ss") - (lib "class100.ss") (lib "string-constant.ss" "string-constants") "sig.ss" "../gui-utils.ss" "../macro.ss" (lib "etc.ss") (lib "mred-sig.ss" "mred") - (lib "file.ss") - (lib "list.ss")) + (lib "file.ss")) (provide editor@) @@ -36,7 +34,6 @@ (define basic<%> (interface (editor<%>) has-focus? - editing-this-file? local-edit-sequence? run-after-edit-sequence get-top-level-window @@ -194,8 +191,6 @@ (send canvas get-top-level-window))] [else #f])))) - [define/public editing-this-file? (lambda () #f)] - [define edit-sequence-queue null] [define edit-sequence-ht (make-hash-table)] [define in-local-edit-sequence? #f] @@ -402,8 +397,6 @@ [super-after-load-file after-load-file] [super-get-keymaps get-keymaps] [super-set-filename set-filename]) - - (define/override (editing-this-file?) #t) (inherit get-canvases) (define/private (check-lock) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 79c14387..8e846ac8 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -125,7 +125,9 @@ get-menu-bar% make-root-area-container close - get-filename)) + editing-this-file? + get-filename + make-visible)) (define basic-mixin (mixin ((class->interface frame%)) (basic<%>) @@ -148,53 +150,52 @@ (lambda () (exit) (exit:set-exiting #f)))) - - (public get-filename) - [define get-filename + + (define/public (make-visible filename) (void)) + (define/public get-filename (case-lambda [() (get-filename #f)] - [(b) #f])] + [(b) #f])) + + (define/public (editing-this-file? filename) #f) - (override on-superwindow-show) (rename [super-on-superwindow-show on-superwindow-show]) - (define (on-superwindow-show shown?) + (define/override (on-superwindow-show shown?) (send (group:get-the-frame-group) frame-shown/hidden this) (super-on-superwindow-show shown?)) (define after-init? #f) - [define/override on-drop-file + (define/override on-drop-file (lambda (filename) - (handler:edit-file filename))] + (handler:edit-file filename))) ;; added call to set label here to hopefully work around a problem in mac mred (inherit set-label change-children) - (override after-new-child) - [define after-new-child + (define/override after-new-child (lambda (child) (when after-init? (change-children (lambda (l) (remq child l))) (error 'frame:basic-mixin "do not add children directly to a frame:basic (unless using make-root-area-container); use the get-area-container method instead" - )))] + )))) - (public get-area-container% get-menu-bar% make-root-area-container close) - [define get-area-container% (lambda () vertical-panel%)] - [define get-menu-bar% (lambda () menu-bar%)] - [define make-root-area-container + (define/public get-area-container% (lambda () vertical-panel%)) + (define/public get-menu-bar% (lambda () menu-bar%)) + (define/public make-root-area-container (lambda (% parent) - (make-object % parent))] + (make-object % parent))) (inherit can-close? on-close) - [define close + (define/public close (lambda () (when (can-close?) (on-close) - (show #f)))] + (show #f)))) (inherit accept-drop-files) - (super-instantiate ()) + (super-new) (accept-drop-files #t) @@ -207,8 +208,7 @@ (reorder-menus this) [define panel (make-root-area-container (get-area-container%) this)] - (public get-area-container) - [define get-area-container (lambda () panel)] + (define/public (get-area-container) panel) (set! after-init? #t))) (define register-group<%> (interface ())) @@ -942,17 +942,25 @@ (rename [super-on-close on-close] [super-set-label set-label]) - (override get-filename on-close) - [define get-filename + (define/override get-filename (case-lambda [() (get-filename #f)] [(b) (let ([e (get-editor)]) - (and e (send e get-filename b)))])] - [define on-close - (lambda () - (super-on-close) - (send (get-editor) on-close))] + (and e (send e get-filename b)))])) + + (define/override (editing-this-file? filename) + (let ([path-equal? + (lambda (x y) + (equal? (normal-case-path (normalize-path x)) + (normal-case-path (normalize-path y))))]) + (let ([this-fn (get-filename)]) + (and this-fn + (path-equal? filename (get-filename)))))) + + (define/override (on-close) + (super-on-close) + (send (get-editor) on-close)) [define label ""] [define label-prefix (application:current-app-name)] (define (do-label) diff --git a/collects/framework/private/group.ss b/collects/framework/private/group.ss index 24facf3a..7cf521bf 100644 --- a/collects/framework/private/group.ss +++ b/collects/framework/private/group.ss @@ -247,14 +247,7 @@ [test-frame (lambda (frame) (and (is-a? frame frame:basic<%>) - (let* ([filename (send frame get-filename)]) - (and (string? filename) - (string=? normalized - (with-handlers ([(lambda (x) #t) - (lambda (x) filename)]) - (normal-case-path - (normalize-path - filename))))))))]) + (send frame editing-this-file? normalized)))]) (let loop ([frames frames]) (cond [(null? frames) #f] diff --git a/collects/framework/private/handler.ss b/collects/framework/private/handler.ss index 7858b3c7..a16439ad 100644 --- a/collects/framework/private/handler.ss +++ b/collects/framework/private/handler.ss @@ -131,7 +131,8 @@ filename)]) (cond [already-open - (send already-open show #t) + (send already-open make-visible filename) + (send already-open show #t) already-open] [(and (preferences:get 'framework:open-here?) (send (group:get-the-frame-group) get-open-here-frame))