From 282a22b8f012641ba1d8d926ca0e962a06ba559a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 17 Mar 2016 16:39:24 -0600 Subject: [PATCH] add `any-control+alt-is-altgr` Thanks to Bert De Ketelaere for helping to sort out this new behavior. --- .../scribblings/gui/eventspace-funcs.scrbl | 18 ++++ gui-doc/scribblings/gui/key-event-class.scrbl | 8 +- gui-lib/info.rkt | 2 +- gui-lib/mred/mred-sig.rkt | 1 + gui-lib/mred/private/mred.rkt | 1 + gui-lib/mred/private/wx/cocoa/platform.rkt | 1 + gui-lib/mred/private/wx/cocoa/procs.rkt | 1 + .../mred/private/wx/common/default-procs.rkt | 7 ++ gui-lib/mred/private/wx/gtk/platform.rkt | 1 + gui-lib/mred/private/wx/gtk/procs.rkt | 1 + gui-lib/mred/private/wx/platform.rkt | 1 + gui-lib/mred/private/wx/win32/key.rkt | 83 +++++++++++++++---- gui-lib/mred/private/wx/win32/platform.rkt | 2 + gui-lib/mred/private/wx/win32/procs.rkt | 3 +- gui-test/tests/gracket/showkey.rkt | 4 +- 15 files changed, 114 insertions(+), 20 deletions(-) diff --git a/gui-doc/scribblings/gui/eventspace-funcs.scrbl b/gui-doc/scribblings/gui/eventspace-funcs.scrbl index ab1f0d7e..eeb5df9e 100644 --- a/gui-doc/scribblings/gui/eventspace-funcs.scrbl +++ b/gui-doc/scribblings/gui/eventspace-funcs.scrbl @@ -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?]{ diff --git a/gui-doc/scribblings/gui/key-event-class.scrbl b/gui-doc/scribblings/gui/key-event-class.scrbl index 87e4dda7..8f6dd7e3 100644 --- a/gui-doc/scribblings/gui/key-event-class.scrbl +++ b/gui-doc/scribblings/gui/key-event-class.scrbl @@ -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"]} diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index 9eda0148..dc7114b8 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.23") +(define version "1.24") diff --git a/gui-lib/mred/mred-sig.rkt b/gui-lib/mred/mred-sig.rkt index a2d237aa..0f438c14 100644 --- a/gui-lib/mred/mred-sig.rkt +++ b/gui-lib/mred/mred-sig.rkt @@ -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 diff --git a/gui-lib/mred/private/mred.rkt b/gui-lib/mred/private/mred.rkt index 655868b7..29bb5919 100644 --- a/gui-lib/mred/private/mred.rkt +++ b/gui-lib/mred/private/mred.rkt @@ -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 diff --git a/gui-lib/mred/private/wx/cocoa/platform.rkt b/gui-lib/mred/private/wx/cocoa/platform.rkt index c4594814..3dd0c92a 100644 --- a/gui-lib/mred/private/wx/cocoa/platform.rkt +++ b/gui-lib/mred/private/wx/cocoa/platform.rkt @@ -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 diff --git a/gui-lib/mred/private/wx/cocoa/procs.rkt b/gui-lib/mred/private/wx/cocoa/procs.rkt index e79bf662..8ee35bd9 100644 --- a/gui-lib/mred/private/wx/cocoa/procs.rkt +++ b/gui-lib/mred/private/wx/cocoa/procs.rkt @@ -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 diff --git a/gui-lib/mred/private/wx/common/default-procs.rkt b/gui-lib/mred/private/wx/common/default-procs.rkt index 52598374..d10d63d2 100644 --- a/gui-lib/mred/private/wx/common/default-procs.rkt +++ b/gui-lib/mred/private/wx/common/default-procs.rkt @@ -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)] diff --git a/gui-lib/mred/private/wx/gtk/platform.rkt b/gui-lib/mred/private/wx/gtk/platform.rkt index 56a50a1a..a10fe482 100644 --- a/gui-lib/mred/private/wx/gtk/platform.rkt +++ b/gui-lib/mred/private/wx/gtk/platform.rkt @@ -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 diff --git a/gui-lib/mred/private/wx/gtk/procs.rkt b/gui-lib/mred/private/wx/gtk/procs.rkt index 972d32ea..f05a92c1 100644 --- a/gui-lib/mred/private/wx/gtk/procs.rkt +++ b/gui-lib/mred/private/wx/gtk/procs.rkt @@ -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 diff --git a/gui-lib/mred/private/wx/platform.rkt b/gui-lib/mred/private/wx/platform.rkt index ca03d4a8..664ae1e7 100644 --- a/gui-lib/mred/private/wx/platform.rkt +++ b/gui-lib/mred/private/wx/platform.rkt @@ -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 diff --git a/gui-lib/mred/private/wx/win32/key.rkt b/gui-lib/mred/private/wx/win32/key.rkt index 059bf508..7bbcb033 100644 --- a/gui-lib/mred/private/wx/win32/key.rkt +++ b/gui-lib/mred/private/wx/win32/key.rkt @@ -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])))) diff --git a/gui-lib/mred/private/wx/win32/platform.rkt b/gui-lib/mred/private/wx/win32/platform.rkt index cd8460c3..3768748f 100644 --- a/gui-lib/mred/private/wx/win32/platform.rkt +++ b/gui-lib/mred/private/wx/win32/platform.rkt @@ -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 diff --git a/gui-lib/mred/private/wx/win32/procs.rkt b/gui-lib/mred/private/wx/win32/procs.rkt index 21315687..59bb54a5 100644 --- a/gui-lib/mred/private/wx/win32/procs.rkt +++ b/gui-lib/mred/private/wx/win32/procs.rkt @@ -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" diff --git a/gui-test/tests/gracket/showkey.rkt b/gui-test/tests/gracket/showkey.rkt index f0d885ba..05b36faf 100644 --- a/gui-test/tests/gracket/showkey.rkt +++ b/gui-test/tests/gracket/showkey.rkt @@ -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)