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:
parent
984c5ca1a1
commit
3de4b74d6b
|
@ -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?]{
|
||||||
|
|
||||||
|
|
|
@ -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?]{
|
||||||
|
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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?
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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" "")
|
||||||
|
|
Loading…
Reference in New Issue
Block a user