From c4ab7733c131676079fb6ed6c29c7b22ec20baca Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 18 Oct 2010 16:44:49 -0600
Subject: [PATCH] gtk: on-activate and single-instance fixes

---
 collects/mred/private/wx/gtk/frame.rkt  | 17 +++++++++++++++++
 collects/mred/private/wx/gtk/unique.rkt | 15 +++++++++++++--
 collects/mred/private/wx/gtk/window.rkt |  2 ++
 3 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt
index 061e3b4165..c9be2bc22a 100644
--- a/collects/mred/private/wx/gtk/frame.rkt
+++ b/collects/mred/private/wx/gtk/frame.rkt
@@ -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)
diff --git a/collects/mred/private/wx/gtk/unique.rkt b/collects/mred/private/wx/gtk/unique.rkt
index 9ab6255d12..ca139be8a7 100644
--- a/collects/mred/private/wx/gtk/unique.rkt
+++ b/collects/mred/private/wx/gtk/unique.rkt
@@ -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)))))
diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt
index f68f784a5c..bfa81ac86b 100644
--- a/collects/mred/private/wx/gtk/window.rkt
+++ b/collects/mred/private/wx/gtk/window.rkt
@@ -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)