From 4dc47ef413cb96cc430e177c6fcdbfa5bd4c7d8e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jens=20Axel=20S=C3=B8gaard?= Date: Thu, 8 Jan 2015 14:11:23 +0100 Subject: [PATCH] Compute other-key-codes Use UCKeyTranslate to compute and store other-key-codes in the key-event. --- gui-lib/mred/private/wx/cocoa/window.rkt | 51 ++++++++++++++++++++++-- 1 file changed, 47 insertions(+), 4 deletions(-) diff --git a/gui-lib/mred/private/wx/cocoa/window.rkt b/gui-lib/mred/private/wx/cocoa/window.rkt index e2ebf146..d9850411 100644 --- a/gui-lib/mred/private/wx/cocoa/window.rkt +++ b/gui-lib/mred/private/wx/cocoa/window.rkt @@ -9,6 +9,7 @@ "keycode.rkt" "pool.rkt" "cursor.rkt" + "key-translate.rkt" "../common/local.rkt" "../../lock.rkt" "../common/event.rkt" @@ -294,7 +295,13 @@ (when wx (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 type (tell #:type _ushort event type)) + (define key-down? (= (bitwise-and type #b1111) NSKeyDown)) (let ([wx (->wx wxb)]) (and wx @@ -328,7 +335,10 @@ (tell #:type _NSString event characters)])] [dead-key? (unbox set-mark)] [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 [wheel wheel] [mod-change? (case (tell #:type _ushort event keyCode) @@ -357,9 +367,9 @@ (let-values ([(x y) (send wx window-point-to-view pos)]) (let ([k (new key-event% [key-code one-code] - [shift-down (bit? modifiers NSShiftKeyMask)] + [shift-down shift?] [control-down control?] - [meta-down (bit? modifiers NSCommandKeyMask)] + [meta-down cmd?] [alt-down option?] [x (->long x)] [y (->long y)] @@ -372,7 +382,40 @@ (let ([alt-code (string-ref alt-str 0)]) (unless (equal? alt-code (send k get-key-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?) (and control? (equal? (send k get-key-code) #\u00)))