From a7426c1c2744dc71a8738e3c20bafcc8c0b2d115 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 24 Oct 2010 11:17:45 -0600 Subject: [PATCH] cocoa: fix startup -psn_ and file handling --- collects/mred/private/app.rkt | 51 +++++++++++++------ collects/mred/private/wx/common/handlers.rkt | 12 +++-- .../scribblings/gui/system-menu-funcs.scrbl | 4 +- src/gracket/grmain.c | 29 +++++++++++ 4 files changed, 76 insertions(+), 20 deletions(-) diff --git a/collects/mred/private/app.rkt b/collects/mred/private/app.rkt index 67948560e3..c546ae878b 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 e8048f0fff..9fad1616f2 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 4390444554..5051b9e4ab 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, diff --git a/src/gracket/grmain.c b/src/gracket/grmain.c index 22f82f505a..7ddf74002c 100644 --- a/src/gracket/grmain.c +++ b/src/gracket/grmain.c @@ -25,6 +25,11 @@ static char *get_gr_init_filename(struct Scheme_Env *env); static void pre_filter_cmdline_arguments(int *argc, char ***argv); #endif +#ifdef wx_mac +# define PRE_FILTER_CMDLINE_ARGUMENTS +static void pre_filter_cmdline_arguments(int *argc, char ***argv); +#endif + #define UNIX_INIT_FILENAME "~/.gracketrc" #define WINDOWS_INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\gracketrc.rktd" #define MACOS9_INIT_FILENAME "PREFERENCES:gracketrc.rktd" @@ -863,3 +868,27 @@ static void pre_filter_cmdline_arguments(int *argc, char ***argv) } #endif + +/***********************************************************************/ +/* Mac OS X flag handling */ +/***********************************************************************/ + +#ifdef wx_mac + +static void pre_filter_cmdline_arguments(int *argc, char ***argv) + XFORM_SKIP_PROC +{ + if ((*argc > 1) && !strncmp((*argv)[1], "-psn_", 5)) { + /* Finder adds "-psn_" when you double-click on the application. + Drop it. */ + char **new_argv; + new_argv = (char **)malloc(((*argc) - 1) * sizeof(char *)); + new_argv[0] = (*argv)[0]; + memcpy(new_argv + 1, (*argv) + 2, ((*argc) - 2) * sizeof(char *)); + (*argc)--; + *argv = new_argv; + } +} + +#endif +