gtk: on-activate and single-instance fixes
This commit is contained in:
parent
3ae3d15d93
commit
c4ab7733c1
|
@ -175,6 +175,7 @@
|
|||
|
||||
(connect-delete gtk)
|
||||
(connect-configure gtk)
|
||||
(connect-focus gtk)
|
||||
|
||||
(define saved-title (or label ""))
|
||||
(define is-modified? #f)
|
||||
|
@ -354,6 +355,22 @@
|
|||
(gtk_window_set_icon_list gtk l)
|
||||
(g_list_free l))))))
|
||||
|
||||
(define child-has-focus? #f)
|
||||
(define reported-activate #f)
|
||||
(define queued-active? #f)
|
||||
(define/public (on-focus-child on?)
|
||||
;; atomic mode
|
||||
(set! child-has-focus? on?)
|
||||
(unless queued-active?
|
||||
(set! queued-active? #t)
|
||||
(queue-window-event this
|
||||
(lambda ()
|
||||
(let ([on? child-has-focus?])
|
||||
(set! queued-active? #f)
|
||||
(unless (eq? on? reported-activate)
|
||||
(set! reported-activate on?)
|
||||
(on-activate on?)))))))
|
||||
|
||||
(define/override (call-pre-on-event w e)
|
||||
(pre-on-event w e))
|
||||
(define/override (call-pre-on-char w e)
|
||||
|
|
|
@ -3,6 +3,7 @@
|
|||
ffi/unsafe/define
|
||||
racket/draw/bstr
|
||||
net/base64
|
||||
"../common/queue.rkt"
|
||||
"types.rkt"
|
||||
"utils.rkt")
|
||||
|
||||
|
@ -41,6 +42,16 @@
|
|||
(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 string->path (vector->list vec))))))
|
||||
UNIQUE_RESPONSE_OK))
|
||||
|
||||
(define-mz gethostname (_fun _pointer _long -> _int)
|
||||
|
@ -65,7 +76,7 @@
|
|||
(format "~a~a~a" host path (version)))))))
|
||||
|
||||
(define (encode s)
|
||||
(regexp-replace* #rx"\r\n" (base64-encode (string->bytes/utf-8 s)) ""))
|
||||
(regexp-replace* #rx"=|\r\n" (base64-encode (string->bytes/utf-8 s)) ""))
|
||||
|
||||
(define (send-command-line app)
|
||||
(let ([msg (unique_message_data_new)]
|
||||
|
@ -83,4 +94,4 @@
|
|||
(when (= (send-command-line app)
|
||||
UNIQUE_RESPONSE_OK)
|
||||
(exit 0)))
|
||||
(connect-message-received app))))
|
||||
(void (connect-message-received app)))))
|
||||
|
|
|
@ -129,6 +129,7 @@
|
|||
(lambda (gtk event)
|
||||
(let ([wx (gtk->wx gtk)])
|
||||
(when wx
|
||||
(send (send wx get-top-win) on-focus-child #t)
|
||||
(queue-window-event wx (lambda () (send wx on-set-focus))))
|
||||
#f)))
|
||||
(define-signal-handler connect-focus-out "focus-out-event"
|
||||
|
@ -136,6 +137,7 @@
|
|||
(lambda (gtk event)
|
||||
(let ([wx (gtk->wx gtk)])
|
||||
(when wx
|
||||
(send (send wx get-top-win) on-focus-child #f)
|
||||
(queue-window-event wx (lambda () (send wx on-kill-focus))))
|
||||
#f)))
|
||||
(define (connect-focus gtk)
|
||||
|
|
Loading…
Reference in New Issue
Block a user