diff --git a/gui-doc/scribblings/gui/libs.scrbl b/gui-doc/scribblings/gui/libs.scrbl index 8688ace9..d5283eb6 100644 --- a/gui-doc/scribblings/gui/libs.scrbl +++ b/gui-doc/scribblings/gui/libs.scrbl @@ -19,5 +19,5 @@ either case: @item{@filepath{libgtk-3.0[.0]} (GTK+ 3) or @filepath{libgtk-x11-2.0[.0]} (GTK+ 2)} @item{@filepath{libgio-2.0[.0]} --- optional, for detecting interface scaling} @item{@filepath{libGL[.1]} --- optional, for OpenGL support} - @item{@filepath{libunique-1.0[.0]} --- optional, for single-instance support} + @item{@filepath{libunique-1.0[.0]} --- optional, for single-instance support (GTK+ 2)} ] diff --git a/gui-lib/mred/private/wx/gtk/unique.rkt b/gui-lib/mred/private/wx/gtk/unique.rkt index 9be84435..72b03d59 100644 --- a/gui-lib/mred/private/wx/gtk/unique.rkt +++ b/gui-lib/mred/private/wx/gtk/unique.rkt @@ -10,6 +10,9 @@ (provide (protect-out do-single-instance)) +;; ---------------------------------------- +;; Old-style -singleInstance support lith libunqiue + (define unique-lib-name "libunique-1.0") (define unique-lib @@ -56,14 +59,90 @@ (exn-message exn))))]) (let* ([p (open-input-bytes d)] [vec (read p)]) - (for-each - queue-file-event - (map (lambda (s) (if (bytes? s) - (bytes->path s) - (string->path s))) - (vector->list vec)))))) + (handle-argv vec)))) UNIQUE_RESPONSE_OK)) +(define (send-command-line app) + (let ([msg (unique_message_data_new)] + [b (let ([o (open-output-bytes)]) + (write (for/vector ([p (in-vector (current-command-line-arguments))]) + (define cp (path->complete-path p)) + (define s (path->string cp)) + (if (equal? cp (string->path s)) + s + ;; can't represent as string; use bytes + (path->bytes cp))) + 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/libunique) + (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))) + (void (connect-message-received app))))) + +;; ---------------------------------------- +;; New-style -singleInstance support lith Gtk + +(define _GtkApplication _GtkWidget) ; (_cpointer/null 'GtkApplication) +(define _GApplicationCommandLine (_cpointer 'GApplicationCommandLine)) + +(define-gtk gtk_application_new (_fun _string _int -> _GtkApplication) + #:fail (lambda () #f)) + +(define-gdk g_application_get_is_remote (_fun _GtkApplication -> _gboolean)) +(define-gdk g_application_run (_fun _GtkApplication _int (_vector i _string) -> _gboolean)) +(define-gdk g_application_command_line_get_arguments + (_fun _GApplicationCommandLine (n : (_ptr o _int)) -> (p : _pointer) -> (values p n))) +(define-gdk g_strfreev (_fun _pointer -> _void)) + +(define-signal-handler connect-activate "activate" + (_fun _GtkApplication -> _void) + (lambda (app) + (void))) + +(define-signal-handler connect-command-line "command-line" + (_fun _GtkApplication _GApplicationCommandLine -> _void) + (lambda (app cmdline) + (define-values (args n) (g_application_command_line_get_arguments cmdline)) + (define argv (cast args _pointer (_vector o _string n))) + (g_strfreev args) + (handle-argv argv))) + +(define APPLICATION_HANDLES_COMMAND_LINE 8) + +(define (do-single-instance/gtk) + (define app (gtk_application_new (build-app-name) APPLICATION_HANDLES_COMMAND_LINE)) + (when app + (define args (for/vector ([i (current-command-line-arguments)]) + (path->string (path->complete-path i)))) + (g_application_run app (vector-length args) args) + (when (g_application_get_is_remote app) + (exit 0)) + (connect-activate app) + (connect-command-line app))) + +;; ---------------------------------------- + +(define (do-single-instance) + (if gtk_application_new + (do-single-instance/gtk) + (do-single-instance/libunique))) + +(define (handle-argv vec) + (for-each + queue-file-event + (map (lambda (s) (if (bytes? s) + (bytes->path s) + (string->path s))) + (vector->list vec)))) + (define-mz gethostname (_fun _pointer _long -> _int) #:fail (lambda () #f)) @@ -87,28 +166,3 @@ (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 (for/vector ([p (in-vector (current-command-line-arguments))]) - (define cp (path->complete-path p)) - (define s (path->string cp)) - (if (equal? cp (string->path s)) - s - ;; can't represent as string; use bytes - (path->bytes cp))) - 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))) - (void (connect-message-received app)))))