add 'shift, 'control, 'rshift, and 'rcontrol events
This commit is contained in:
Matthew Flatt
parent
4a387c5b6a
commit
f93c94f6ff
|
|
@ -169,15 +169,18 @@
|
|||
[(positive? delta-x) '(wheel-left)]
|
||||
[else '(wheel-right)]))])
|
||||
(unless (and (pair? evts)
|
||||
(do-key-event wxb event self #f evts))
|
||||
(do-key-event wxb event self #f #f evts))
|
||||
(super-tell #:type _void scrollWheel: event))))]
|
||||
|
||||
[-a _void (keyDown: [_id event])
|
||||
(unless (do-key-event wxb event self #t #f)
|
||||
(unless (do-key-event wxb event self #t #f #f)
|
||||
(super-tell #:type _void keyDown: event))]
|
||||
[-a _void (keyUp: [_id event])
|
||||
(unless (do-key-event wxb event self #f #f)
|
||||
(unless (do-key-event wxb event self #f #f #f)
|
||||
(super-tell #:type _void keyUp: event))]
|
||||
[-a _void (flagsChanged: [_id event])
|
||||
(unless (do-key-event wxb event self #f #t #f)
|
||||
(super-tell #:type _void flagsChanged: event))]
|
||||
[-a _void (insertText: [_NSStringOrAttributed str])
|
||||
(set-saved-marked! wxb #f #f)
|
||||
(let ([cit (current-insert-text)])
|
||||
|
|
@ -291,7 +294,7 @@
|
|||
(when wx
|
||||
(send wx reset-cursor-rects)))])
|
||||
|
||||
(define (do-key-event wxb event self down? wheel)
|
||||
(define (do-key-event wxb event self down? mod-change? wheel)
|
||||
(let ([wx (->wx wxb)])
|
||||
(and
|
||||
wx
|
||||
|
|
@ -318,6 +321,7 @@
|
|||
[pos (tell #:type _NSPoint event locationInWindow)]
|
||||
[str (cond
|
||||
[wheel #f]
|
||||
[mod-change? #f]
|
||||
[(unbox set-mark) ""] ; => dead key for composing characters
|
||||
[(unbox inserted-text)]
|
||||
[else
|
||||
|
|
@ -327,6 +331,12 @@
|
|||
[option? (bit? modifiers NSAlternateKeyMask)]
|
||||
[codes (cond
|
||||
[wheel wheel]
|
||||
[mod-change? (case (tell #:type _ushort event keyCode)
|
||||
[(56) '(shift)]
|
||||
[(59) '(control)]
|
||||
[(60) '(rshift)]
|
||||
[(62) '(rcontrol)]
|
||||
[else '()])]
|
||||
[had-saved-text? str]
|
||||
[(map-key-code (tell #:type _ushort event keyCode))
|
||||
=> list]
|
||||
|
|
@ -355,7 +365,7 @@
|
|||
[y (->long y)]
|
||||
[time-stamp (->long (* (tell #:type _double event timestamp) 1000.0))]
|
||||
[caps-down (bit? modifiers NSAlphaShiftKeyMask)])])
|
||||
(unless wheel
|
||||
(unless (or wheel mod-change?)
|
||||
(let ([alt-str (tell #:type _NSString event charactersIgnoringModifiers)])
|
||||
(when (and (string? alt-str)
|
||||
(= 1 (string-length alt-str)))
|
||||
|
|
@ -370,8 +380,13 @@
|
|||
;; swap altenate with main
|
||||
(let ([other (send k get-other-altgr-key-code)])
|
||||
(send k set-other-altgr-key-code (send k get-key-code))
|
||||
(send k set-key-code other)))
|
||||
(unless down?
|
||||
(send k set-key-code other))))
|
||||
(unless wheel
|
||||
(unless (or down? (and mod-change?
|
||||
(case (send k get-key-code)
|
||||
[(shift rshift) (send k get-shift-down)]
|
||||
[(control rcontrol) (send k get-control-down)]
|
||||
[else #t])))
|
||||
;; swap altenate with main
|
||||
(send k set-key-release-code (send k get-key-code))
|
||||
(send k set-key-code 'release)))
|
||||
|
|
|
|||
|
|
@ -66,7 +66,11 @@
|
|||
(#xffc9 . f12)
|
||||
(#xffca . f13)
|
||||
(#xffcb . f14)
|
||||
(#xffcc . f15))
|
||||
(#xffcc . f15)
|
||||
(#xffe1 . shift)
|
||||
(#xffe2 . rshift)
|
||||
(#xffe3 . control)
|
||||
(#xffe4 . rcontrol))
|
||||
v
|
||||
#f))
|
||||
|
||||
|
|
|
|||
|
|
@ -127,8 +127,12 @@
|
|||
|
||||
|
||||
(define (make-key-event just-check? wParam lParam is-char? is-up? hwnd)
|
||||
(let ([control-down? (not (zero? (arithmetic-shift (GetKeyState VK_CONTROL) -1)))]
|
||||
(let* ([control-down? (not (zero? (arithmetic-shift (GetKeyState VK_CONTROL) -1)))]
|
||||
[rcontrol-down? (and control-down?
|
||||
(not (zero? (arithmetic-shift (GetKeyState VK_RCONTROL) -1))))]
|
||||
[shift-down? (not (zero? (arithmetic-shift (GetKeyState VK_SHIFT) -1)))]
|
||||
[rshift-down? (and shift-down?
|
||||
(not (zero? (arithmetic-shift (GetKeyState VK_RSHIFT) -1))))]
|
||||
[caps-down? (not (zero? (arithmetic-shift (GetKeyState VK_CAPITAL) -1)))]
|
||||
[alt-down? (= (bitwise-and (HIWORD lParam) KF_ALTDOWN) KF_ALTDOWN)])
|
||||
(let-values ([(id other-shift other-altgr other-shift-altgr)
|
||||
|
|
@ -212,15 +216,11 @@
|
|||
(values id s a sa))))
|
||||
(values (and is-up? (try-generate-release)) #f #f #f))
|
||||
(cond
|
||||
[(and (not is-up?) (= wParam VK_CONTROL))
|
||||
;; Don't generate control-key down events:
|
||||
(values #f #f #f #f)]
|
||||
[(and (not override-mapping?) (not is-up?)
|
||||
;; Let these get translated to WM_CHAR or skipped
|
||||
;; entirely:
|
||||
(memq wParam
|
||||
(list VK_ESCAPE VK_SHIFT VK_CONTROL
|
||||
VK_SPACE VK_RETURN VK_TAB VK_BACK)))
|
||||
(list VK_ESCAPE VK_SPACE VK_RETURN VK_TAB VK_BACK)))
|
||||
(values #f #f #f #f)]
|
||||
[(and (not id) is-up?)
|
||||
(values (try-generate-release) #f #f #f)]
|
||||
|
|
@ -230,9 +230,15 @@
|
|||
(if just-check?
|
||||
#t
|
||||
(let* ([id (if (number? id) (integer->char id) id)]
|
||||
[key-id (if (equal? id #\033)
|
||||
'escape
|
||||
[key-id (case id
|
||||
[(#\033) 'escape]
|
||||
[(shift) (if rshift-down?
|
||||
'rshift
|
||||
id)]
|
||||
[(control) (if rcontrol-down?
|
||||
'rcontrol
|
||||
id)]
|
||||
[else id])]
|
||||
[e (new key-event%
|
||||
[key-code (if is-up?
|
||||
'release
|
||||
|
|
|
|||
|
|
@ -71,8 +71,10 @@ Gets the virtual key code for the key event. The virtual key code is
|
|||
@item{@indexed-racket['start]}
|
||||
@item{@indexed-racket['cancel]}
|
||||
@item{@indexed-racket['clear]}
|
||||
@item{@indexed-racket['shift]}
|
||||
@item{@indexed-racket['control]}
|
||||
@item{@indexed-racket['shift] --- Shift key}
|
||||
@item{@indexed-racket['rshift] --- right Shift key}
|
||||
@item{@indexed-racket['control] --- Control key}
|
||||
@item{@indexed-racket['rcontrol] --- right Control key}
|
||||
@item{@indexed-racket['menu]}
|
||||
@item{@indexed-racket['pause]}
|
||||
@item{@indexed-racket['capital]}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user