diff --git a/collects/mred/mred-sig.rkt b/collects/mred/mred-sig.rkt index c06787aff7..f3bb5b34c0 100644 --- a/collects/mred/mred-sig.rkt +++ b/collects/mred/mred-sig.rkt @@ -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<%> diff --git a/collects/mred/private/app.rkt b/collects/mred/private/app.rkt index 73c10f28b8..1e9bfff177 100644 --- a/collects/mred/private/app.rkt +++ b/collects/mred/private/app.rkt @@ -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)) diff --git a/collects/mred/private/kernel.rkt b/collects/mred/private/kernel.rkt index fa2475b09f..ccd9ea7c7f 100644 --- a/collects/mred/private/kernel.rkt +++ b/collects/mred/private/kernel.rkt @@ -38,4 +38,5 @@ application-file-handler application-quit-handler application-about-handler - application-pref-handler) + application-pref-handler + application-start-empty-handler) diff --git a/collects/mred/private/mred.rkt b/collects/mred/private/mred.rkt index c8dbb48076..050e8bb5d4 100644 --- a/collects/mred/private/mred.rkt +++ b/collects/mred/private/mred.rkt @@ -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 diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index 672c4ffc99..725fd65708 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -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. diff --git a/collects/mred/private/wx/common/handlers.rkt b/collects/mred/private/wx/common/handlers.rkt index b62ea90170..7c57414d51 100644 --- a/collects/mred/private/wx/common/handlers.rkt +++ b/collects/mred/private/wx/common/handlers.rkt @@ -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 diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt index f887785414..c1c5903721 100644 --- a/collects/mred/private/wx/common/queue.rkt +++ b/collects/mred/private/wx/common/queue.rkt @@ -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 diff --git a/collects/scribblings/gui/system-menu-funcs.scrbl b/collects/scribblings/gui/system-menu-funcs.scrbl index 7f19bd9d8b..3475b37646 100644 --- a/collects/scribblings/gui/system-menu-funcs.scrbl +++ b/collects/scribblings/gui/system-menu-funcs.scrbl @@ -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)