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
(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))
@ -65,7 +65,8 @@
(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
(if af
(queue-window-callback
af
(entry-point
(lambda () (when (send af accept-drag?)
(send af on-drop-file f))))))))))
(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?)

View File

@ -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)

View File

@ -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,

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);
#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