From 045da06ace116be7a2da466d6565b885cb006be1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 17 Oct 2010 12:01:53 -0600 Subject: [PATCH] gtk: command line and single-instance support --- collects/mred/private/wx/common/queue.rkt | 4 +- collects/mred/private/wx/gtk/init.rkt | 3 - collects/mred/private/wx/gtk/queue.rkt | 62 +++++++++++++- collects/mred/private/wx/gtk/unique.rkt | 86 +++++++++++++++++++ src/gracket/grmain.c | 100 ++++++++++++++++++++++ src/racket/main.c | 49 ++++++----- src/racket/src/thread.c | 6 +- 7 files changed, 278 insertions(+), 32 deletions(-) create mode 100644 collects/mred/private/wx/gtk/unique.rkt diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt index 1383e84276..5f717ea357 100644 --- a/collects/mred/private/wx/common/queue.rkt +++ b/collects/mred/private/wx/common/queue.rkt @@ -50,7 +50,9 @@ begin-busy-cursor end-busy-cursor - is-busy?) + is-busy? + + scheme_register_process_global) ;; ------------------------------------------------------------ ;; This module must be instantiated only once: diff --git a/collects/mred/private/wx/gtk/init.rkt b/collects/mred/private/wx/gtk/init.rkt index 190be27f3e..ba601aeb08 100644 --- a/collects/mred/private/wx/gtk/init.rkt +++ b/collects/mred/private/wx/gtk/init.rkt @@ -5,8 +5,6 @@ "queue.rkt") (unsafe!) -(define-gtk gtk_init (_fun (_ptr io _int) (_ptr io _pointer) -> _void)) - (define-gtk gtk_rc_parse_string (_fun _string -> _void)) (define-gtk gtk_rc_add_default_file (_fun _path -> _void)) (define-gtk gtk_rc_find_module_in_path (_fun _path -> _path)) @@ -17,6 +15,5 @@ (gtk_rc_parse_string (format "module_path \"~a\"\n" dir)) (gtk_rc_add_default_file (build-path dir "gtkrc")))) -(gtk_init 0 #f) (define pump-thread (gtk-start-event-pump)) diff --git a/collects/mred/private/wx/gtk/queue.rkt b/collects/mred/private/wx/gtk/queue.rkt index 332c7c3d8d..a8c4113461 100644 --- a/collects/mred/private/wx/gtk/queue.rkt +++ b/collects/mred/private/wx/gtk/queue.rkt @@ -7,7 +7,8 @@ "../common/queue.rkt" "../common/freeze.rkt" "const.rkt" - "w32.rkt") + "w32.rkt" + "unique.rkt") (provide gtk-start-event-pump @@ -20,12 +21,65 @@ queue-event yield) + +;; ------------------------------------------------------------ +;; Gtk initialization + +(define-gtk gtk_init_check (_fun (_ptr io _int) (_ptr io _gcpointer) -> _gboolean)) + +(let* ([argc-ptr (scheme_register_process_global "PLT_X11_ARGUMENT_COUNT" #f)] + [argc (or (and argc-ptr (cast argc-ptr _pointer _long)) 0)] + [argv (and (positive? argc) + (scheme_register_process_global "PLT_X11_ARGUMENTS" #f))] + [display (getenv "DISPLAY")]) + ;; Convert X11 arguments, if any, to Gtk form: + (let-values ([(args single-instance?) + (if (zero? argc) + (values null #f) + (let loop ([i 1][si? #f]) + (if (= i argc) + (values null si?) + (let ([s (ptr-ref argv _bytes i)]) + (cond + [(bytes=? s #"-display") + (let-values ([(args si?) (loop (+ i 2) si?)] + [(d) (ptr-ref argv _bytes (add1 i))]) + (set! display (bytes->string/utf-8 d #\?)) + (values (list* #"--display" d args) + si?))] + [(bytes=? s #"-synchronous") + (let-values ([(args si?) (loop (+ i 1) si?)]) + (values (cons #"--sync" args) + si?))] + [(bytes=? s #"-singleInstance") + (loop (add1 i) #t)] + [(or (bytes=? s #"-iconic") + (bytes=? s #"-rv") + (bytes=? s #"+rv") + (bytes=? s #"-reverse")) + ;; ignored with 0 arguments + (loop (add1 i) #t)] + [else + ;; all other ignored flags have a single argument + (loop (+ i 2) #t)])))))]) + (let-values ([(new-argc new-argv) + (if (null? args) + (values 0 #f) + (values (add1 (length args)) + (cast (cons (ptr-ref argv _bytes 0) + args) + (_list i _bytes) + _pointer)))]) + (unless (gtk_init_check new-argc new-argv) + (error (format + "Gtk initialization failed for display ~s" + (or display ":0")))) + (when single-instance? + (do-single-instance))))) + ;; ------------------------------------------------------------ ;; Gtk event pump -(define-gtk gtk_init (_fun _int _pointer -> _void)) -(gtk_init 0 #f) - (define-gtk gtk_events_pending (_fun -> _gboolean)) (define-gtk gtk_main_iteration_do (_fun _gboolean -> _gboolean)) diff --git a/collects/mred/private/wx/gtk/unique.rkt b/collects/mred/private/wx/gtk/unique.rkt new file mode 100644 index 0000000000..9ab6255d12 --- /dev/null +++ b/collects/mred/private/wx/gtk/unique.rkt @@ -0,0 +1,86 @@ +#lang racket/base +(require ffi/unsafe + ffi/unsafe/define + racket/draw/bstr + net/base64 + "types.rkt" + "utils.rkt") + +(provide do-single-instance) + +(define unique-lib + (with-handlers ([exn:fail? (lambda (exn) #f)]) + (ffi-lib "libunique-1.0" '("0")))) + +(define-ffi-definer define-unique unique-lib + #:default-make-fail make-not-available) + +(define _gsize _ulong) + +(define UNIQUE_RESPONSE_OK 1) + +(define _UniqueApp _GtkWidget) ; not a widget, but we want to connect a signal +(define _UniqueMessageData (_cpointer 'UniqueMessageData)) + +(define-unique unique_app_new (_fun _string _string -> _UniqueApp) + #:fail (lambda () (lambda args #f))) +(define-unique unique_app_add_command (_fun _UniqueApp _string _int -> _void)) +(define-unique unique_app_is_running (_fun _UniqueApp -> _gboolean)) +(define-unique unique_app_send_message (_fun _UniqueApp _int _UniqueMessageData -> _int)) + +(define-unique unique_message_data_new (_fun -> _UniqueMessageData)) +(define-unique unique_message_data_free (_fun _UniqueMessageData -> _void)) +(define-unique unique_message_data_set (_fun _UniqueMessageData _pointer _gsize -> _void)) +(define-unique unique_message_data_get (_fun _UniqueMessageData (len : (_ptr o _gsize)) + -> (data : _bytes) + -> (scheme_make_sized_byte_string + data + len + 0))) + +(define-signal-handler connect-message-received "message-received" + (_fun _UniqueApp _int _UniqueMessageData _uint -> _int) + (lambda (app cmd data time) + UNIQUE_RESPONSE_OK)) + +(define-mz gethostname (_fun _pointer _long -> _int) + #:fail (lambda () #f)) + +(define HOSTLEN 256) + +(define (build-app-name) + (let-values ([(path) (simplify-path + (path->complete-path + (or (find-executable-path (find-system-path 'run-file) #f) + (find-system-path 'run-file)) + (current-directory)))] + [(host) (or (and gethostname + (let ([b (make-bytes HOSTLEN)]) + (and (zero? (gethostname b HOSTLEN)) + (bytes->string/utf-8 (car (regexp-match #rx#"^[^\0]*" b)) #\?)))) + "")]) + (string->bytes/utf-8 + (format "org.racket-lang.~a" + (encode + (format "~a~a~a" host path (version))))))) + +(define (encode s) + (regexp-replace* #rx"\r\n" (base64-encode (string->bytes/utf-8 s)) "")) + +(define (send-command-line app) + (let ([msg (unique_message_data_new)] + [b (let ([o (open-output-bytes)]) + (write (current-command-line-arguments) o) + (get-output-bytes o))]) + (unique_message_data_set msg b (bytes-length b)) + (unique_app_send_message app 42 msg))) + +(define (do-single-instance) + (let ([app (unique_app_new (build-app-name) #f)]) + (when app + (unique_app_add_command app "startup" 42) + (when (unique_app_is_running app) + (when (= (send-command-line app) + UNIQUE_RESPONSE_OK) + (exit 0))) + (connect-message-received app)))) diff --git a/src/gracket/grmain.c b/src/gracket/grmain.c index 17b4247795..e9f2db6feb 100644 --- a/src/gracket/grmain.c +++ b/src/gracket/grmain.c @@ -18,6 +18,11 @@ static int wx_in_terminal = 0; struct Scheme_Env; static char *get_gr_init_filename(struct Scheme_Env *env); +#ifdef wx_xt +# 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" @@ -93,8 +98,16 @@ static void yield_indefinitely() #endif } +/***********************************************************************/ +/* Win32 handling */ +/***********************************************************************/ + #ifdef WIN32 +/* ---------------------------------------- */ +/* stdio to console */ +/* ---------------------------------------- */ + static void MrEdSchemeMessages(char *, ...); static Scheme_Object *stdin_pipe; @@ -495,6 +508,10 @@ static int parse_command_line(char ***_command, char *buf) return count; } +/* ---------------------------------------- */ +/* command-line parsing */ +/* ---------------------------------------- */ + int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored, int nCmdShow) { LPWSTR m_lpCmdLine; @@ -582,3 +599,86 @@ END_XFORM_SKIP; # endif #endif + +/***********************************************************************/ +/* X11 flag handling */ +/***********************************************************************/ + +#ifdef wx_xt + +typedef struct { + char *flag; + int arg_count; +} X_flag_entry; + +#define SINGLE_INSTANCE "-singleInstance" + +X_flag_entry X_flags[] = { + { "-display", 1 }, + { "-geometry", 1 }, + { "-bg", 1 }, + { "-background", 1 }, + { "-fg", 1 }, + { "-foreground", 1 }, + { "-fn", 1 }, + { "-font", 1 }, + { "-iconic", 0 }, + { "-name", 1 }, + { "-rv", 0 }, + { "-reverse", 0 }, + { "+rv", 0 }, + { "-selectionTimeout", 1 }, + { "-synchronous", 0 }, + { "-title", 1 }, + { "-xnllanguage", 1 }, + { "-xrm", 1 }, + { SINGLE_INSTANCE, 0}, + { NULL, 0 } +}; + +static int filter_x_readable(char **argv, int argc) + XFORM_SKIP_PROC +{ + int pos = 1, i; + + while (pos < argc) { + for (i = 0; X_flags[i].flag; i++) { + if (!strcmp(X_flags[i].flag, argv[pos])) + break; + } + + if (!X_flags[i].flag) + return pos; + else { + int newpos = pos + X_flags[i].arg_count + 1; + if (newpos > argc) { + printf("%s: X Window System flag \"%s\" expects %d arguments, %d provided\n", + argv[0], argv[pos], X_flags[i].arg_count, argc - pos - 1); + exit(-1); + } + pos = newpos; + } + } + + return pos; +} + +static void pre_filter_cmdline_arguments(int *argc, char ***argv) + XFORM_SKIP_PROC +{ + int pos; + char **naya; + + pos = filter_x_readable(*argv, *argc); + if (pos > 1) { + scheme_register_process_global("PLT_X11_ARGUMENT_COUNT", (void *)(long)pos); + scheme_register_process_global("PLT_X11_ARGUMENTS", *argv); + naya = malloc((*argc - (pos - 1)) * sizeof(char *)); + memcpy(naya, *argv + (pos - 1), (*argc - (pos - 1)) * sizeof(char *)); + naya[0] = (*argv)[0]; + *argv = naya; + *argc -= (pos - 1); + } +} + +#endif diff --git a/src/racket/main.c b/src/racket/main.c index adc917133b..7dca2c4e13 100644 --- a/src/racket/main.c +++ b/src/racket/main.c @@ -307,37 +307,42 @@ static int main_after_stack(void *data) #endif #ifdef WINDOWS_UNICODE_MAIN - { - char *a; - int i, j, l; - argv = (char **)malloc(sizeof(char*)*argc); - for (i = 0; i < argc; i++) { - for (j = 0; wargv[i][j]; j++) { - } - l = scheme_utf8_encode((unsigned int*)wargv[i], 0, j, - NULL, 0, - 1 /* UTF-16 */); - a = malloc(l + 1); - scheme_utf8_encode((unsigned int *)wargv[i], 0, j, - (unsigned char *)a, 0, - 1 /* UTF-16 */); - a[l] = 0; - argv[i] = a; - } - } + { + char *a; + int i, j, l; + argv = (char **)malloc(sizeof(char*)*argc); + for (i = 0; i < argc; i++) { + for (j = 0; wargv[i][j]; j++) { + } + l = scheme_utf8_encode((unsigned int*)wargv[i], 0, j, + NULL, 0, + 1 /* UTF-16 */); + a = malloc(l + 1); + scheme_utf8_encode((unsigned int *)wargv[i], 0, j, + (unsigned char *)a, 0, + 1 /* UTF-16 */); + a[l] = 0; + argv[i] = a; + } + } #endif + #if !defined(NO_USER_BREAK_HANDLER) || defined(DOS_FILE_SYSTEM) - break_handle = scheme_get_main_thread_break_handle(); - signal_handle = scheme_get_signal_handle(); + break_handle = scheme_get_main_thread_break_handle(); + signal_handle = scheme_get_signal_handle(); # ifndef NO_USER_BREAK_HANDLER - MZ_SIGSET(SIGINT, user_break_hit); + MZ_SIGSET(SIGINT, user_break_hit); # endif # ifdef DOS_FILE_SYSTEM - SetConsoleCtrlHandler(ConsoleBreakHandler, TRUE); + SetConsoleCtrlHandler(ConsoleBreakHandler, TRUE); # endif #endif +#ifdef PRE_FILTER_CMDLINE_ARGUMENTS + pre_filter_cmdline_arguments(&argc, &MAIN_argv); +#endif + rval = run_from_cmd_line(argc, argv, scheme_basic_env, cont_run); #ifndef DEFER_EXPLICIT_EXIT diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index e678d9aafe..ce562c9cb0 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -2553,7 +2553,8 @@ void *scheme_register_process_global(const char *key, void *val) long len; #if defined(MZ_USE_MZRT) - mzrt_mutex_lock(process_global_lock); + if (process_global_lock) + mzrt_mutex_lock(process_global_lock); #endif for (pg = process_globals; pg; pg = pg->next) { @@ -2575,7 +2576,8 @@ void *scheme_register_process_global(const char *key, void *val) } #if defined(MZ_USE_MZRT) - mzrt_mutex_unlock(process_global_lock); + if (process_global_lock) + mzrt_mutex_unlock(process_global_lock); #endif return old_val;