racket/gui: add `application-start-empty-handler'
This commit is contained in:
parent
ce4705cedc
commit
735ca7f3c3
|
@ -10,6 +10,7 @@ application-about-handler
|
||||||
application-file-handler
|
application-file-handler
|
||||||
application-preferences-handler
|
application-preferences-handler
|
||||||
application-quit-handler
|
application-quit-handler
|
||||||
|
application-start-empty-handler
|
||||||
area-container-window<%>
|
area-container-window<%>
|
||||||
area-container<%>
|
area-container<%>
|
||||||
area<%>
|
area<%>
|
||||||
|
|
|
@ -10,6 +10,7 @@
|
||||||
application-about-handler
|
application-about-handler
|
||||||
application-quit-handler
|
application-quit-handler
|
||||||
application-file-handler
|
application-file-handler
|
||||||
|
application-start-empty-handler
|
||||||
current-eventspace-has-standard-menus?
|
current-eventspace-has-standard-menus?
|
||||||
current-eventspace-has-menu-root?
|
current-eventspace-has-menu-root?
|
||||||
eventspace-handler-thread)
|
eventspace-handler-thread)
|
||||||
|
@ -150,6 +151,17 @@
|
||||||
values
|
values
|
||||||
requeue-saved-files))]))
|
requeue-saved-files))]))
|
||||||
|
|
||||||
|
(define application-start-empty-handler
|
||||||
|
(case-lambda
|
||||||
|
[() (or (and (wx:main-eventspace? (wx:current-eventspace))
|
||||||
|
(app-handler-orig (wx:application-start-empty-handler)))
|
||||||
|
void)]
|
||||||
|
[(proc)
|
||||||
|
(set-handler! 'application-start-empty-handler proc
|
||||||
|
wx:application-start-empty-handler
|
||||||
|
0
|
||||||
|
values
|
||||||
|
void)]))
|
||||||
|
|
||||||
(define (current-eventspace-has-standard-menus?)
|
(define (current-eventspace-has-standard-menus?)
|
||||||
(and (eq? 'macosx (system-type))
|
(and (eq? 'macosx (system-type))
|
||||||
|
|
|
@ -38,4 +38,5 @@
|
||||||
application-file-handler
|
application-file-handler
|
||||||
application-quit-handler
|
application-quit-handler
|
||||||
application-about-handler
|
application-about-handler
|
||||||
application-pref-handler)
|
application-pref-handler
|
||||||
|
application-start-empty-handler)
|
||||||
|
|
|
@ -272,6 +272,7 @@
|
||||||
application-preferences-handler
|
application-preferences-handler
|
||||||
application-quit-handler
|
application-quit-handler
|
||||||
application-file-handler
|
application-file-handler
|
||||||
|
application-start-empty-handler
|
||||||
current-eventspace-has-standard-menus?
|
current-eventspace-has-standard-menus?
|
||||||
current-eventspace-has-menu-root?
|
current-eventspace-has-menu-root?
|
||||||
eventspace-handler-thread
|
eventspace-handler-thread
|
||||||
|
|
|
@ -47,6 +47,8 @@
|
||||||
|
|
||||||
(define app (tell NSApplication sharedApplication))
|
(define app (tell NSApplication sharedApplication))
|
||||||
|
|
||||||
|
(define got-file? #f)
|
||||||
|
|
||||||
(define-objc-class MyApplicationDelegate NSObject #:protocols (NSApplicationDelegate)
|
(define-objc-class MyApplicationDelegate NSObject #:protocols (NSApplicationDelegate)
|
||||||
[]
|
[]
|
||||||
[-a _NSUInteger (applicationShouldTerminate: [_id app])
|
[-a _NSUInteger (applicationShouldTerminate: [_id app])
|
||||||
|
@ -72,7 +74,11 @@
|
||||||
(queue-about-event))
|
(queue-about-event))
|
||||||
#t]
|
#t]
|
||||||
[-a _BOOL (application: [_id theApplication] openFile: [_NSString filename])
|
[-a _BOOL (application: [_id theApplication] openFile: [_NSString filename])
|
||||||
|
(set! got-file? #t)
|
||||||
(queue-file-event (string->path filename))]
|
(queue-file-event (string->path filename))]
|
||||||
|
[-a _void (applicationDidFinishLaunching: [_id notification])
|
||||||
|
(unless got-file?
|
||||||
|
(queue-start-empty-event))]
|
||||||
[-a _BOOL (applicationShouldHandleReopen: [_id app] hasVisibleWindows: [_BOOL has-visible?])
|
[-a _BOOL (applicationShouldHandleReopen: [_id app] hasVisibleWindows: [_BOOL has-visible?])
|
||||||
;; If we have any visible windows, return #t to do the default thing.
|
;; If we have any visible windows, return #t to do the default thing.
|
||||||
;; Otherwise return #f, because we don't want any invisible windows resurrected.
|
;; Otherwise return #f, because we don't want any invisible windows resurrected.
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
(protect-out application-file-handler
|
(protect-out application-file-handler
|
||||||
|
application-start-empty-handler
|
||||||
application-quit-handler
|
application-quit-handler
|
||||||
application-about-handler
|
application-about-handler
|
||||||
application-pref-handler
|
application-pref-handler
|
||||||
|
@ -10,8 +11,15 @@
|
||||||
nothing-application-about-handler))
|
nothing-application-about-handler))
|
||||||
|
|
||||||
(define saved-files null)
|
(define saved-files null)
|
||||||
(define afh (lambda (f)
|
(define orig-afh (lambda (f)
|
||||||
(set! saved-files (cons f saved-files))))
|
(if (eq? afh orig-afh)
|
||||||
|
(set! saved-files (cons f saved-files))
|
||||||
|
;; handler has changed between time a call here
|
||||||
|
;; was queued and the call happened
|
||||||
|
(let ([sf (cons f saved-files)])
|
||||||
|
(set! saved-files null)
|
||||||
|
(for-each afh (reverse sf))))))
|
||||||
|
(define afh orig-afh)
|
||||||
(define application-file-handler
|
(define application-file-handler
|
||||||
(case-lambda
|
(case-lambda
|
||||||
[(proc)
|
[(proc)
|
||||||
|
@ -21,6 +29,21 @@
|
||||||
(for-each proc (reverse sf)))]
|
(for-each proc (reverse sf)))]
|
||||||
[() afh]))
|
[() afh]))
|
||||||
|
|
||||||
|
(define started-empty? #f)
|
||||||
|
(define orig-aseh (lambda ()
|
||||||
|
(if (eq? aseh orig-aseh)
|
||||||
|
(set! started-empty? #t)
|
||||||
|
(aseh))))
|
||||||
|
(define aseh orig-aseh)
|
||||||
|
(define application-start-empty-handler
|
||||||
|
(case-lambda
|
||||||
|
[(proc)
|
||||||
|
(set! aseh proc)
|
||||||
|
(when started-empty?
|
||||||
|
(set! started-empty? #f)
|
||||||
|
(proc))]
|
||||||
|
[() aseh]))
|
||||||
|
|
||||||
(define aqh void)
|
(define aqh void)
|
||||||
(define application-quit-handler
|
(define application-quit-handler
|
||||||
(case-lambda
|
(case-lambda
|
||||||
|
|
|
@ -56,6 +56,7 @@
|
||||||
queue-prefs-event
|
queue-prefs-event
|
||||||
queue-about-event
|
queue-about-event
|
||||||
queue-file-event
|
queue-file-event
|
||||||
|
queue-start-empty-event
|
||||||
|
|
||||||
begin-busy-cursor
|
begin-busy-cursor
|
||||||
end-busy-cursor
|
end-busy-cursor
|
||||||
|
@ -582,6 +583,11 @@
|
||||||
((application-file-handler) file))
|
((application-file-handler) file))
|
||||||
'med))
|
'med))
|
||||||
|
|
||||||
|
(define (queue-start-empty-event)
|
||||||
|
;; called in event-pump thread
|
||||||
|
(queue-event main-eventspace (application-start-empty-handler)
|
||||||
|
'med))
|
||||||
|
|
||||||
(define (begin-busy-cursor)
|
(define (begin-busy-cursor)
|
||||||
(let ([e (current-eventspace)])
|
(let ([e (current-eventspace)])
|
||||||
(atomically
|
(atomically
|
||||||
|
|
|
@ -53,6 +53,39 @@ or has no effect (when called with a handler).
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@defproc*[([(application-file-handler)
|
||||||
|
(path? . -> . any)]
|
||||||
|
[(application-file-handler [handler-proc (path? . -> . any)])
|
||||||
|
void?])]{
|
||||||
|
When the current eventspace is the initial eventspace, this procedure
|
||||||
|
retrieves or installs a procedure that is called on Mac OS X
|
||||||
|
and Windows when the application is running and user double-clicks an
|
||||||
|
application-handled file or drags a file onto the application's
|
||||||
|
icon. The procedure is always called in the initial eventspace's
|
||||||
|
handler thread (as a callback), and the argument is a filename.
|
||||||
|
|
||||||
|
The default handler queues a callback to the
|
||||||
|
@method[window<%> on-drop-file] method of the most-recently activated frame in the main eventspace (see
|
||||||
|
@racket[get-top-level-edit-target-window]), if
|
||||||
|
drag-and-drop is enabled for that frame. Otherwise, it saves
|
||||||
|
the filename and re-queues the handler event when the application
|
||||||
|
file handler is later changed.
|
||||||
|
|
||||||
|
On Windows, when the application is @italic{not} running and user double-clicks an
|
||||||
|
application-handled file or drags a file onto the application's icon,
|
||||||
|
the filename is provided as a command-line argument to the
|
||||||
|
application.
|
||||||
|
|
||||||
|
On Mac OS X, if an application is started @emph{without} files, then
|
||||||
|
the @racket[application-start-empty-handler] procedure is called.
|
||||||
|
|
||||||
|
If the current eventspace is not the initial eventspace, this
|
||||||
|
procedure returns @racket[void] (when called with zero arguments)
|
||||||
|
or has no effect (when called with a handler).
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
@defproc*[([(application-preferences-handler)
|
@defproc*[([(application-preferences-handler)
|
||||||
(or/c (-> any) false/c)]
|
(or/c (-> any) false/c)]
|
||||||
[(application-preferences-handler [handler-thunk (or/c (-> any) false/c)])
|
[(application-preferences-handler [handler-thunk (or/c (-> any) false/c)])
|
||||||
|
@ -99,28 +132,22 @@ procedure returns @racket[void] (when called with zero arguments)
|
||||||
or has no effect (when called with a handler).
|
or has no effect (when called with a handler).
|
||||||
}
|
}
|
||||||
|
|
||||||
@defproc*[([(application-file-handler)
|
|
||||||
(path? . -> . any)]
|
@defproc*[([(application-start-empty-handler)
|
||||||
[(application-file-handler [handler-proc (path? . -> . any)])
|
(-> any)]
|
||||||
|
[(application-start-empty-handler [handler-thunk (-> any)])
|
||||||
void?])]{
|
void?])]{
|
||||||
When the current eventspace is the initial eventspace, this procedure
|
When the current eventspace is the initial eventspace, this procedure
|
||||||
retrieves or installs a procedure that is called on Mac OS X
|
retrieves or installs a thunk that is called when the user starts
|
||||||
and Windows when the application is running and user double-clicks an
|
the application on Mac OS X without supplying any initial files (e.g.,
|
||||||
application-handled file or drags a file onto the application's
|
by double-clicking the application icon instead of double-clicking
|
||||||
icon. The procedure is always called in the initial eventspace's
|
files that are handled by the application).
|
||||||
handler thread (as a callback), and the argument is a filename.
|
|
||||||
|
|
||||||
The default handler queues a callback to the
|
The default handler re-queues the handler event when the application
|
||||||
@method[window<%> on-drop-file] method of the most-recently activated frame in the main eventspace (see
|
start-empty handler is later changed. As a result, if an application
|
||||||
@racket[get-top-level-edit-target-window]), if
|
sets both @racket[application-start-empty-handler] and
|
||||||
drag-and-drop is enabled for that frame. Otherwise, it saves
|
@racket[application-file-handler], then one or the other is
|
||||||
the filename and re-queues the handler event when the application
|
eventually called.
|
||||||
file handler is later changed.
|
|
||||||
|
|
||||||
When the application is @italic{not} running and user double-clicks an
|
|
||||||
application-handled file or drags a file onto the application's icon,
|
|
||||||
the filename is provided as a command-line argument to the
|
|
||||||
application.
|
|
||||||
|
|
||||||
If the current eventspace is not the initial eventspace, this
|
If the current eventspace is not the initial eventspace, this
|
||||||
procedure returns @racket[void] (when called with zero arguments)
|
procedure returns @racket[void] (when called with zero arguments)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user