gtk: on-activate and single-instance fixes

This commit is contained in:
Matthew Flatt 2010-10-18 16:44:49 -06:00
parent 3ae3d15d93
commit c4ab7733c1
3 changed files with 32 additions and 2 deletions

View File

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

View File

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

View File

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