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

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
pkgs/gui-pkgs/gui-doc/scribblings/gui/key-event-class.scrbl
View File

@ -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?]{

19
pkgs/gui-pkgs/gui-doc/scribblings/gui/keymap-class.scrbl
View File

@ -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?]{

18
pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt
View File

@ -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]

3
pkgs/gui-pkgs/gui-lib/mred/private/wx/common/event.rkt
View File

@ -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]

19
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/key.rkt
View File

@ -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?

39
pkgs/gui-pkgs/gui-lib/mred/private/wxme/keymap.rkt
View File

@ -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)

3
pkgs/gui-pkgs/gui-test/tests/gracket/showkey.rkt
View File

@ -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" "")