115 lines
4.3 KiB
Racket
115 lines
4.3 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
racket/draw/unsafe/bstr
|
|
net/base64
|
|
"../common/queue.rkt"
|
|
"types.rkt"
|
|
"utils.rkt")
|
|
|
|
(provide
|
|
(protect-out do-single-instance))
|
|
|
|
(define unique-lib-name "libunique-1.0")
|
|
|
|
(define unique-lib
|
|
(with-handlers ([exn:fail? (lambda (exn) #f)])
|
|
(ffi-lib unique-lib-name '("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
|
|
(unless unique-lib
|
|
(log-error "~s not found; single-instance mode disabled"
|
|
unique-lib-name))
|
|
#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)
|
|
(let ([d (unique_message_data_get data)])
|
|
(with-handlers ([exn:fail? (lambda (exn)
|
|
(log-error
|
|
(format "error handling single-instance message: ~s"
|
|
(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))))))
|
|
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 (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)))))
|