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

another refinement to cocoa key handling

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-04 07:38:14 -06:00
parent 15a7a2a006
commit cc737fc571
1 changed files with 80 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -53,6 +53,8 @@
(import-class NSArray) (import-class NSArray)
(import-protocol NSTextInput) (import-protocol NSTextInput)
(define current-insert-text (make-parameter #f))
(define-objc-mixin (KeyMouseResponder Superclass) (define-objc-mixin (KeyMouseResponder Superclass)
[wxb] [wxb]
[-a _void (mouseDown: [_id event]) [-a _void (mouseDown: [_id event])
@ -106,19 +108,34 @@
(super-tell #:type _void otherMouseDragged: event))] (super-tell #:type _void otherMouseDragged: event))]
[-a _void (keyDown: [_id event]) [-a _void (keyDown: [_id event])
(unless (do-key-event wxb event) (unless (do-key-event wxb event self)
(super-tell #:type _void keyDown: event))] (super-tell #:type _void keyDown: event))]
[-a _void (insertText: [_NSString str]) [-a _void (insertText: [_NSString str])
(let ([cit (current-insert-text)])
(if cit
(set-box! cit str)
(let ([wx (->wx wxb)]) (let ([wx (->wx wxb)])
(post-dummy-event) ;; to wake up in case of character palette insert (post-dummy-event) ;; to wake up in case of character palette insert
(when wx (when wx
(queue-window-event wx (lambda () (queue-window-event wx (lambda ()
(send wx key-event-as-string str)))))] (send wx key-event-as-string str)))))))]
;; for NSTextInput, to enable character palette insert: ;; for NSTextInput:
[-a _BOOL (hasMarkedText) #f] [-a _BOOL (hasMarkedText) #f]
[-a _id (validAttributesForMarkedText) [-a _id (validAttributesForMarkedText)
(tell NSArray array)]) (tell NSArray array)]
[-a _void (unmarkText) (void)]
[-a _NSRange (markedRange) (make-NSRange 0 0)]
[-a _NSRange (selectedRange) (make-NSRange 0 0)]
[-a _void (setMarkedText: [_id aString] selectedRange: [_NSRange selRange])
(void)]
[-a _id (validAttributesForMarkedText) #f]
[-a _id (attributedSubstringFromRange: [_NSRange theRange]) #f]
[-a _NSUInteger (characterIndexForPoint: [_NSPoint thePoint]) 0]
[-a _NSInteger (conversationIdentifier) 0]
[-a _void (doCommandBySelector: [_SEL aSelector]) (void)]
[-a _NSRect (firstRectForCharacterRange: [_NSRange r]) (make-NSRect (make-NSPoint 0 0)
(make-NSSize 0 0))])
(define-objc-mixin (KeyMouseTextResponder Superclass) (define-objc-mixin (KeyMouseTextResponder Superclass)
#:mixins (KeyMouseResponder) #:mixins (KeyMouseResponder)
@ -132,10 +149,23 @@
(when wx (when wx
(send wx reset-cursor-rects)))]) (send wx reset-cursor-rects)))])
(define (do-key-event wxb event) (define (do-key-event wxb event self)
(let ([wx (->wx wxb)]) (let ([wx (->wx wxb)])
(and (and
wx wx
(let ([inserted-text (box #f)])
;; Calling `interpretKeyEvents:' allows key combinations to be
;; handled, such as option-e followed by e to produce é. The
;; call to `interpretKeyEvents:' typically calls `insertText:',
;; so we set `current-insert-text' to tell `insertText:' to just
;; give us back the text in the parameter. For now, we ignore the
;; text and handle the event as usual, though probably we should
;; be doing something with it.
(parameterize ([current-insert-text inserted-text])
(tellv self interpretKeyEvents: (tell (tell NSArray alloc)
initWithObjects: #:type (_ptr i _id) event
count: #:type _NSUInteger 1)))
(let* ([modifiers (tell #:type _NSUInteger event modifierFlags)] (let* ([modifiers (tell #:type _NSUInteger event modifierFlags)]
[bit? (lambda (m b) (positive? (bitwise-and m b)))] [bit? (lambda (m b) (positive? (bitwise-and m b)))]
[pos (tell #:type _NSPoint event locationInWindow)] [pos (tell #:type _NSPoint event locationInWindow)]
@ -176,7 +206,7 @@
#t) #t)
(constrained-reply (send wx get-eventspace) (constrained-reply (send wx get-eventspace)
(lambda () (send wx dispatch-on-char k #t)) (lambda () (send wx dispatch-on-char k #t))
#t)))))))) #t)))))))))
(define (do-mouse-event wxb event kind l? m? r? [ctl-kind kind]) (define (do-mouse-event wxb event kind l? m? r? [ctl-kind kind])
(let ([wx (->wx wxb)]) (let ([wx (->wx wxb)])