diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index aedba614..df742f4a 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -37,14 +37,22 @@ local-edit-sequence? run-after-edit-sequence get-top-level-window - on-close save-file-out-of-date? save-file/gui-error - load-file/gui-error)) + load-file/gui-error + on-close + can-close? + close)) (define basic-mixin (mixin (editor<%>) (basic<%>) + (define/public (can-close?) #t) + (define/public (on-close) (void)) + (define/public (close) (if (can-close?) + (begin (on-close) #t) + #f)) + (inherit get-filename save-file) (define/public save-file/gui-error (opt-lambda ([input-filename #f] @@ -176,7 +184,6 @@ (super-on-focus x)) (define/public (has-focus?) has-focus) - (define/public (on-close) (void)) (define/public (get-top-level-window) (let loop ([text this]) (let ([editor-admin (send text get-admin)]) @@ -451,9 +458,25 @@ (unless temp? (update-frame-filename))])) + (inherit save-file) + (rename [super-can-close? can-close?]) + (define/override (can-close?) + (let* ([user-allowed-or-not-modified + (or (not (is-modified?)) + (case (gui-utils:unsaved-warning + (get-filename/untitled-name) + (string-constant close-anyway) + #t + this) + [(continue) #t] + [(save) (save-file)] + [else #f]))]) + (and user-allowed-or-not-modified + (super-can-close?)))) + (define/override (get-keymaps) (cons (keymap:get-file) (super-get-keymaps))) - (super-instantiate ()))) + (super-new))) (define backup-autosave<%> (interface (basic<%>) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 15561192..3fe51c18 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -938,8 +938,7 @@ (inherit get-area-container get-client-size show get-edit-target-window get-edit-target-object) - (rename [super-on-close on-close] - [super-set-label set-label]) + (rename [super-set-label set-label]) (define/override get-filename (case-lambda @@ -957,9 +956,16 @@ (and this-fn (path-equal? filename (get-filename)))))) + (rename [super-on-close on-close]) (define/override (on-close) (super-on-close) (send (get-editor) on-close)) + + (rename [super-can-close? can-close?]) + (define/override (can-close?) + (and (super-can-close?) + (send (get-editor) can-close?))) + [define label ""] [define label-prefix (application:current-app-name)] (define (do-label) @@ -2313,32 +2319,6 @@ (lambda (x) #f)]) (directory-exists? (build-path (collection-path "framework") "CVS")))) - (define file<%> (interface (-editor<%>))) - (define file-mixin - (mixin (-editor<%>) (file<%>) - (inherit get-editor get-filename get-label save) - (rename [super-can-close? can-close?]) - (override can-close?) - [define can-close? - (lambda () - (let* ([edit (get-editor)] - [user-allowed-or-not-modified - (or (not (send edit is-modified?)) - (case (gui-utils:unsaved-warning - (let ([fn (get-filename)]) - (if (string? fn) - fn - (get-label))) - (string-constant close-anyway) - #t - this) - [(continue) #t] - [(save) (save)] - [else #f]))]) - (and user-allowed-or-not-modified - (super-can-close?))))] - (super-instantiate ()))) - (define bday-click-canvas% (class canvas% (rename [super-on-event on-event]) @@ -2361,9 +2341,7 @@ (define open-here% (open-here-mixin editor%)) (define -text% (text-mixin open-here%)) - (define text-info-file% (file-mixin -text%)) - (define searchable% (searchable-text-mixin (searchable-mixin text-info-file%))) + (define searchable% (searchable-text-mixin (searchable-mixin -text%))) (define delegate% (delegate-mixin searchable%)) - (define -pasteboard% (pasteboard-mixin open-here%)) - (define pasteboard-info-file% (file-mixin -pasteboard%))))) + (define -pasteboard% (pasteboard-mixin open-here%))))) diff --git a/collects/framework/private/handler.ss b/collects/framework/private/handler.ss index a16439ad..5c8ecabc 100644 --- a/collects/framework/private/handler.ss +++ b/collects/framework/private/handler.ss @@ -99,7 +99,7 @@ (define current-create-new-window (make-parameter (lambda (filename) - (let ([frame (make-object frame:text-info-file% filename)]) + (let ([frame (make-object frame:text% filename)]) (send frame show #t) frame)))) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index a84b404d..a517cf69 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -354,7 +354,6 @@ info<%> text-info<%> pasteboard-info<%> - file<%> basic% status-line% @@ -365,11 +364,9 @@ editor% open-here% text% - text-info-file% searchable% delegate% pasteboard% - pasteboard-info-file% basic-mixin register-group-mixin @@ -384,8 +381,7 @@ searchable-text-mixin info-mixin text-info-mixin - pasteboard-info-mixin - file-mixin)) + pasteboard-info-mixin)) (define-signature framework:frame-fun^ (reorder-menus add-snip-menu-items)) diff --git a/collects/tests/framework/frame.ss b/collects/tests/framework/frame.ss index eff7a67a..5be0150d 100644 --- a/collects/tests/framework/frame.ss +++ b/collects/tests/framework/frame.ss @@ -88,9 +88,6 @@ (test-creation 'text-info-file%-creation 'frame:text-info-file%) - (test-creation - 'text-info-file-mixin-creation - '(frame:file-mixin frame:text%)) (test-creation 'pasteboard-mixin-creation @@ -102,9 +99,6 @@ 'pasteboard%-creation 'frame:pasteboard%) - (test-creation - 'pasteboard-info-file-mixin-creation - '(frame:file-mixin frame:pasteboard%)) (test-creation 'pasteboard-info-file%-creation 'frame:pasteboard-info-file%)