diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/key-event-class.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/key-event-class.scrbl index 76e84dcc..f5cd3d15 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/key-event-class.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/gui/key-event-class.scrbl @@ -27,19 +27,21 @@ See also @|mousekeydiscuss|. [caps-down any/c #f] [mod3-down any/c #f] [mod4-down any/c #f] - [mod5-down any/c #f])]{ + [mod5-down any/c #f] + [control+meta-is-altgr any/c #f])]{ See the corresponding @racketidfont{get-} and @racketidfont{set-} methods for information about @racket[key-code], @racket[shift-down], @racket[control-down], @racket[meta-down], @racket[mod3-down], @racket[mod4-down], @racket[mod5-down], @racket[alt-down], @racket[x], @racket[y], @racket[time-stamp], @racket[caps-down], @racket[mod3-down], - @racket[mod4-down], and @racket[mod5-down]. + @racket[mod4-down], @racket[mod5-down], and @racket[control+meta-is-altgr]. The release key code, as returned by @method[key-event% get-key-release-code], is initialized to @racket['press]. -@history[#:changed "1.1" @elem{Added @racket[mod3-down], @racket[mod4-down], and @racket[mod5-down].}] +@history[#:changed "1.1" @elem{Added @racket[mod3-down], @racket[mod4-down], and @racket[mod5-down].} + #:changed "1.2" @elem{Added @racket[control+meta-is-altgr].}] } @defmethod[(get-alt-down) @@ -61,12 +63,24 @@ Returns @racket[#t] if the Caps Lock key was on for the event. boolean?]{ Returns @racket[#t] if the Control key was down for the event. -On Mac OS X, if a control-key press is combined with a mouse button +On Mac OS X, if a Control-key press is combined with a mouse button click, the event is reported as a right-button click and @method[key-event% get-control-down] for the event reports @racket[#f]. } + +@defmethod[(get-control+meta-is-altgr) + boolean?]{ + +Returns @racket[#t] if a Control plus Meta event should be treated as +an AltGr event on Windows: the Control key was the left one and the +Alt key was the right one (typed that way on a keyboard with a right +Alt key, or produced by a single AltGr key). + +@history[#:added "1.2"]} + + @defmethod[(get-key-code) (or/c char? key-code-symbol?)]{ @@ -341,6 +355,15 @@ On Mac OS X, if a control-key press is combined with a mouse button } +@defmethod[(control+meta-is-altgr [down? any/c]) + void?]{ + +Sets whether a Control plus Meta combination on Windows should be +treated as an AltGr combinations. See @racket[get-control+meta-is-altgr]. + +@history[#:added "1.2"]} + + @defmethod[(set-key-code [code (or/c char? key-code-symbol?)]) void?]{ diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/keymap-class.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/keymap-class.scrbl index 1dc1da23..23c57189 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/keymap-class.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/gui/keymap-class.scrbl @@ -186,9 +186,12 @@ The modifier identifiers are: @item{@litchar{l:} --- All platforms: Caps Lock} + @item{@litchar{g:} --- Windows: Control plus Alt as AltGr; + see @xmethod[key-event% control+meta-is-altgr]} + @item{@litchar{?:} --- All platforms: allow match to character produced by opposite use of Shift, AltGr/Option, and/or Caps Lock, when available; see -@xmethod[key-event% get-other-shift-key-code]} + @xmethod[key-event% get-other-shift-key-code]} ] If a particular modifier is not mentioned in a state string, it @@ -196,8 +199,8 @@ If a particular modifier is not mentioned in a state string, it @litchar{~} preceding a modifier makes the string match only states where the corresponding modifier is not pressed. If the state string begins with @litchar{:}, then the string matches a state only if - modifiers (other than Caps Lock) not mentioned in the string are not - pressed. + modifiers among Shift, Control, Option, Alt, Meta, and Command that are + not mentioned in the string are not pressed. A key identifier can be either a character on the keyboard (e.g., @litchar{a}, @litchar{2}, @litchar{?}) or a special name. The @@ -325,6 +328,10 @@ Examples: @item{@racket["~c:a"] --- matches whenever @litchar{a} is typed and neither the Shift key nor the Control key is pressed.} + @item{@racket["c:m:~g:x"] --- matches whenever @litchar{x} is typed + with Control and Alt (Windows) or Meta (Unix) is pressed, as long as + the Control-Alt combination is not formed by AltGr on Windows.} + @item{@racket[":esc;:c:c"] --- matches an Escape key press (no modifiers) followed by a Control-C press (no modifiers other than Control).} @@ -346,8 +353,10 @@ A function name does not have to be mapped to a handler before input can be changed without affecting the map from input states to function names. -} - + +@history[#:changed "1.2" @elem{Added @litchar{g:} and @litchar{~g:} support.}]} + + @defmethod[(remove-chained-keymap [keymap (is-a?/c keymap%)]) void?]{ diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt index df54472f..9fb2b2b4 100644 --- a/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt +++ b/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt @@ -172,10 +172,9 @@ (cond [(eq? (system-type) 'windows) (cond - [(or (and (regexp-match? #rx"a:c" cs) - (not (regexp-match? #rx"~a:c" cs))) - (and (regexp-match? #rx"c:m" cs) - (not (regexp-match? #rx"~c:m" cs)))) + [(and (regexp-match? #rx"c:m" cs) + (not (regexp-match? #rx"~c:m" cs)) + (not (regexp-match? #rx"~g:" cs))) #f] [(or (has-key? #\a) (has-key? #\d)) #f] @@ -262,6 +261,7 @@ [meta (if neg? #f 'd/c)] [command (if neg? #f 'd/c)] [lock 'd/c] + [altgr 'd/c] [question-mark 'd/c] [do-key @@ -282,6 +282,7 @@ [(#\d) (set! command val)] [(#\m) (set! meta val)] [(#\l) (set! lock val)] + [(#\g) (set! altgr val)] [(#\?) (set! question-mark val)]))) mods) @@ -296,6 +297,10 @@ (do-key #\m meta) (do-key #\s shift) (do-key #\l lock) + (and (eq? 'windows (system-type)) + control + meta + (do-key #\g altgr)) canon-key))))) ;; split-out : char (listof char) -> (listof (listof char)) @@ -331,9 +336,10 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (make-meta-prefix-list key [mask-control? #f]) + ;; Note: key canonicalization will remove "~g" when redundant (list (if mask-control? - (string-append "m:" key) - (string-append "~c:m:" key)) + (string-append "~g:m:" key) + (string-append "~c:~g:m:" key)) (string-append "ESC;" key))) (define (send-map-function-meta keymap key func [mask-control? #f] diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/event.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/event.rkt index bcb6bc0f..d224ffb0 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/event.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/event.rkt @@ -87,7 +87,8 @@ (init-properties [[bool? caps-down] #f] [[bool? mod3-down] #f] [[bool? mod4-down] #f] - [[bool? mod5-down] #f]) + [[bool? mod5-down] #f] + [[bool? control+meta-is-altgr] #f]) (properties [[(make-alts symbol? char?) key-release-code] 'press] [[(make-or-false (make-alts symbol? char?)) other-shift-key-code] #f] [[(make-or-false (make-alts symbol? char?)) other-altgr-key-code] #f] diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/key.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/key.rkt index 04e12764..059bf508 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/key.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/key.rkt @@ -132,11 +132,17 @@ (let* ([control-down? (not (zero? (arithmetic-shift (GetKeyState VK_CONTROL) -1)))] [rcontrol-down? (and control-down? (not (zero? (arithmetic-shift (GetKeyState VK_RCONTROL) -1))))] + [lcontrol-down? (and control-down? + (not (zero? (arithmetic-shift (GetKeyState VK_LCONTROL) -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)]) + [alt-down? (= (bitwise-and (HIWORD lParam) KF_ALTDOWN) KF_ALTDOWN)] + [ralt-down? (and alt-down? + (not (zero? (arithmetic-shift (GetKeyState VK_RMENU) -1))))] + [lalt-down? (and alt-down? + (not (zero? (arithmetic-shift (GetKeyState VK_LMENU) -1))))]) (let-values ([(id other-shift other-altgr other-shift-altgr) (cond [(symbol? wParam) @@ -177,7 +183,10 @@ [else ;; wParam is a virtual key code (let ([id (hash-ref win32->symbol wParam #f)] - [override-mapping? (and control-down? (not alt-down?))] + [override-mapping? (and control-down? + ;; not AltGR: + (not (and lcontrol-down? + ralt-down?)))] [try-generate-release (lambda () (let ([sc (THE_SCAN_CODE lParam)]) @@ -252,7 +261,11 @@ [x 0] [y 0] [time-stamp 0] - [caps-down caps-down?])] + [caps-down caps-down?] + [control+meta-is-altgr (and control-down? + alt-down? + (not rcontrol-down?) + (not lalt-down?))])] [as-key (lambda (v) (if (integer? v) (integer->char v) v))]) (when is-up? diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/keymap.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/keymap.rkt index 9229bcd2..462a29aa 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/keymap.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/keymap.rkt @@ -120,6 +120,8 @@ cmd-off? caps-on? caps-off? + altgr-on? + altgr-off? score @@ -191,7 +193,7 @@ (when old (old)))) (define/private (find-key code other-code alt-code other-alt-code caps-code - shift? ctrl? alt? meta? cmd? caps? + shift? ctrl? alt? meta? cmd? caps? altgr? prefix) (for*/fold ([best-key #f] [best-score -1]) @@ -221,6 +223,9 @@ (or (and (key-caps-on? key) caps?) (and (key-caps-off? key) (not caps?)) (and (not (key-caps-on? key)) (not (key-caps-off? key)))) + (or (and (key-altgr-on? key) altgr?) + (and (key-altgr-off? key) (not altgr?)) + (and (not (key-altgr-on? key)) (not (key-altgr-off? key)))) (eq? (key-seqprefix key) prefix)) (let ([score (+ (key-score key) (if (eqv? (key-code key) code) @@ -233,7 +238,7 @@ (values best-key best-score))) (values best-key best-score)))) - (define/private (do-map-function code shift ctrl alt meta cmd caps check-other? + (define/private (do-map-function code shift ctrl alt meta cmd caps altgr check-other? fname prev isprefix? fullset?) ;; look for existing key mapping: (let ([key @@ -251,6 +256,8 @@ (eq? (key-cmd-off? key) (cmd . < . 0)) (eq? (key-caps-on? key) (caps . > . 0)) (eq? (key-caps-off? key) (caps . < . 0)) + (eq? (key-altgr-on? key) (altgr . > . 0)) + (eq? (key-altgr-off? key) (altgr . < . 0)) (eq? (key-check-other? key) check-other?) (eq? (key-seqprefix key) prev) key)) @@ -274,6 +281,8 @@ (if (shift . < . 0) "~s:" "") (if (caps . > . 0) "l:" "") (if (caps . < . 0) "~l:" "") + (if (altgr . > . 0) "g:" "") + (if (altgr . < . 0) "~g:" "") (or (hash-ref rev-keylist code) (format "~c" code)))]) (error (method-name 'keymap% 'map-function) @@ -291,6 +300,7 @@ (meta . > . 0) (meta . < . 0) (cmd . > . 0) (cmd . < . 0) (caps . > . 0) (caps . < . 0) + (altgr . > . 0) (altgr . < . 0) (+ (if (shift . > . 0) 1 0) (if (shift . < . 0) 5 0) (if (ctrl . > . 0) 1 0) @@ -303,6 +313,8 @@ (if (cmd . < . 0) 5 0) (if (caps . > . 0) 1 0) (if (caps . < . 0) 5 0) + (if (altgr . > . 0) 1 0) + (if (altgr . < . 0) 5 0) (if check-other? 6 30)) check-other? fullset? @@ -351,12 +363,12 @@ (cond [(regexp-match? #rx"^[?]:" str) (sloop (substring str 2) downs ups #t)] - [(regexp-match? #rx"^~[SsCcAaMmDdLl]:" str) + [(regexp-match? #rx"^~[SsCcAaMmDdLlGg]:" str) (let ([c (char-downcase (string-ref str 1))]) (if (memv c downs) (bad-string (format "inconsistent ~a: modifier state" c)) (sloop (substring str 3) downs (cons c ups) others?)))] - [(regexp-match? #rx"^[SsCcAaMmDdLl]:" str) + [(regexp-match? #rx"^[SsCcAaMmDdLlGg]:" str) (let ([c (char-downcase (string-ref str 0))]) (if (memv c ups) (bad-string (format "inconsistent ~a: modifier state" c)) @@ -398,6 +410,7 @@ (modval #\m) (modval #\d) (modval #\l #f) + (modval #\g #f) others? fname prev-key @@ -408,11 +421,11 @@ (loop (cdr seq) newkey))))))]))))))) (define/private (handle-event code other-code alt-code other-alt-code caps-code - shift? ctrl? alt? meta? cmd? caps? + shift? ctrl? alt? meta? cmd? caps? altgr? score) (let-values ([(key found-score) (find-key code other-code alt-code other-alt-code caps-code - shift? ctrl? alt? meta? cmd? caps? prefix)]) + shift? ctrl? alt? meta? cmd? caps? altgr? prefix)]) (set! prefix #f) (if (and key (found-score . >= . score)) @@ -426,15 +439,15 @@ (values #f #f #f)))) (define/public (get-best-score code other-code alt-code other-alt-code caps-code - shift? ctrl? alt? meta? cmd? caps?) + shift? ctrl? alt? meta? cmd? caps? altgr?) (let-values ([(key score) (find-key code other-code alt-code other-alt-code caps-code - shift? ctrl? alt? meta? cmd? caps? prefix)]) + shift? ctrl? alt? meta? cmd? caps? altgr? prefix)]) (for/fold ([s (if key score -1)]) ([c (in-list chain-to)]) (max s (send c get-best-score code other-code alt-code other-alt-code caps-code - shift? ctrl? alt? meta? cmd? caps?))))) + shift? ctrl? alt? meta? cmd? caps? altgr?))))) (def/public (set-grab-key-function [(make-procedure 4) grab]) (set! grab-key-function grab)) @@ -460,7 +473,8 @@ (send event get-alt-down) (as-meta-key (send event get-meta-down)) (as-cmd-key (send event get-meta-down)) - (send event get-caps-down))]) + (send event get-caps-down) + (send event get-control+meta-is-altgr))]) (let ([was-prefixed? prefixed?]) (let* ([r (chain-handle-key-event obj event #f prefixed? score)] @@ -511,6 +525,7 @@ (as-meta-key (send event get-meta-down)) (as-cmd-key (send event get-meta-down)) (send event get-caps-down) + (send event get-control+meta-is-altgr) score)]) (if h? (if fname @@ -593,7 +608,8 @@ (send event get-alt-down) (as-meta-key (send event get-meta-down)) (as-cmd-key (send event get-meta-down)) - (send event get-caps-down)))))])) + (send event get-caps-down) + #f))))])) (define/private (other-handle-mouse-event obj event grab try-state score) (for/fold ([result 0]) @@ -676,6 +692,7 @@ (as-meta-key (send event get-meta-down)) (as-cmd-key (send event get-meta-down)) (send event get-caps-down) + #f score)]) (cond [(and h? fname) diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/showkey.rkt b/pkgs/gui-pkgs/gui-test/tests/gracket/showkey.rkt index 37f1fcef..f0d885ba 100644 --- a/pkgs/gui-pkgs/gui-test/tests/gracket/showkey.rkt +++ b/pkgs/gui-pkgs/gui-test/tests/gracket/showkey.rkt @@ -47,7 +47,7 @@ ""))) (define/override (on-char ev) (set! iter (add1 iter)) - (printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~a~a~a~a\n" + (printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~a~a~a~a~a\n" (es-check) iter (let ([v (send ev get-key-code)]) @@ -70,6 +70,7 @@ vs)) (if (send ev get-meta-down) " META" "") (if (send ev get-control-down) " CTL" "") + (if (send ev get-control+meta-is-altgr) " = ALTGR" "") (if (send ev get-alt-down) " ALT" "") (if (send ev get-shift-down) " SHIFT" "") (if (send ev get-caps-down) " CAPS" "")