racket/gui: report AltGr combination for left Control plus right Alt

Use the new AltGr report to enable Control-Alt- combinations in
DrRacket (and other framework programs) when they do not intefere
with plain AltGr combinations.

original commit: 513ff778110b0a4f4ed725a9d4d79bacb275f97f
This commit is contained in:
Matthew Flatt 2014-08-04 11:34:31 +01:00
parent 984c5ca1a1
commit 3de4b74d6b
7 changed files with 101 additions and 31 deletions

View File

@ -27,19 +27,21 @@ See also @|mousekeydiscuss|.
[caps-down any/c #f] [caps-down any/c #f]
[mod3-down any/c #f] [mod3-down any/c #f]
[mod4-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-} See the corresponding @racketidfont{get-} and @racketidfont{set-}
methods for information about @racket[key-code], @racket[shift-down], methods for information about @racket[key-code], @racket[shift-down],
@racket[control-down], @racket[meta-down], @racket[mod3-down], @racket[mod4-down], @racket[control-down], @racket[meta-down], @racket[mod3-down], @racket[mod4-down],
@racket[mod5-down], @racket[alt-down], @racket[x], @racket[y], @racket[mod5-down], @racket[alt-down], @racket[x], @racket[y],
@racket[time-stamp], @racket[caps-down], @racket[mod3-down], @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% The release key code, as returned by @method[key-event%
get-key-release-code], is initialized to @racket['press]. 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) @defmethod[(get-alt-down)
@ -61,12 +63,24 @@ Returns @racket[#t] if the Caps Lock key was on for the event.
boolean?]{ boolean?]{
Returns @racket[#t] if the Control key was down for the event. 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 click, the event is reported as a right-button click and
@method[key-event% get-control-down] for the event reports @racket[#f]. @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) @defmethod[(get-key-code)
(or/c char? key-code-symbol?)]{ (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?)]) @defmethod[(set-key-code [code (or/c char? key-code-symbol?)])
void?]{ void?]{

View File

@ -186,9 +186,12 @@ The modifier identifiers are:
@item{@litchar{l:} --- All platforms: Caps Lock} @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 @item{@litchar{?:} --- All platforms: allow match to character produced by opposite
use of Shift, AltGr/Option, and/or Caps Lock, when available; see 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 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 @litchar{~} preceding a modifier makes the string match only states
where the corresponding modifier is not pressed. If the state string where the corresponding modifier is not pressed. If the state string
begins with @litchar{:}, then the string matches a state only if begins with @litchar{:}, then the string matches a state only if
modifiers (other than Caps Lock) not mentioned in the string are not modifiers among Shift, Control, Option, Alt, Meta, and Command that are
pressed. not mentioned in the string are not pressed.
A key identifier can be either a character on the keyboard (e.g., A key identifier can be either a character on the keyboard (e.g.,
@litchar{a}, @litchar{2}, @litchar{?}) or a special name. The @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 @item{@racket["~c:a"] --- matches whenever @litchar{a} is typed and neither
the Shift key nor the Control key is pressed.} 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 @item{@racket[":esc;:c:c"] --- matches an Escape key press (no
modifiers) followed by a Control-C press (no modifiers other than modifiers) followed by a Control-C press (no modifiers other than
Control).} 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 can be changed without affecting the map from input states to
function names. function names.
}
@history[#:changed "1.2" @elem{Added @litchar{g:} and @litchar{~g:} support.}]}
@defmethod[(remove-chained-keymap [keymap (is-a?/c keymap%)]) @defmethod[(remove-chained-keymap [keymap (is-a?/c keymap%)])
void?]{ void?]{

View File

@ -172,10 +172,9 @@
(cond (cond
[(eq? (system-type) 'windows) [(eq? (system-type) 'windows)
(cond (cond
[(or (and (regexp-match? #rx"a:c" cs) [(and (regexp-match? #rx"c:m" cs)
(not (regexp-match? #rx"~a:c" cs))) (not (regexp-match? #rx"~c:m" cs))
(and (regexp-match? #rx"c:m" cs) (not (regexp-match? #rx"~g:" cs)))
(not (regexp-match? #rx"~c:m" cs))))
#f] #f]
[(or (has-key? #\a) (has-key? #\d)) [(or (has-key? #\a) (has-key? #\d))
#f] #f]
@ -262,6 +261,7 @@
[meta (if neg? #f 'd/c)] [meta (if neg? #f 'd/c)]
[command (if neg? #f 'd/c)] [command (if neg? #f 'd/c)]
[lock 'd/c] [lock 'd/c]
[altgr 'd/c]
[question-mark 'd/c] [question-mark 'd/c]
[do-key [do-key
@ -282,6 +282,7 @@
[(#\d) (set! command val)] [(#\d) (set! command val)]
[(#\m) (set! meta val)] [(#\m) (set! meta val)]
[(#\l) (set! lock val)] [(#\l) (set! lock val)]
[(#\g) (set! altgr val)]
[(#\?) (set! question-mark val)]))) [(#\?) (set! question-mark val)])))
mods) mods)
@ -296,6 +297,10 @@
(do-key #\m meta) (do-key #\m meta)
(do-key #\s shift) (do-key #\s shift)
(do-key #\l lock) (do-key #\l lock)
(and (eq? 'windows (system-type))
control
meta
(do-key #\g altgr))
canon-key))))) canon-key)))))
;; split-out : char (listof char) -> (listof (listof char)) ;; split-out : char (listof char) -> (listof (listof char))
@ -331,9 +336,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-meta-prefix-list key [mask-control? #f]) (define (make-meta-prefix-list key [mask-control? #f])
;; Note: key canonicalization will remove "~g" when redundant
(list (if mask-control? (list (if mask-control?
(string-append "m:" key) (string-append "~g:m:" key)
(string-append "~c:m:" key)) (string-append "~c:~g:m:" key))
(string-append "ESC;" key))) (string-append "ESC;" key)))
(define (send-map-function-meta keymap key func [mask-control? #f] (define (send-map-function-meta keymap key func [mask-control? #f]

View File

@ -87,7 +87,8 @@
(init-properties [[bool? caps-down] #f] (init-properties [[bool? caps-down] #f]
[[bool? mod3-down] #f] [[bool? mod3-down] #f]
[[bool? mod4-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] (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-shift-key-code] #f]
[[(make-or-false (make-alts symbol? char?)) other-altgr-key-code] #f] [[(make-or-false (make-alts symbol? char?)) other-altgr-key-code] #f]

View File

@ -132,11 +132,17 @@
(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? [rcontrol-down? (and control-down?
(not (zero? (arithmetic-shift (GetKeyState VK_RCONTROL) -1))))] (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)))] [shift-down? (not (zero? (arithmetic-shift (GetKeyState VK_SHIFT) -1)))]
[rshift-down? (and shift-down? [rshift-down? (and shift-down?
(not (zero? (arithmetic-shift (GetKeyState VK_RSHIFT) -1))))] (not (zero? (arithmetic-shift (GetKeyState VK_RSHIFT) -1))))]
[caps-down? (not (zero? (arithmetic-shift (GetKeyState VK_CAPITAL) -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) (let-values ([(id other-shift other-altgr other-shift-altgr)
(cond (cond
[(symbol? wParam) [(symbol? wParam)
@ -177,7 +183,10 @@
[else [else
;; wParam is a virtual key code ;; wParam is a virtual key code
(let ([id (hash-ref win32->symbol wParam #f)] (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 [try-generate-release
(lambda () (lambda ()
(let ([sc (THE_SCAN_CODE lParam)]) (let ([sc (THE_SCAN_CODE lParam)])
@ -252,7 +261,11 @@
[x 0] [x 0]
[y 0] [y 0]
[time-stamp 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) [as-key (lambda (v)
(if (integer? v) (integer->char v) v))]) (if (integer? v) (integer->char v) v))])
(when is-up? (when is-up?

View File

@ -120,6 +120,8 @@
cmd-off? cmd-off?
caps-on? caps-on?
caps-off? caps-off?
altgr-on?
altgr-off?
score score
@ -191,7 +193,7 @@
(when old (old)))) (when old (old))))
(define/private (find-key code other-code alt-code other-alt-code caps-code (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) prefix)
(for*/fold ([best-key #f] (for*/fold ([best-key #f]
[best-score -1]) [best-score -1])
@ -221,6 +223,9 @@
(or (and (key-caps-on? key) caps?) (or (and (key-caps-on? key) caps?)
(and (key-caps-off? key) (not caps?)) (and (key-caps-off? key) (not caps?))
(and (not (key-caps-on? key)) (not (key-caps-off? key)))) (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)) (eq? (key-seqprefix key) prefix))
(let ([score (+ (key-score key) (let ([score (+ (key-score key)
(if (eqv? (key-code key) code) (if (eqv? (key-code key) code)
@ -233,7 +238,7 @@
(values best-key best-score))) (values best-key best-score)))
(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?) fname prev isprefix? fullset?)
;; look for existing key mapping: ;; look for existing key mapping:
(let ([key (let ([key
@ -251,6 +256,8 @@
(eq? (key-cmd-off? key) (cmd . < . 0)) (eq? (key-cmd-off? key) (cmd . < . 0))
(eq? (key-caps-on? key) (caps . > . 0)) (eq? (key-caps-on? key) (caps . > . 0))
(eq? (key-caps-off? 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-check-other? key) check-other?)
(eq? (key-seqprefix key) prev) (eq? (key-seqprefix key) prev)
key)) key))
@ -274,6 +281,8 @@
(if (shift . < . 0) "~s:" "") (if (shift . < . 0) "~s:" "")
(if (caps . > . 0) "l:" "") (if (caps . > . 0) "l:" "")
(if (caps . < . 0) "~l:" "") (if (caps . < . 0) "~l:" "")
(if (altgr . > . 0) "g:" "")
(if (altgr . < . 0) "~g:" "")
(or (hash-ref rev-keylist code) (or (hash-ref rev-keylist code)
(format "~c" code)))]) (format "~c" code)))])
(error (method-name 'keymap% 'map-function) (error (method-name 'keymap% 'map-function)
@ -291,6 +300,7 @@
(meta . > . 0) (meta . < . 0) (meta . > . 0) (meta . < . 0)
(cmd . > . 0) (cmd . < . 0) (cmd . > . 0) (cmd . < . 0)
(caps . > . 0) (caps . < . 0) (caps . > . 0) (caps . < . 0)
(altgr . > . 0) (altgr . < . 0)
(+ (if (shift . > . 0) 1 0) (+ (if (shift . > . 0) 1 0)
(if (shift . < . 0) 5 0) (if (shift . < . 0) 5 0)
(if (ctrl . > . 0) 1 0) (if (ctrl . > . 0) 1 0)
@ -303,6 +313,8 @@
(if (cmd . < . 0) 5 0) (if (cmd . < . 0) 5 0)
(if (caps . > . 0) 1 0) (if (caps . > . 0) 1 0)
(if (caps . < . 0) 5 0) (if (caps . < . 0) 5 0)
(if (altgr . > . 0) 1 0)
(if (altgr . < . 0) 5 0)
(if check-other? 6 30)) (if check-other? 6 30))
check-other? check-other?
fullset? fullset?
@ -351,12 +363,12 @@
(cond (cond
[(regexp-match? #rx"^[?]:" str) [(regexp-match? #rx"^[?]:" str)
(sloop (substring str 2) downs ups #t)] (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))]) (let ([c (char-downcase (string-ref str 1))])
(if (memv c downs) (if (memv c downs)
(bad-string (format "inconsistent ~a: modifier state" c)) (bad-string (format "inconsistent ~a: modifier state" c))
(sloop (substring str 3) downs (cons c ups) others?)))] (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))]) (let ([c (char-downcase (string-ref str 0))])
(if (memv c ups) (if (memv c ups)
(bad-string (format "inconsistent ~a: modifier state" c)) (bad-string (format "inconsistent ~a: modifier state" c))
@ -398,6 +410,7 @@
(modval #\m) (modval #\m)
(modval #\d) (modval #\d)
(modval #\l #f) (modval #\l #f)
(modval #\g #f)
others? others?
fname fname
prev-key prev-key
@ -408,11 +421,11 @@
(loop (cdr seq) newkey))))))]))))))) (loop (cdr seq) newkey))))))])))))))
(define/private (handle-event code other-code alt-code other-alt-code caps-code (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) score)
(let-values ([(key found-score) (let-values ([(key found-score)
(find-key code other-code alt-code other-alt-code caps-code (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) (set! prefix #f)
(if (and key (found-score . >= . score)) (if (and key (found-score . >= . score))
@ -426,15 +439,15 @@
(values #f #f #f)))) (values #f #f #f))))
(define/public (get-best-score code other-code alt-code other-alt-code caps-code (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) (let-values ([(key score)
(find-key code other-code alt-code other-alt-code caps-code (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)]) (for/fold ([s (if key score -1)])
([c (in-list chain-to)]) ([c (in-list chain-to)])
(max s (max s
(send c get-best-score code other-code alt-code other-alt-code caps-code (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]) (def/public (set-grab-key-function [(make-procedure 4) grab])
(set! grab-key-function grab)) (set! grab-key-function grab))
@ -460,7 +473,8 @@
(send event get-alt-down) (send event get-alt-down)
(as-meta-key (send event get-meta-down)) (as-meta-key (send event get-meta-down))
(as-cmd-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 ([was-prefixed? prefixed?])
(let* ([r (chain-handle-key-event obj event #f prefixed? score)] (let* ([r (chain-handle-key-event obj event #f prefixed? score)]
@ -511,6 +525,7 @@
(as-meta-key (send event get-meta-down)) (as-meta-key (send event get-meta-down))
(as-cmd-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)
score)]) score)])
(if h? (if h?
(if fname (if fname
@ -593,7 +608,8 @@
(send event get-alt-down) (send event get-alt-down)
(as-meta-key (send event get-meta-down)) (as-meta-key (send event get-meta-down))
(as-cmd-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) (define/private (other-handle-mouse-event obj event grab try-state score)
(for/fold ([result 0]) (for/fold ([result 0])
@ -676,6 +692,7 @@
(as-meta-key (send event get-meta-down)) (as-meta-key (send event get-meta-down))
(as-cmd-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
score)]) score)])
(cond (cond
[(and h? fname) [(and h? fname)

View File

@ -47,7 +47,7 @@
""))) "")))
(define/override (on-char ev) (define/override (on-char ev)
(set! iter (add1 iter)) (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) (es-check)
iter iter
(let ([v (send ev get-key-code)]) (let ([v (send ev get-key-code)])
@ -70,6 +70,7 @@
vs)) vs))
(if (send ev get-meta-down) " META" "") (if (send ev get-meta-down) " META" "")
(if (send ev get-control-down) " CTL" "") (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-alt-down) " ALT" "")
(if (send ev get-shift-down) " SHIFT" "") (if (send ev get-shift-down) " SHIFT" "")
(if (send ev get-caps-down) " CAPS" "") (if (send ev get-caps-down) " CAPS" "")