focus callbacks

collects/mred/private/wx/cocoa/canvas.rkt

@@ -40,7 +40,7 @@
               (CGContextFillRect cg (make-NSRect (make-NSPoint 0 0)
                                                  (make-NSSize 32000 32000))))
             (tellv ctx restoreGraphicsState))))
-      (send wx refresh))
+      (send wx queue-paint))
   (-a _void (viewWillMoveToWindow: [_id w])
       (when wx
         (queue-window-event wx (lambda () (send wx fix-dc)))))
@@ -77,7 +77,7 @@
     (define canvas-style style)
 
     (define paint-queued? #f)
-    (define/override (refresh)
+    (define/public (queue-paint)
       ;; can be called from any thread, including the event-pump thread
       (unless paint-queued?
         (set! paint-queued? #t)
@@ -85,6 +85,9 @@
                                    (set! paint-queued? #f)
                                    (on-paint)))))
 
+    (define/override (refresh)
+      (tellv content-cocoa setNeedsDisplay: #:type _BOOL #t))
+
     (define/override (get-cocoa-content) content-cocoa)
 
     (super-new 
@@ -108,7 +111,7 @@
 
     (define dc (make-object dc% (make-graphics-context) 0 0 10 10))
 
-    (refresh)
+    (queue-paint)
     
     (define/public (get-dc) dc)
 

collects/mred/private/wx/cocoa/window.rkt

@@ -266,7 +266,7 @@
     (define/public (set-focus)
       (let ([w (tell cocoa window)])
         (when w
-          (tellv w makeFirstResponder: cocoa))))
+          (tellv w makeFirstResponder: (get-cocoa-content)))))
     (define/public (on-set-focus) (void))
     (define/public (on-kill-focus) (void))
 

collects/mred/private/wx/gtk/window.rkt

@@ -52,7 +52,8 @@
 (define-gtk gtk_widget_size_request (_fun _GtkWidget _GtkRequisition-pointer -> _void))
 (define-gtk gtk_widget_size_allocate (_fun _GtkWidget _GtkAllocation-pointer -> _void))
 (define-gtk gtk_widget_set_size_request (_fun _GtkWidget _int _int -> _void))
-(define-gtk gtk_widget_grab_focus (_fun _GtkWidget -> _gboolean))
+(define-gtk gtk_widget_grab_focus (_fun _GtkWidget -> _void))
+(define-gtk gtk_widget_is_focus (_fun _GtkWidget -> _gboolean))
 (define-gtk gtk_widget_set_sensitive (_fun _GtkWidget _gboolean -> _void))
 
 ;; ----------------------------------------
@@ -105,6 +106,8 @@
 (define-signal-handler connect-button-press "button-press-event"
   (_fun _GtkWidget _GdkEventButton-pointer -> _gboolean)
   (lambda (gtk event)
+    (unless (gtk_widget_is_focus gtk)
+      (gtk_widget_grab_focus gtk))
     (do-button-event gtk event #f #f)))
 
 (define-signal-handler connect-button-release "button-release-event"
@@ -288,7 +291,7 @@
     (define/public (drag-accept-files on?) (void))
 
     (define/public (set-focus)
-      (gtk_widget_grab_focus gtk))
+      (gtk_widget_grab_focus (get-client-gtk)))
 
     (define/public (set-cursor v)
       (void))

collects/mred/private/wxcanvas.rkt

@@ -215,7 +215,9 @@
             #t
             (make-editor-canvas% (make-control% wx:editor-canvas%
                                                 0 0 #t #t)))
-      (inherit editor-canvas-on-scroll)
+      (inherit editor-canvas-on-scroll
+               set-no-expose-focus)
       (define/override (on-scroll e)
         (editor-canvas-on-scroll))
-      (super-new))))
+      (super-new)
+      (set-no-expose-focus))))

collects/mred/private/wxwindow.rkt

@@ -180,7 +180,10 @@
        [old-w -1]
        [old-h -1]
        [old-x -1]
-       [old-y -1])
+       [old-y -1]
+       [expose-focus? #t])
+      (public
+        [set-no-expose-focus (lambda () (set! expose-focus? #f))])
       (override
 	[on-drop-file (entry-point
 		       (lambda (f)
@@ -210,6 +213,12 @@
 			       (set! old-x x)
 			       (set! old-y y)
 			       (as-exit (lambda () (send mred on-move x y)))))))))))]
+	[on-set-focus (lambda () 
+                        (super on-set-focus)
+                        (when expose-focus? (send (get-proxy) on-focus #t)))]
+	[on-kill-focus (lambda () 
+                         (super on-kill-focus)
+                         (when expose-focus? (send (get-proxy) on-focus #f)))]
 	[pre-on-char (lambda (w e)
 		       (or (super pre-on-char w e)
                            (if (skip-subwindow-events?)