diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 0d93034cd0..7a5e4ab3a2 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/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) diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index 07802b391d..041805cabd 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/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)) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index e8e522a8e9..bd0fbb6f69 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/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)) diff --git a/collects/mred/private/wxcanvas.rkt b/collects/mred/private/wxcanvas.rkt index 38ec4ebd5b..60cc8549c4 100644 --- a/collects/mred/private/wxcanvas.rkt +++ b/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)))) diff --git a/collects/mred/private/wxwindow.rkt b/collects/mred/private/wxwindow.rkt index 66ab6dff50..be3d476669 100644 --- a/collects/mred/private/wxwindow.rkt +++ b/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?)