From adced0a8c807f465eb460307bf18b3b16133d53c Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 9 Feb 2022 23:53:16 +0000 Subject: [PATCH 1/4] X.A.{Grid,Tree}Select: Fix keybindings in secondary kbd layouts We didn't clean XKB group bits out of the KeyPress events' state so key bindings only worked in the primary keyboard layout (first XKB group). To fix this, this adds a `cleanKeyMask` function to X.Prelude which is analogous to `cleanMask` but aimed at cleaning regular KeyPress states (as opposed to just KeyPresses from passive key grabs), and this is then used instead of `cleanMask`. Related: https://github.com/xmonad/xmonad-contrib/issues/290 Related: https://github.com/xmonad/xmonad-contrib/pull/590 --- XMonad/Actions/GridSelect.hs | 2 +- XMonad/Actions/TreeSelect.hs | 2 +- XMonad/Prelude.hs | 16 ++++++++++++++++ 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index f33f0dcd52..1ba0aa6347 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -409,7 +409,7 @@ makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> l then do (ks,s) <- lookupString $ asKeyEvent e return $ do - mask <- liftX $ cleanMask (ev_state ev) + mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) keyhandler (fromMaybe xK_VoidSymbol ks, s, mask) else return $ stdHandle ev me diff --git a/XMonad/Actions/TreeSelect.hs b/XMonad/Actions/TreeSelect.hs index 110930a7db..8727634ef7 100644 --- a/XMonad/Actions/TreeSelect.hs +++ b/XMonad/Actions/TreeSelect.hs @@ -535,7 +535,7 @@ navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do if | ev_event_type ev == keyPress -> do (ks, _) <- lookupString $ asKeyEvent e return $ do - mask <- liftX $ cleanMask (ev_state ev) + mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) f <- asks ts_navigate fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f | ev_event_type ev == buttonPress -> do diff --git a/XMonad/Prelude.hs b/XMonad/Prelude.hs index de2a83cff0..227211d1a4 100644 --- a/XMonad/Prelude.hs +++ b/XMonad/Prelude.hs @@ -24,6 +24,7 @@ module XMonad.Prelude ( safeGetWindowAttributes, keyToString, keymaskToString, + cleanKeyMask, ) where import Foreign (alloca, peek) @@ -116,3 +117,18 @@ keymaskToString numLockMask msk = -- pair, into a string. keyToString :: (KeyMask, KeySym) -> [Char] keyToString = uncurry (++) . bimap (keymaskToString 0) keysymToString + +-- | Strip numlock, capslock, mouse buttons and XKB group from a 'KeyMask', +-- leaving only modifier keys like Shift, Control, Super, Hyper in the mask +-- (hence the \"Key\" in \"cleanKeyMask\"). +-- +-- Core's 'cleanMask' only strips the first two because key events from +-- passive grabs (key bindings) are stripped of mouse buttons and XKB group by +-- the X server already for compatibility reasons. For more info, see: +-- +cleanKeyMask :: X (KeyMask -> KeyMask) +cleanKeyMask = cleanKeyMask' <$> gets numberlockMask + +cleanKeyMask' :: KeyMask -> KeyMask -> KeyMask +cleanKeyMask' numLockMask mask = + mask .&. complement (numLockMask .|. lockMask) .&. (button1Mask - 1) From 12c5518852efb624b6b875994b5439759f464fb8 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 9 Feb 2022 23:53:16 +0000 Subject: [PATCH 2/4] X.A.Submap, X.Prompt: Use cleanKeyMask MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This replaces the custom `cleanMask` extension in these modules—which only filtered out XKB group bits and Button5Mask¹—with the new `cleanKeyMask` which additionally filters out all mouse buttons, as these aren't relevant for key bindings. ¹) Filtering out Button5Mask was probably an off-by-one mistake. Fixes: https://github.com/xmonad/xmonad-contrib/issues/290 Related: https://github.com/xmonad/xmonad-contrib/pull/590 --- XMonad/Actions/Submap.hs | 5 ++--- XMonad/Prompt.hs | 30 ++++++++++-------------------- 2 files changed, 12 insertions(+), 23 deletions(-) diff --git a/XMonad/Actions/Submap.hs b/XMonad/Actions/Submap.hs index 06c8c7e47d..7b03b2a187 100644 --- a/XMonad/Actions/Submap.hs +++ b/XMonad/Actions/Submap.hs @@ -27,7 +27,7 @@ module XMonad.Actions.Submap ( import Data.Bits import qualified Data.Map as M import XMonad hiding (keys) -import XMonad.Prelude (fix, fromMaybe, keyToString) +import XMonad.Prelude (fix, fromMaybe, keyToString, cleanKeyMask) import XMonad.Util.XUtils {- $usage @@ -138,8 +138,7 @@ waitForKeyPress = do then nextkey else return (m, keysym) _ -> return (0, 0) - -- Remove num lock mask and Xkb group state bits - m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1) + m' <- cleanKeyMask <*> pure m io $ do ungrabPointer dpy currentTime ungrabKeyboard dpy currentTime sync dpy False diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 1883851256..8513f6d645 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -99,7 +99,6 @@ module XMonad.Prompt import XMonad hiding (cleanMask, config) import XMonad.Prelude hiding (toList) -import qualified XMonad as X (numberlockMask) import qualified XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.Types @@ -150,7 +149,7 @@ data XPState = , offset :: !Int , config :: XPConfig , successful :: Bool - , numlockMask :: KeyMask + , cleanMask :: KeyMask -> KeyMask , done :: Bool , modeDone :: Bool , color :: XPColor @@ -357,9 +356,9 @@ amberXPConfig = def { bgColor = "black" } initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode - -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> Dimension - -> XPState -initState d rw w s opMode gc fonts h c nm width = + -> GC -> XMonadFont -> [String] -> XPConfig -> (KeyMask -> KeyMask) + -> Dimension -> XPState +initState d rw w s opMode gc fonts h c cm width = XPS { dpy = d , rootw = rw , win = w @@ -382,7 +381,7 @@ initState d rw w s opMode gc fonts h c nm width = , successful = False , done = False , modeDone = False - , numlockMask = nm + , cleanMask = cm , prompter = defaultPrompter c , color = defaultColor c , eventBuffer = [] @@ -555,7 +554,7 @@ mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState mkXPromptImplementation historyKey conf om = do XConf { display = d, theRoot = rw } <- ask s <- gets $ screenRect . W.screenDetail . W.current . windowset - numlock <- gets X.numberlockMask + cleanMask <- cleanKeyMask cachedir <- asks (cacheDir . directories) hist <- io $ readHistory cachedir fs <- initXMF (font conf) @@ -572,7 +571,7 @@ mkXPromptImplementation historyKey conf om = do selectInput d w $ exposureMask .|. keyPressMask setGraphicsExposures d gc False let hs = fromMaybe [] $ M.lookup historyKey hist - st = initState d rw w s om gc fs hs conf numlock width + st = initState d rw w s om gc fs hs conf cleanMask width runXP st)) releaseXMF fs when (successful st') $ do @@ -595,15 +594,6 @@ mkXPromptImplementation historyKey conf om = do CenteredAt{ xpWidth } -> floor $ fi (rect_width scr) * xpWidth _ -> rect_width scr --- | Removes numlock and capslock from a keymask. --- Duplicate of cleanMask from core, but in the --- XP monad instead of X. -cleanMask :: KeyMask -> XP KeyMask -cleanMask msk = do - numlock <- gets numlockMask - let highMasks = 1 `shiftL` 12 - 1 - return (complement (numlock .|. lockMask) .&. msk .&. highMasks) - -- | Inverse of 'Codec.Binary.UTF8.String.utf8Encode', that is, a convenience -- function that checks to see if the input string is UTF8 encoded before -- decoding. @@ -699,7 +689,7 @@ merely discarded, but passed to the respective application window. handleMain :: KeyStroke -> Event -> XP () handleMain stroke@(keysym,_) KeyEvent{ev_event_type = t, ev_state = m} = do (compKey,modeKey) <- gets $ (completionKey &&& changeModeKey) . config - keymask <- cleanMask m + keymask <- gets cleanMask <*> pure m -- haven't subscribed to keyRelease, so just in case when (t == keyPress) $ if (keymask,keysym) == compKey @@ -831,7 +821,7 @@ handleSubmap :: XP () -> Event -> XP () handleSubmap defaultAction keymap stroke KeyEvent{ev_event_type = t, ev_state = m} = do - keymask <- cleanMask m + keymask <- gets cleanMask <*> pure m when (t == keyPress) $ handleInputSubmap defaultAction keymap keymask stroke handleSubmap _ _ stroke event = handleOther stroke event @@ -888,7 +878,7 @@ handleBuffer :: (String -> String -> (Bool,Bool)) -> Event -> XP () handleBuffer f stroke event@KeyEvent{ev_event_type = t, ev_state = m} = do - keymask <- cleanMask m + keymask <- gets cleanMask <*> pure m when (t == keyPress) $ handleInputBuffer f keymask stroke event handleBuffer _ stroke event = handleOther stroke event From 68c967ec0c87b946476487e7f57124ecde854a60 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Thu, 12 Aug 2021 11:30:23 +0300 Subject: [PATCH 3/4] X.A.{Grid,Tree}Select, X.Prompt: Fix keybindings like Shift-Tab and similar This changes KeyPress handling in these modules to behave much closer to how xmonad core itself handles keypresses. The primary difference lies in that xmonad reads raw KeyCode and then converts it to unmodified KeySym, while these modules used `lookupString` to find the actual keysyms. As a consequence, key definitions like `(shiftMap, xK_Tab)` didn't work on many layouts because an actual KeySym for `Shift-Tab` is commonly `ISO_LEFT_TAB`, and not `Tab`. Closes: https://github.com/xmonad/xmonad-contrib/pull/590 Co-authored-by: Tomas Janousek --- XMonad/Actions/GridSelect.hs | 5 +++-- XMonad/Actions/TreeSelect.hs | 4 ++-- XMonad/Prompt.hs | 9 +++++---- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 1ba0aa6347..b4e297d12b 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -407,10 +407,11 @@ makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> l ev <- getEvent e if ev_event_type ev == keyPress then do - (ks,s) <- lookupString $ asKeyEvent e + (_, s) <- lookupString $ asKeyEvent e + ks <- keycodeToKeysym d (ev_keycode ev) 0 return $ do mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) - keyhandler (fromMaybe xK_VoidSymbol ks, s, mask) + keyhandler (ks, s, mask) else return $ stdHandle ev me diff --git a/XMonad/Actions/TreeSelect.hs b/XMonad/Actions/TreeSelect.hs index 8727634ef7..43ef6e7993 100644 --- a/XMonad/Actions/TreeSelect.hs +++ b/XMonad/Actions/TreeSelect.hs @@ -533,11 +533,11 @@ navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do ev <- getEvent e if | ev_event_type ev == keyPress -> do - (ks, _) <- lookupString $ asKeyEvent e + ks <- keycodeToKeysym d (ev_keycode ev) 0 return $ do mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) f <- asks ts_navigate - fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f + fromMaybe navigate $ M.lookup (mask, ks) f | ev_event_type ev == buttonPress -> do -- See XMonad.Prompt Note [Allow ButtonEvents] allowEvents d replayPointer currentTime diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 8513f6d645..ce29663d40 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -637,10 +637,11 @@ eventLoop handle stopAction = do -- Also capture @buttonPressMask@, see Note [Allow ButtonEvents] maskEvent d (exposureMask .|. keyPressMask .|. buttonPressMask) e ev <- getEvent e - (ks,s) <- if ev_event_type ev == keyPress - then lookupString $ asKeyEvent e - else return (Nothing, "") - return (fromMaybe xK_VoidSymbol ks,s,ev) + if ev_event_type ev == keyPress + then do (_, s) <- lookupString $ asKeyEvent e + ks <- keycodeToKeysym d (ev_keycode ev) 0 + return (ks, s, ev) + else return (noSymbol, "", ev) l -> do modify $ \s -> s { eventBuffer = tail l } return $ head l From 1b728ff96ab630fc4c574ad560f5ec34a9f238d7 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Thu, 10 Feb 2022 15:01:10 +0000 Subject: [PATCH 4/4] CHANGES: Document the key bindings changes --- CHANGES.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 134755bfcf..c2fa1c67ef 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -132,6 +132,13 @@ - Added `visualSubmap` to visualise the available keys and their actions when inside a submap. + * `XMonad.Prompt`, `XMonad.Actions.TreeSelect`, `XMonad.Actions.GridSelect` + + - Key bindings now behave similarly to xmonad core: + State of mouse buttons and XKB layout groups is ignored. + Translation of key codes to symbols ignores modifiers, so `Shift-Tab` is + now just `(shiftMap, xK_Tab)` instead of `(shiftMap, xK_ISO_Left_Tab)`. + ## 0.17.0 (October 27, 2021) ### Breaking Changes