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

Compute other-key-codes

Browse Source 
Use UCKeyTranslate to compute and store other-key-codes in the key-event.
This commit is contained in:
Jens Axel Søgaard 2015-01-08 14:11:23 +01:00 committed by Matthew Flatt
parent fb0356d2fb
commit 4dc47ef413
1 changed files with 47 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
gui-lib/mred/private/wx/cocoa/window.rkt
View File

@ -9,6 +9,7 @@
"keycode.rkt" "keycode.rkt"
"pool.rkt" "pool.rkt"
"cursor.rkt" "cursor.rkt"
"key-translate.rkt"
"../common/local.rkt" "../common/local.rkt"
"../../lock.rkt" "../../lock.rkt"
"../common/event.rkt" "../common/event.rkt"
@ -294,7 +295,13 @@
(when wx (when wx
(send wx reset-cursor-rects)))]) (send wx reset-cursor-rects)))])
(define dead-key-state (make-initial-dead-key-state))
(define << arithmetic-shift)
(define (do-key-event wxb event self down? mod-change? wheel) (define (do-key-event wxb event self down? mod-change? wheel)
(define type (tell #:type _ushort event type))
(define key-down? (= (bitwise-and type #b1111) NSKeyDown))
(let ([wx (->wx wxb)]) (let ([wx (->wx wxb)])
(and (and
wx wx
@ -328,7 +335,10 @@
(tell #:type _NSString event characters)])] (tell #:type _NSString event characters)])]
[dead-key? (unbox set-mark)] [dead-key? (unbox set-mark)]
[control? (bit? modifiers NSControlKeyMask)] [control? (bit? modifiers NSControlKeyMask)]
[option? (bit? modifiers NSAlternateKeyMask)] [option? (bit? modifiers NSAlternateKeyMask)]
[shift? (bit? modifiers NSShiftKeyMask)]
[cmd? (bit? modifiers NSCommandKeyMask)]
[caps? (bit? modifiers NSAlphaShiftKeyMask)]
[codes (cond [codes (cond
[wheel wheel] [wheel wheel]
[mod-change? (case (tell #:type _ushort event keyCode) [mod-change? (case (tell #:type _ushort event keyCode)
@ -357,9 +367,9 @@
(let-values ([(x y) (send wx window-point-to-view pos)]) (let-values ([(x y) (send wx window-point-to-view pos)])
(let ([k (new key-event% (let ([k (new key-event%
[key-code one-code] [key-code one-code]
[shift-down (bit? modifiers NSShiftKeyMask)] [shift-down shift?]
[control-down control?] [control-down control?]
[meta-down (bit? modifiers NSCommandKeyMask)] [meta-down cmd?]
[alt-down option?] [alt-down option?]
[x (->long x)] [x (->long x)]
[y (->long y)] [y (->long y)]
@ -372,7 +382,40 @@
(let ([alt-code (string-ref alt-str 0)]) (let ([alt-code (string-ref alt-str 0)])
(unless (equal? alt-code (send k get-key-code)) (unless (equal? alt-code (send k get-key-code))
(send k set-other-altgr-key-code alt-code))))) (send k set-other-altgr-key-code alt-code)))))
(when (and (or (and option? (when key-down?
(let ()
(define (toggle flag m b) (if flag (- m b) (+ m b)))
(define prev-dks (copy-dead-key-state dead-key-state))
(define (old-dks-copy) (copy-dead-key-state prev-dks))
(define mask (+ modifier-shift-key modifier-option-key modifier-alpha-lock
modifier-cmd-key modifier-control-key))
(define kc (tell #:type _ushort event keyCode))
(define mods (bitwise-and (<< modifiers -8) mask))
(define s (key-translate kc #:modifier-key-state mods
#:dead-key-state dead-key-state))
(define dead? (= 0 (string-length s)))
(unless dead? (set! dead-key-state (make-initial-dead-key-state)))
;; actual char received
(define c (and (not dead?) (string-ref s 0)))
;; the other codes all assume that caps-lock is off, so make sure it is turned off
(set! mods (if caps? (toggle caps? mods modifier-alpha-lock) mods))
(define shift-mod (toggle shift? mods modifier-shift-key))
(define alt-mod (toggle option? mods modifier-option-key))
(define shift-alt-mod (toggle shift? (toggle option? mods modifier-option-key)
modifier-shift-key))
;; (define cmd-mod (toggle cmd? mods modifier-cmd-key))
;; (define ctrl-mod (toggle control? mods modifier-control-key))
(define (alternative who setter mod)
(define s (key-translate kc #:modifier-key-state mod #:dead-key-state (old-dks-copy)))
(setter (if (> (string-length s) 0) (string-ref s 0) #f))
(void))
(alternative 'shift (lambda (c) (send k set-other-shift-key-code c)) shift-mod)
(alternative 'alt (lambda (c) (send k set-other-altgr-key-code c)) alt-mod)
;; what exacly is shift+altgr supposed to hold ?
(alternative 'shift-alt (lambda (c) (send k set-other-shift-altgr-key-code c)) shift-alt-mod)))
;; TODO What was this swapping meant to do?
#;(when (and (or (and option?
special-option-key?) special-option-key?)
(and control? (and control?
(equal? (send k get-key-code) #\u00))) (equal? (send k get-key-code) #\u00)))