cocoa: fix startup -psn_ and file handling

This commit is contained in:
Matthew Flatt 2010-10-24 11:17:45 -06:00
parent 3294d3427a
commit a7426c1c27
4 changed files with 76 additions and 20 deletions

View File

@ -1,6 +1,6 @@
(module app mzscheme (module app racket/base
(require mzlib/class (require racket/class
(prefix wx: "kernel.ss") (prefix-in wx: "kernel.ss")
"lock.ss" "lock.ss"
"helper.ss" "helper.ss"
"wx.ss" "wx.ss"
@ -50,7 +50,7 @@
(set! running-quit? #f)))))))))))]) (set! running-quit? #f)))))))))))])
(wx:application-quit-handler (make-app-handler f 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 (when proc
(unless (and (procedure? proc) (unless (and (procedure? proc)
(procedure-arity-includes? proc arity)) (procedure-arity-includes? proc arity))
@ -59,13 +59,14 @@
proc))) proc)))
(let ([e (wx:current-eventspace)]) (let ([e (wx:current-eventspace)])
(when (wx:main-eventspace? e) (when (wx:main-eventspace? e)
(param (make-app-handler (param (make-app-handler
(lambda args (lambda args
(parameterize ([wx:current-eventspace e]) (parameterize ([wx:current-eventspace e])
(wx:queue-callback (wx:queue-callback
(lambda () (result-filter (apply proc args))) (lambda () (result-filter (apply proc args)))
wx:middle-queue-key))) wx:middle-queue-key)))
proc))))) proc))
(post-set))))
(define application-preferences-handler (define application-preferences-handler
(case-lambda (case-lambda
@ -75,7 +76,8 @@
(set-handler! 'application-preferences-handler proc (set-handler! 'application-preferences-handler proc
wx:application-pref-handler wx:application-pref-handler
0 0
values)])) values
void)]))
(define application-about-handler (define application-about-handler
(case-lambda (case-lambda
@ -86,7 +88,8 @@
(set-handler! 'application-about-handler proc (set-handler! 'application-about-handler proc
wx:application-about-handler wx:application-about-handler
0 0
values)])) values
void)]))
(define application-quit-handler (define application-quit-handler
(case-lambda (case-lambda
@ -97,18 +100,33 @@
(set-handler! 'application-quit-handler proc (set-handler! 'application-quit-handler proc
wx:application-quit-handler wx:application-quit-handler
0 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 (define default-application-file-handler
(entry-point (entry-point
(lambda (f) (lambda (f)
(let ([af (weak-box-value active-main-frame)]) (let ([af (weak-box-value active-main-frame)])
(when af (if af
(queue-window-callback (queue-window-callback
af af
(entry-point (entry-point
(lambda () (when (send af accept-drag?) (lambda () (if (send af accept-drag?)
(send af on-drop-file f)))))))))) (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) (define (install-defh)
(wx:application-file-handler (make-app-handler (wx:application-file-handler (make-app-handler
@ -129,7 +147,8 @@
(set-handler! 'application-file-handler proc (set-handler! 'application-file-handler proc
wx:application-file-handler wx:application-file-handler
1 1
values))])) values
requeue-saved-files))]))
(define (current-eventspace-has-standard-menus?) (define (current-eventspace-has-standard-menus?)

View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(provide application-file-handler (provide application-file-handler
application-quit-handler application-quit-handler
@ -7,10 +7,16 @@
nothing-application-pref-handler) 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 (define application-file-handler
(case-lambda (case-lambda
[(proc) (set! afh proc)] [(proc)
(set! afh proc)
(let ([sf saved-files])
(set! saved-files null)
(for-each proc (reverse sf)))]
[() afh])) [() afh]))
(define aqh void) (define aqh void)

View File

@ -113,7 +113,9 @@ When the current eventspace is the initial eventspace, this procedure
The default handler queues a callback to the 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 @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 @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 When the application is @italic{not} running and user double-clicks an
application-handled file or drags a file onto the application's icon, application-handled file or drags a file onto the application's icon,

View File

@ -25,6 +25,11 @@ static char *get_gr_init_filename(struct Scheme_Env *env);
static void pre_filter_cmdline_arguments(int *argc, char ***argv); static void pre_filter_cmdline_arguments(int *argc, char ***argv);
#endif #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 UNIX_INIT_FILENAME "~/.gracketrc"
#define WINDOWS_INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\gracketrc.rktd" #define WINDOWS_INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\gracketrc.rktd"
#define MACOS9_INIT_FILENAME "PREFERENCES:gracketrc.rktd" #define MACOS9_INIT_FILENAME "PREFERENCES:gracketrc.rktd"
@ -863,3 +868,27 @@ static void pre_filter_cmdline_arguments(int *argc, char ***argv)
} }
#endif #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