diff --git a/collects/mred/private/app.rkt b/collects/mred/private/app.rkt index 67948560..c546ae87 100644 --- a/collects/mred/private/app.rkt +++ b/collects/mred/private/app.rkt @@ -1,6 +1,6 @@ -(module app mzscheme - (require mzlib/class - (prefix wx: "kernel.ss") +(module app racket/base + (require racket/class + (prefix-in wx: "kernel.ss") "lock.ss" "helper.ss" "wx.ss" @@ -50,7 +50,7 @@ (set! running-quit? #f)))))))))))]) (wx:application-quit-handler (make-app-handler f f))) - (define (set-handler! who proc param arity result-filter) + (define (set-handler! who proc param arity result-filter post-set) (when proc (unless (and (procedure? proc) (procedure-arity-includes? proc arity)) @@ -59,13 +59,14 @@ proc))) (let ([e (wx:current-eventspace)]) (when (wx:main-eventspace? e) - (param (make-app-handler + (param (make-app-handler (lambda args (parameterize ([wx:current-eventspace e]) (wx:queue-callback (lambda () (result-filter (apply proc args))) wx:middle-queue-key))) - proc))))) + proc)) + (post-set)))) (define application-preferences-handler (case-lambda @@ -75,7 +76,8 @@ (set-handler! 'application-preferences-handler proc wx:application-pref-handler 0 - values)])) + values + void)])) (define application-about-handler (case-lambda @@ -86,7 +88,8 @@ (set-handler! 'application-about-handler proc wx:application-about-handler 0 - values)])) + values + void)])) (define application-quit-handler (case-lambda @@ -97,18 +100,33 @@ (set-handler! 'application-quit-handler proc wx:application-quit-handler 0 - (lambda (v) (unless v (wx:cancel-quit)) v))])) + (lambda (v) (unless v (wx:cancel-quit)) v) + void)])) + + (define saved-files null) (define default-application-file-handler (entry-point (lambda (f) (let ([af (weak-box-value active-main-frame)]) - (when af - (queue-window-callback - af - (entry-point - (lambda () (when (send af accept-drag?) - (send af on-drop-file f)))))))))) + (if af + (queue-window-callback + af + (entry-point + (lambda () (if (send af accept-drag?) + (send af on-drop-file f) + (set! saved-files (cons f saved-files)))))) + (set! saved-files (cons f saved-files))))))) + + (define (requeue-saved-files) + (as-entry + (lambda () + (for-each (lambda (f) + (wx:queue-callback (lambda () + ((wx:application-file-handler) f)) + wx:middle-queue-key)) + (reverse saved-files)) + (set! saved-files null)))) (define (install-defh) (wx:application-file-handler (make-app-handler @@ -129,7 +147,8 @@ (set-handler! 'application-file-handler proc wx:application-file-handler 1 - values))])) + values + requeue-saved-files))])) (define (current-eventspace-has-standard-menus?) diff --git a/collects/mred/private/wx/common/handlers.rkt b/collects/mred/private/wx/common/handlers.rkt index e8048f0f..9fad1616 100644 --- a/collects/mred/private/wx/common/handlers.rkt +++ b/collects/mred/private/wx/common/handlers.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide application-file-handler application-quit-handler @@ -7,10 +7,16 @@ nothing-application-pref-handler) -(define afh void) +(define saved-files null) +(define afh (lambda (f) + (set! saved-files (cons f saved-files)))) (define application-file-handler (case-lambda - [(proc) (set! afh proc)] + [(proc) + (set! afh proc) + (let ([sf saved-files]) + (set! saved-files null) + (for-each proc (reverse sf)))] [() afh])) (define aqh void) diff --git a/collects/scribblings/gui/system-menu-funcs.scrbl b/collects/scribblings/gui/system-menu-funcs.scrbl index 43904445..5051b9e4 100644 --- a/collects/scribblings/gui/system-menu-funcs.scrbl +++ b/collects/scribblings/gui/system-menu-funcs.scrbl @@ -113,7 +113,9 @@ When the current eventspace is the initial eventspace, this procedure 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 @scheme[get-top-level-edit-target-window]), if - drag-and-drop is enabled for that frame. + 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,