suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/gui: add `application-start-empty-handler'

Browse Source
This commit is contained in:
Matthew Flatt 2011-09-09 10:24:07 -06:00
parent ce4705cedc
commit 735ca7f3c3
8 changed files with 99 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mred/mred-sig.rkt
View File

@ -10,6 +10,7 @@ application-about-handler
application-file-handler
application-preferences-handler
application-quit-handler
application-start-empty-handler
area-container-window<%>
area-container<%>
area<%>

12
collects/mred/private/app.rkt
View File

@ -10,6 +10,7 @@
application-about-handler
application-quit-handler
application-file-handler
application-start-empty-handler
current-eventspace-has-standard-menus?
current-eventspace-has-menu-root?
eventspace-handler-thread)
@ -150,6 +151,17 @@
values
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?)
(and (eq? 'macosx (system-type))

3
collects/mred/private/kernel.rkt
View File

@ -38,4 +38,5 @@
application-file-handler
application-quit-handler
application-about-handler
application-pref-handler)
application-pref-handler
application-start-empty-handler)

1
collects/mred/private/mred.rkt
View File

@ -272,6 +272,7 @@
application-preferences-handler
application-quit-handler
application-file-handler
application-start-empty-handler
current-eventspace-has-standard-menus?
current-eventspace-has-menu-root?
eventspace-handler-thread

6
collects/mred/private/wx/cocoa/queue.rkt
View File

@ -47,6 +47,8 @@
(define app (tell NSApplication sharedApplication))
(define got-file? #f)
(define-objc-class MyApplicationDelegate NSObject #:protocols (NSApplicationDelegate)
[]
[-a _NSUInteger (applicationShouldTerminate: [_id app])
@ -72,7 +74,11 @@
(queue-about-event))
#t]
[-a _BOOL (application: [_id theApplication] openFile: [_NSString filename])
(set! got-file? #t)
(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?])
;; 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.

27
collects/mred/private/wx/common/handlers.rkt
View File

@ -2,6 +2,7 @@
(provide
(protect-out application-file-handler
application-start-empty-handler
application-quit-handler
application-about-handler
application-pref-handler
@ -10,8 +11,15 @@
nothing-application-about-handler))
(define saved-files null)
(define afh (lambda (f)
(set! saved-files (cons f saved-files))))
(define orig-afh (lambda (f)
(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
(case-lambda
[(proc)
@ -21,6 +29,21 @@
(for-each proc (reverse sf)))]
[() 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 application-quit-handler
(case-lambda

6
collects/mred/private/wx/common/queue.rkt
View File

@ -56,6 +56,7 @@
queue-prefs-event
queue-about-event
queue-file-event
queue-start-empty-event
begin-busy-cursor
end-busy-cursor
@ -582,6 +583,11 @@
((application-file-handler) file))
'med))
(define (queue-start-empty-event)
;; called in event-pump thread
(queue-event main-eventspace (application-start-empty-handler)
'med))
(define (begin-busy-cursor)
(let ([e (current-eventspace)])
(atomically

65
collects/scribblings/gui/system-menu-funcs.scrbl
View File

@ -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)
(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).
}
@defproc*[([(application-file-handler)
(path? . -> . any)]
[(application-file-handler [handler-proc (path? . -> . any)])
@defproc*[([(application-start-empty-handler)
(-> any)]
[(application-start-empty-handler [handler-thunk (-> 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.
retrieves or installs a thunk that is called when the user starts
the application on Mac OS X without supplying any initial files (e.g.,
by double-clicking the application icon instead of double-clicking
files that are handled by the application).
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.
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.
The default handler re-queues the handler event when the application
start-empty handler is later changed. As a result, if an application
sets both @racket[application-start-empty-handler] and
@racket[application-file-handler], then one or the other is
eventually called.
If the current eventspace is not the initial eventspace, this
procedure returns @racket[void] (when called with zero arguments)