suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

focus callbacks

Browse Source
This commit is contained in:
Matthew Flatt 2010-07-22 21:15:48 -05:00
parent 54bee6314e
commit efb88aef4f
5 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mred/private/wx/cocoa/canvas.rkt
View File

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

2
collects/mred/private/wx/cocoa/window.rkt
View File

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

7
collects/mred/private/wx/gtk/window.rkt
View File

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

6
collects/mred/private/wxcanvas.rkt
View File

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

11
collects/mred/private/wxwindow.rkt
View File

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