..
original commit: c61b11c1e7fa9bb1056ba31c471007bd3f66e770
This commit is contained in:
parent
af450c495c
commit
313b5610d7
|
@ -161,38 +161,9 @@
|
||||||
(send (group:get-the-frame-group) frame-shown/hidden this)
|
(send (group:get-the-frame-group) frame-shown/hidden this)
|
||||||
(super-on-superwindow-show shown?))
|
(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)
|
(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?)
|
[define/override on-drop-file
|
||||||
(super-on-focus on?)
|
|
||||||
(when on?
|
|
||||||
(send (group:get-the-frame-group) set-active-frame this)))
|
|
||||||
|
|
||||||
[define on-drop-file
|
|
||||||
(lambda (filename)
|
(lambda (filename)
|
||||||
(handler:edit-file filename))]
|
(handler:edit-file filename))]
|
||||||
|
|
||||||
|
@ -213,6 +184,8 @@
|
||||||
[define make-root-area-container
|
[define make-root-area-container
|
||||||
(lambda (% parent)
|
(lambda (% parent)
|
||||||
(make-object % parent))]
|
(make-object % parent))]
|
||||||
|
|
||||||
|
(inherit can-close? on-close)
|
||||||
[define close
|
[define close
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(when (can-close?)
|
(when (can-close?)
|
||||||
|
@ -232,13 +205,47 @@
|
||||||
mb)))
|
mb)))
|
||||||
|
|
||||||
(reorder-menus this)
|
(reorder-menus this)
|
||||||
(send (group:get-the-frame-group) insert-frame this)
|
|
||||||
|
|
||||||
[define panel (make-root-area-container (get-area-container%) this)]
|
[define panel (make-root-area-container (get-area-container%) this)]
|
||||||
(public get-area-container)
|
(public get-area-container)
|
||||||
[define get-area-container (lambda () panel)]
|
[define get-area-container (lambda () panel)]
|
||||||
(set! after-init? #t)))
|
(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 locked-message (string-constant read-only))
|
||||||
(define unlocked-message (string-constant read/write))
|
(define unlocked-message (string-constant read/write))
|
||||||
|
|
||||||
|
@ -2317,7 +2324,7 @@
|
||||||
[else (super-on-event evt)]))
|
[else (super-on-event evt)]))
|
||||||
(super-instantiate ())))
|
(super-instantiate ())))
|
||||||
|
|
||||||
(define basic% (basic-mixin frame%))
|
(define basic% (register-group-mixin (basic-mixin frame%)))
|
||||||
(define info% (info-mixin basic%))
|
(define info% (info-mixin basic%))
|
||||||
(define text-info% (text-info-mixin info%))
|
(define text-info% (text-info-mixin info%))
|
||||||
(define pasteboard-info% (pasteboard-info-mixin text-info%))
|
(define pasteboard-info% (pasteboard-info-mixin text-info%))
|
||||||
|
|
|
@ -2,7 +2,6 @@
|
||||||
(module handler mzscheme
|
(module handler mzscheme
|
||||||
(require (lib "unitsig.ss")
|
(require (lib "unitsig.ss")
|
||||||
(lib "class.ss")
|
(lib "class.ss")
|
||||||
(lib "class100.ss")
|
|
||||||
(lib "list.ss")
|
(lib "list.ss")
|
||||||
(lib "hierlist.ss" "hierlist")
|
(lib "hierlist.ss" "hierlist")
|
||||||
"sig.ss"
|
"sig.ss"
|
||||||
|
@ -361,21 +360,17 @@
|
||||||
(super-instantiate ()))))
|
(super-instantiate ()))))
|
||||||
|
|
||||||
(define *open-directory* ; object to remember last directory
|
(define *open-directory* ; object to remember last directory
|
||||||
(make-object
|
(new (class object%
|
||||||
(class100 object% ()
|
(field [the-dir #f])
|
||||||
(private-field
|
[define/public get (lambda () the-dir)]
|
||||||
[the-dir #f])
|
[define/public set-from-file!
|
||||||
(public
|
|
||||||
[get (lambda () the-dir)]
|
|
||||||
[set-from-file!
|
|
||||||
(lambda (file)
|
(lambda (file)
|
||||||
(set! the-dir (path-only file)))]
|
(set! the-dir (path-only file)))]
|
||||||
[set-to-default
|
[define/public set-to-default
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set! the-dir (current-directory)))])
|
(set! the-dir (current-directory)))]
|
||||||
(sequence
|
|
||||||
(set-to-default)
|
(set-to-default)
|
||||||
(super-init)))))
|
(super-new))))
|
||||||
|
|
||||||
(define open-file
|
(define open-file
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
|
|
@ -343,6 +343,7 @@
|
||||||
|
|
||||||
(define-signature framework:frame-class^
|
(define-signature framework:frame-class^
|
||||||
(basic<%>
|
(basic<%>
|
||||||
|
register-group<%>
|
||||||
status-line<%>
|
status-line<%>
|
||||||
standard-menus<%>
|
standard-menus<%>
|
||||||
editor<%>
|
editor<%>
|
||||||
|
@ -373,6 +374,7 @@
|
||||||
pasteboard-info-file%
|
pasteboard-info-file%
|
||||||
|
|
||||||
basic-mixin
|
basic-mixin
|
||||||
|
register-group-mixin
|
||||||
status-line-mixin
|
status-line-mixin
|
||||||
standard-menus-mixin
|
standard-menus-mixin
|
||||||
editor-mixin
|
editor-mixin
|
||||||
|
|
Loading…
Reference in New Issue
Block a user