From 6a7f6484217f530be5938744ce37cf6d928a0b10 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Thu, 10 Feb 2022 16:57:44 +0000 Subject: [PATCH 1/3] Add stripModMask to customize cleanMask/extraModifiers Fixes: https://github.com/xmonad/xmonad/issues/172 Relates: https://github.com/xmonad/xmonad-contrib/issues/290 --- CHANGES.md | 4 ++++ src/XMonad/Config.hs | 12 +++++++++++- src/XMonad/Core.hs | 1 + src/XMonad/Operations.hs | 19 +++++++++++-------- xmonad.cabal | 2 +- 5 files changed, 28 insertions(+), 10 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 1a0d4b35..496cd92a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,10 @@ * Added custom cursor shapes for resizing and moving windows. + * Added `stripModMask` to allow customizing which modifiers are irrelevant + for key bindings. Useful for binding numpad keys only when Num Lock is + off, or to make Mod5 irrelevant in addition to the default Num/Caps Lock. + ### Bug Fixes * Fixed border color of windows with alpha channel. Now all windows have the diff --git a/src/XMonad/Config.hs b/src/XMonad/Config.hs index a450fbc0..deaa88d7 100644 --- a/src/XMonad/Config.hs +++ b/src/XMonad/Config.hs @@ -38,6 +38,7 @@ import XMonad.Layout import XMonad.Operations import XMonad.ManageHook import qualified XMonad.StackSet as W +import Control.Monad.State (gets) import Data.Bits ((.|.)) import Data.Default.Class import Data.Monoid @@ -58,7 +59,7 @@ import Graphics.X11.Xlib.Extras workspaces :: [WorkspaceId] workspaces = map show [1 .. 9 :: Int] --- | modMask lets you specify which modkey you want to use. The default +-- | 'modMask' lets you specify which modkey you want to use. The default -- is mod1Mask ("left alt"). You may also consider using mod3Mask -- ("right alt"), which does not conflict with emacs keybindings. The -- "windows key" is usually mod4Mask. @@ -66,6 +67,14 @@ workspaces = map show [1 .. 9 :: Int] defaultModMask :: KeyMask defaultModMask = mod1Mask +-- | 'stripModMask' lets you specify which modifiers are irrelevant for key +-- bindings. The default is Num Lock and Caps Lock. You will need to override +-- this if you wish to only strip Caps Lock if you need to bind numpad keys +-- but only when Num Lock is off (or on). Another use case is adding +-- 'mod5Mask' to the list of stripped/irrelevant modifiers. +defaultStripModMask :: X KeyMask +defaultStripModMask = gets ((lockMask .|.) . numberlockMask) + -- | Width of the window border in pixels. -- borderWidth :: Dimension @@ -264,6 +273,7 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh , XMonad.normalBorderColor = normalBorderColor , XMonad.focusedBorderColor = focusedBorderColor , XMonad.modMask = defaultModMask + , XMonad.stripModMask = defaultStripModMask , XMonad.keys = keys , XMonad.logHook = logHook , XMonad.startupHook = startupHook diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index f02081ed..dbd340fd 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -111,6 +111,7 @@ data XConfig l = XConfig -- event hooks in most cases. , workspaces :: ![String] -- ^ The list of workspaces' names , modMask :: !KeyMask -- ^ the mod modifier + , stripModMask :: !(X KeyMask) -- ^ The mask of modifiers to ignore in key bindings. Default: num/caps lock. , keys :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())) -- ^ The key binding: a map from key presses and actions , mouseBindings :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ())) diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs index ce29def1..09c7dd03 100644 --- a/src/XMonad/Operations.hs +++ b/src/XMonad/Operations.hs @@ -56,8 +56,8 @@ import qualified XMonad.StackSet as W import Data.Maybe import Data.Monoid (Endo(..),Any(..)) -import Data.List (nub, (\\), find) -import Data.Bits ((.|.), (.&.), complement, testBit) +import Data.List (nub, (\\), find, foldl', subsequences) +import Data.Bits ((.|.), (.&.), complement, bit, testBit, clearBit, countTrailingZeros) import Data.Function (on) import Data.Ratio import qualified Data.Map as M @@ -500,17 +500,20 @@ isClient :: Window -> X Bool isClient w = withWindowSet $ return . W.member w -- | Combinations of extra modifier masks we need to grab keys\/buttons for. --- (numlock and capslock) +-- (by default numlock and capslock, can be overridden in 'stripModMask') extraModifiers :: X [KeyMask] extraModifiers = do - nlm <- gets numberlockMask - return [0, nlm, lockMask, nlm .|. lockMask ] + smm <- join $ asks $ stripModMask . config + return $ map (foldl' (.|.) 0) (subsequences (bits smm)) + where + bits 0 = [] + bits n = let b = countTrailingZeros n in bit b : bits (n `clearBit` b) --- | Strip numlock\/capslock from a mask. +-- | Strip 'stripModMask' (by default numlock\/capslock) from a mask. cleanMask :: KeyMask -> X KeyMask cleanMask km = do - nlm <- gets numberlockMask - return (complement (nlm .|. lockMask) .&. km) + smm <- join $ asks $ stripModMask . config + return (complement smm .&. km) -- | Set the 'Pixel' alpha value to 255. setPixelSolid :: Pixel -> Pixel diff --git a/xmonad.cabal b/xmonad.cabal index d4d8d9c6..a42d03da 100644 --- a/xmonad.cabal +++ b/xmonad.cabal @@ -1,5 +1,5 @@ name: xmonad -version: 0.17.0.9 +version: 0.17.0.91 synopsis: A tiling window manager description: xmonad is a tiling window manager for X. Windows are arranged automatically to tile the screen without gaps or overlap, maximising From fca3313583ec78aa5c2c32a904a1ef2cf2475370 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tom=C3=A1=C5=A1=20Janou=C5=A1ek?= Date: Sun, 13 Feb 2022 10:31:42 +0000 Subject: [PATCH 2/3] fixup! Add stripModMask to customize cleanMask/extraModifiers Co-authored-by: Tony Zorman --- src/XMonad/Config.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/XMonad/Config.hs b/src/XMonad/Config.hs index deaa88d7..2b445b1c 100644 --- a/src/XMonad/Config.hs +++ b/src/XMonad/Config.hs @@ -69,7 +69,7 @@ defaultModMask = mod1Mask -- | 'stripModMask' lets you specify which modifiers are irrelevant for key -- bindings. The default is Num Lock and Caps Lock. You will need to override --- this if you wish to only strip Caps Lock if you need to bind numpad keys +-- this if you wish to only strip Caps Lock; e.g., if you need to bind numpad keys -- but only when Num Lock is off (or on). Another use case is adding -- 'mod5Mask' to the list of stripped/irrelevant modifiers. defaultStripModMask :: X KeyMask From 67304e9f32c786552e89ffdc040165f0dafaa450 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sun, 13 Feb 2022 11:26:48 +0000 Subject: [PATCH 3/3] fixup! Add stripModMask to customize cleanMask/extraModifiers --- src/XMonad/Config.hs | 5 +++-- src/XMonad/Core.hs | 2 +- src/XMonad/Operations.hs | 9 +++------ 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/src/XMonad/Config.hs b/src/XMonad/Config.hs index 2b445b1c..711cf31f 100644 --- a/src/XMonad/Config.hs +++ b/src/XMonad/Config.hs @@ -41,6 +41,7 @@ import qualified XMonad.StackSet as W import Control.Monad.State (gets) import Data.Bits ((.|.)) import Data.Default.Class +import Data.Functor ((<&>)) import Data.Monoid import qualified Data.Map as M import System.Exit @@ -72,8 +73,8 @@ defaultModMask = mod1Mask -- this if you wish to only strip Caps Lock; e.g., if you need to bind numpad keys -- but only when Num Lock is off (or on). Another use case is adding -- 'mod5Mask' to the list of stripped/irrelevant modifiers. -defaultStripModMask :: X KeyMask -defaultStripModMask = gets ((lockMask .|.) . numberlockMask) +defaultStripModMask :: X [KeyMask] +defaultStripModMask = gets numberlockMask <&> \numLockMask -> [lockMask, numLockMask] -- | Width of the window border in pixels. -- diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index dbd340fd..25d4ddad 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -111,7 +111,7 @@ data XConfig l = XConfig -- event hooks in most cases. , workspaces :: ![String] -- ^ The list of workspaces' names , modMask :: !KeyMask -- ^ the mod modifier - , stripModMask :: !(X KeyMask) -- ^ The mask of modifiers to ignore in key bindings. Default: num/caps lock. + , stripModMask :: !(X [KeyMask]) -- ^ Modifiers to ignore in key bindings. Default: num/caps lock. , keys :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())) -- ^ The key binding: a map from key presses and actions , mouseBindings :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ())) diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs index 09c7dd03..dd4d66b7 100644 --- a/src/XMonad/Operations.hs +++ b/src/XMonad/Operations.hs @@ -57,7 +57,7 @@ import qualified XMonad.StackSet as W import Data.Maybe import Data.Monoid (Endo(..),Any(..)) import Data.List (nub, (\\), find, foldl', subsequences) -import Data.Bits ((.|.), (.&.), complement, bit, testBit, clearBit, countTrailingZeros) +import Data.Bits ((.|.), (.&.), complement, testBit) import Data.Function (on) import Data.Ratio import qualified Data.Map as M @@ -504,16 +504,13 @@ isClient w = withWindowSet $ return . W.member w extraModifiers :: X [KeyMask] extraModifiers = do smm <- join $ asks $ stripModMask . config - return $ map (foldl' (.|.) 0) (subsequences (bits smm)) - where - bits 0 = [] - bits n = let b = countTrailingZeros n in bit b : bits (n `clearBit` b) + return $ map (foldl' (.|.) 0) (subsequences smm) -- | Strip 'stripModMask' (by default numlock\/capslock) from a mask. cleanMask :: KeyMask -> X KeyMask cleanMask km = do smm <- join $ asks $ stripModMask . config - return (complement smm .&. km) + return (complement (foldl' (.|.) 0 smm) .&. km) -- | Set the 'Pixel' alpha value to 255. setPixelSolid :: Pixel -> Pixel