diff --git a/CHANGES.md b/CHANGES.md index 134755bf..c2fa1c67 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 diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index f33f0dcd..b4e297d1 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 $ cleanMask (ev_state ev) - keyhandler (fromMaybe xK_VoidSymbol ks, s, mask) + mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) + keyhandler (ks, s, mask) else return $ stdHandle ev me diff --git a/XMonad/Actions/Submap.hs b/XMonad/Actions/Submap.hs index 06c8c7e4..7b03b2a1 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/Actions/TreeSelect.hs b/XMonad/Actions/TreeSelect.hs index 110930a7..43ef6e79 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 $ 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 + 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/Prelude.hs b/XMonad/Prelude.hs index de2a83cf..227211d1 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) diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 18838512..ce29663d 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. @@ -647,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 @@ -699,7 +690,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 +822,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 +879,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