original commit: c61b11c1e7fa9bb1056ba31c471007bd3f66e770
This commit is contained in:
Robby Findler 2003-11-03 15:47:48 +00:00
parent af450c495c
commit 313b5610d7
3 changed files with 53 additions and 49 deletions

View File

@ -160,39 +160,10 @@
(define (on-superwindow-show shown?)
(send (group:get-the-frame-group) frame-shown/hidden this)
(super-on-superwindow-show shown?))
(rename [super-can-close? can-close?]
[super-on-close on-close]
[super-on-focus on-focus])
(define after-init? #f)
(override can-close? on-close on-focus on-drop-file)
(define (can-close?)
(let ([number-of-frames
(length (send (group:get-the-frame-group)
get-frames))])
(if (preferences:get 'framework:exit-when-no-frames)
(and (super-can-close?)
(or (exit:exiting?)
(not (= 1 number-of-frames))
(exit:user-oks-exit)))
#t)))
(define (on-close)
(super-on-close)
(send (group:get-the-frame-group)
remove-frame
this)
(when (preferences:get 'framework:exit-when-no-frames)
(unless (exit:exiting?)
(when (null? (send (group:get-the-frame-group) get-frames))
(exit:exit)))))
(define (on-focus on?)
(super-on-focus on?)
(when on?
(send (group:get-the-frame-group) set-active-frame this)))
[define on-drop-file
[define/override on-drop-file
(lambda (filename)
(handler:edit-file filename))]
@ -213,6 +184,8 @@
[define make-root-area-container
(lambda (% parent)
(make-object % parent))]
(inherit can-close? on-close)
[define close
(lambda ()
(when (can-close?)
@ -232,12 +205,46 @@
mb)))
(reorder-menus this)
(send (group:get-the-frame-group) insert-frame this)
[define panel (make-root-area-container (get-area-container%) this)]
(public get-area-container)
[define get-area-container (lambda () panel)]
(set! after-init? #t)))
(define register-group<%> (interface ()))
(define register-group-mixin
(mixin (basic<%>) (register-group<%>)
(rename [super-can-close? can-close?]
[super-on-close on-close]
[super-on-focus on-focus])
(define/override (can-close?)
(let ([number-of-frames
(length (send (group:get-the-frame-group)
get-frames))])
(if (preferences:get 'framework:exit-when-no-frames)
(and (super-can-close?)
(or (exit:exiting?)
(not (= 1 number-of-frames))
(exit:user-oks-exit)))
#t)))
(define/override (on-close)
(super-on-close)
(send (group:get-the-frame-group)
remove-frame
this)
(when (preferences:get 'framework:exit-when-no-frames)
(unless (exit:exiting?)
(when (null? (send (group:get-the-frame-group) get-frames))
(exit:exit)))))
(define/override (on-focus on?)
(super-on-focus on?)
(when on?
(send (group:get-the-frame-group) set-active-frame this)))
(super-new)
(send (group:get-the-frame-group) insert-frame this)))
(define locked-message (string-constant read-only))
(define unlocked-message (string-constant read/write))
@ -2317,7 +2324,7 @@
[else (super-on-event evt)]))
(super-instantiate ())))
(define basic% (basic-mixin frame%))
(define basic% (register-group-mixin (basic-mixin frame%)))
(define info% (info-mixin basic%))
(define text-info% (text-info-mixin info%))
(define pasteboard-info% (pasteboard-info-mixin text-info%))

View File

@ -2,7 +2,6 @@
(module handler mzscheme
(require (lib "unitsig.ss")
(lib "class.ss")
(lib "class100.ss")
(lib "list.ss")
(lib "hierlist.ss" "hierlist")
"sig.ss"
@ -361,21 +360,17 @@
(super-instantiate ()))))
(define *open-directory* ; object to remember last directory
(make-object
(class100 object% ()
(private-field
[the-dir #f])
(public
[get (lambda () the-dir)]
[set-from-file!
(lambda (file)
(set! the-dir (path-only file)))]
[set-to-default
(lambda ()
(set! the-dir (current-directory)))])
(sequence
(set-to-default)
(super-init)))))
(new (class object%
(field [the-dir #f])
[define/public get (lambda () the-dir)]
[define/public set-from-file!
(lambda (file)
(set! the-dir (path-only file)))]
[define/public set-to-default
(lambda ()
(set! the-dir (current-directory)))]
(set-to-default)
(super-new))))
(define open-file
(lambda ()

View File

@ -343,6 +343,7 @@
(define-signature framework:frame-class^
(basic<%>
register-group<%>
status-line<%>
standard-menus<%>
editor<%>
@ -373,6 +374,7 @@
pasteboard-info-file%
basic-mixin
register-group-mixin
status-line-mixin
standard-menus-mixin
editor-mixin