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

add any-control+alt-is-altgr

Browse Source 
Thanks to Bert De Ketelaere for helping to sort out this new
behavior.
This commit is contained in:
Matthew Flatt 2016-03-17 16:39:24 -06:00
parent 3ae70e6617
commit 282a22b8f0
15 changed files with 114 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gui-doc/scribblings/gui/eventspace-funcs.scrbl
View File

@ -124,6 +124,24 @@ If no argument is provided, the result is @racket[#t] if Option is
currently treated specially, @racket[#f] otherwise.
}
@defproc*[([(any-control+alt-is-altgr [on? any/c])
void?]
[(any-control+alt-is-altgr)
boolean?])]{
Enables or disables the treatment of any Control plus Alt as
equivalent to AltGr (Windows), as opposed to treating only a
left-hand Control plus a right-hand Alt (for keyboard configurations
that have both) as AltGr.
If @racket[on?] is provided as @racket[#f], key events are reported
normally. This setting affects all windows and eventspaces.
If no argument is provided, the result is @racket[#t] if Control plus Alt is
currently treated as AltGr, @racket[#f] otherwise.
@history[#:added "1.24"]}
@defproc[(queue-callback [callback (-> any)]
[high-priority? any/c #t])
void?]{

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

@ -74,9 +74,11 @@ On Mac OS X, if a Control-key press is combined with a mouse button
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).
an AltGr event on Windows. By default, AltGr treatment applies if the
Control key was the left one and the Alt key (as Meta) was the right one---typed
that way on a keyboard with a right Alt key, or produced by a single
AltGr key. See also @racket[any-control+alt-is-altgr], which controls
whether other Control plus Alt combinations are treated as AltGr.
@history[#:added "1.2"]}

2
gui-lib/info.rkt
View File

@ -30,4 +30,4 @@
(define pkg-authors '(mflatt robby))
(define version "1.23")
(define version "1.24")

1
gui-lib/mred/mred-sig.rkt
View File

@ -4,6 +4,7 @@ add-color<%>
add-editor-keymap-functions
add-pasteboard-keymap-functions
add-text-keymap-functions
any-control+alt-is-altgr
append-editor-font-menu-items
append-editor-operation-menu-items
application-about-handler

1
gui-lib/mred/private/mred.rkt
View File

@ -143,6 +143,7 @@
scroll-event%
special-control-key
special-option-key
any-control+alt-is-altgr
map-command-as-meta-key
label->plain-label
write-editor-global-footer

1
gui-lib/mred/private/wx/cocoa/platform.rkt
View File

@ -85,6 +85,7 @@
get-color-from-user
special-option-key
special-control-key
any-control+alt-is-altgr
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap

1
gui-lib/mred/private/wx/cocoa/procs.rkt
View File

@ -65,6 +65,7 @@
play-sound
file-creator-and-type
file-selector
any-control+alt-is-altgr
key-symbol-to-menu-key
needs-grow-box-spacer?
get-current-mouse-state

7
gui-lib/mred/private/wx/common/default-procs.rkt
View File

@ -3,6 +3,7 @@
racket/draw/private/color)
(provide special-control-key
special-option-key
any-control+alt-is-altgr
file-creator-and-type
get-panel-background
fill-private-color)
@ -19,6 +20,12 @@
[() special-option-key?]
[(on?) (set! special-option-key? (and on? #t))]))
(define any-control+alt-is-altgr? #f)
(define any-control+alt-is-altgr
(case-lambda
[() any-control+alt-is-altgr?]
[(on?) (set! any-control+alt-is-altgr? (and on? #t))]))
(define file-creator-and-type
(case-lambda
[(path cr ty) (void)]

1
gui-lib/mred/private/wx/gtk/platform.rkt
View File

@ -86,6 +86,7 @@
get-color-from-user
special-option-key
special-control-key
any-control+alt-is-altgr
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap

1
gui-lib/mred/private/wx/gtk/procs.rkt
View File

@ -56,6 +56,7 @@
file-creator-and-type
special-control-key
special-option-key
any-control+alt-is-altgr
get-panel-background
fill-private-color
get-color-from-user

1
gui-lib/mred/private/wx/platform.rkt
View File

@ -75,6 +75,7 @@
get-color-from-user
special-option-key
special-control-key
any-control+alt-is-altgr
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap

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

@ -10,25 +10,47 @@
(protect-out maybe-make-key-event
generates-key-event?
reset-key-mapping
key-symbol-to-menu-key))
key-symbol-to-menu-key
any-control+alt-is-altgr))
(define-user32 GetKeyState (_wfun _int -> _SHORT))
(define-user32 MapVirtualKeyW (_wfun _UINT _UINT -> _UINT))
(define-user32 VkKeyScanW (_wfun _WCHAR -> _SHORT))
(define-user32 ToUnicode (_wfun _UINT _UINT _pointer _pointer _int _UINT -> _int))
(define-user32 GetKeyboardState (_wfun _pointer -> _BOOL))
(define control+alt-always-as-altgr? #f)
(define any-control+alt-is-altgr
(case-lambda
[() control+alt-always-as-altgr?]
[(on?) (set! control+alt-always-as-altgr? (and on? #t))]))
;; Back-door result from `key-mapped?` via `maybe-make-key-event`:
(define no-translate? #f)
;; Called to determine whether a WM_KEYDOWN event should
;; be passed to TranslateEvent() to get a WM_CHAR event.
;; If the WM_KEYDOWN event itself will translate to a
;; visible key event, then don't use TranslateEvent().
(define (generates-key-event? msg)
(let ([message (MSG-message msg)])
(and (or (eq? message WM_KEYDOWN)
(eq? message WM_SYSKEYDOWN)
(eq? message WM_KEYUP)
(eq? message WM_SYSKEYUP))
(maybe-make-key-event #t
(MSG-wParam msg)
(MSG-lParam msg)
#f
(or (= message WM_KEYUP)
(= message WM_SYSKEYUP))
(MSG-hwnd msg)))))
(or (maybe-make-key-event #t
(MSG-wParam msg)
(MSG-lParam msg)
#f
(or (= message WM_KEYUP)
(= message WM_SYSKEYUP))
(MSG-hwnd msg))
;; If ToUnicode() was used for checking, claim that
;; an event will be generated so that TranslateEvent()
;; is not used.
(begin0
no-translate?
(set! no-translate? #f))))))
(define (THE_SCAN_CODE lParam)
(bitwise-and (arithmetic-shift lParam -16) #x1FF))
@ -53,7 +75,8 @@
(VkKeyScanW (char->integer i)))))
other-key-codes)))
(define (reset-key-mapping)
(set! other-key-codes #f))
(set! other-key-codes #f)
(set! mapped-keys (make-hash)))
(define (other-orig j)
(char->integer (string-ref find_shift_alts j)))
@ -184,9 +207,14 @@
;; wParam is a virtual key code
(let ([id (hash-ref win32->symbol wParam #f)]
[override-mapping? (and control-down?
;; not AltGR:
(not (and lcontrol-down?
ralt-down?)))]
;; not AltGR or no mapping:
(or (not alt-down?)
(not (or control+alt-always-as-altgr?
(and lcontrol-down?
ralt-down?)))
(not (key-mapped? wParam
(THE_SCAN_CODE lParam)
just-check?))))]
[try-generate-release
(lambda ()
(let ([sc (THE_SCAN_CODE lParam)])
@ -264,8 +292,9 @@
[caps-down caps-down?]
[control+meta-is-altgr (and control-down?
alt-down?
(not rcontrol-down?)
(not lalt-down?))])]
(or control+alt-always-as-altgr?
(and (not rcontrol-down?)
(not lalt-down?))))])]
[as-key (lambda (v)
(if (integer? v) (integer->char v) v))])
(when is-up?
@ -341,3 +370,29 @@
(subtract . Subtract)
(numpad-enter . |Numpad Enter|)
(numpad6 . |Numpad 6|)))
;; The `key-mapped?` function is used to predict whether an
;; AltGr combination will produce a key; if not, a key
;; event can be synthesized (like control combinations)
(define keys-state (make-bytes 256))
(define unicode-result (make-bytes 20))
(define mapped-keys (make-hash))
(define (key-mapped? vk sc just-check?)
(define key (vector vk sc))
(hash-ref mapped-keys
key
(lambda ()
(cond
[just-check?
;; In checking mode, we can use ToUnicode():
(GetKeyboardState keys-state)
(define n (ToUnicode vk sc keys-state unicode-result 10 0))
(when (= n -1)
;; For a dead char, ToUnicode() seems to have the effect
;; of TranslateEvent(), so avoid the latter.
(set! no-translate? #t))
(define mapped? (not (zero? n)))
;; Record what we learned for use by non-checking mode:
(hash-set! mapped-keys key mapped?)
mapped?]
[else #f]))))

2
gui-lib/mred/private/wx/win32/platform.rkt
View File

@ -23,6 +23,7 @@
"slider.rkt"
"tab-panel.rkt"
"window.rkt"
"key.rkt"
"procs.rkt")
(provide (protect-out platform-values))
@ -86,6 +87,7 @@
get-color-from-user
special-option-key
special-control-key
any-control+alt-is-altgr
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap

3
gui-lib/mred/private/wx/win32/procs.rkt
View File

@ -12,7 +12,8 @@
"dc.rkt"
"printer-dc.rkt"
(except-in "../common/default-procs.rkt"
get-panel-background)
get-panel-background
any-control+alt-is-altgr)
"filedialog.rkt"
"colordialog.rkt"
"sound.rkt"

4
gui-test/tests/gracket/showkey.rkt
View File

@ -8,7 +8,9 @@
[("--option") "set special Option key"
(special-option-key #t)]
[("--control") "set special Control key"
(special-control-key #t)])
(special-control-key #t)]
[("--altgr") "set any Control+Alt as AltGr"
(any-control+alt-is-altgr #t)])
(let ()
(define iter 0)