aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Rahm/Desktop/Keys.hs1
-rw-r--r--src/Rahm/Desktop/Keys/Dsl2.hs109
-rw-r--r--src/Rahm/Desktop/Keys/Grab.hs37
-rw-r--r--src/Rahm/Desktop/Keys/KeyCodeMapping.hs76
-rw-r--r--src/Rahm/Desktop/RebindKeys.hs2
5 files changed, 123 insertions, 102 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 5402e33..0d24593 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -63,6 +63,7 @@ import Rahm.Desktop.History
jumpToLastLocation,
)
import Rahm.Desktop.Keys.Dsl2
+import Rahm.Desktop.Keys.Grab (KeySymOrKeyCode(..))
import Rahm.Desktop.Keys.Wml
( addWindowToSelection,
clearWindowSelection,
diff --git a/src/Rahm/Desktop/Keys/Dsl2.hs b/src/Rahm/Desktop/Keys/Dsl2.hs
index d2eb662..c9cea83 100644
--- a/src/Rahm/Desktop/Keys/Dsl2.hs
+++ b/src/Rahm/Desktop/Keys/Dsl2.hs
@@ -35,13 +35,14 @@ import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
+import Rahm.Desktop.Keys.KeyCodeMapping (setupKeycodeMapping)
+import Rahm.Desktop.Keys.Grab
import Rahm.Desktop.Common (pointerWindow, runMaybeT_)
import Rahm.Desktop.Logger (LogLevel (Debug, Info), logs)
import Rahm.Desktop.Submap (ButtonOrKeyEvent (ButtonPress, KeyPress, event_keycode, event_mask), getStringForKey, nextButtonOrKeyEvent)
import Rahm.Desktop.XMobarLog (spawnXMobar)
import Rahm.Desktop.XMobarLog.PendingBuffer (pushAddPendingBuffer, pushPendingBuffer)
import XMonad
-import qualified XMonad.Util.ExtensibleConf as XC
-- | A documented "thing." It is essentially an item with a string attached to
-- it. A glorified tuple (String, t)
@@ -83,9 +84,6 @@ instance LiftBinding Button where
type Super Button = Button
doLift = id
-data KeySymOrKeyCode = Ks KeySym | Kc KeyCode
- deriving (Ord, Eq, Show, Read)
-
-- | An GADT for XConfig that hides the 'l' parameter. This keeps type
-- signatures clean by not having to carry around a superfluous type variable.
data XConfigH where
@@ -347,107 +345,16 @@ continuous (Binder b) = do
runBinder :: XConfig l -> Binder a -> BindingsMap
runBinder conf (Binder binder) = runReader (execWriterT binder) (XConfigH conf)
-type KeyCodeActionMap = Map (KeyMask, KeyCode) (X ())
-
withBindings :: Binder a -> XConfig l -> XConfig l
withBindings b config =
let (Bindings keyBinds keycodeBinds buttonBinds) =
resolveBindings $ runBinder config b
- in XC.once
- ( \c ->
- c
- { keys = keyBinds,
- mouseBindings = buttonBinds,
- handleEventHook = handleEventHook c <> eventHandler,
- startupHook = startupHook c >> startupHandler
- }
- )
- (keycodeBinds config :: KeyCodeActionMap)
- config
- where
- startupHandler = grabKeycodes
-
- eventHandler
- e@( KeyEvent
- { ev_event_type = t,
- ev_keycode = kc,
- ev_state = m
- }
- )
- | t == keyPress = do
- mapM_ (sequence_ . Map.lookup (m, kc))
- =<< getKeycodeMap
- return (All True)
-
- eventHandler e@MappingNotifyEvent{} = do
- -- Ideally, we'd like to grab the keys here, but XMonad regrabs its keys
- -- after the user event handlers run and in the process ungrab any keys
- -- we just grabbed.
- --
- -- So, we'll emit an X11 ClientMessage to tell us to regrab the keys
- -- instead. This will then run after xmonad ungrabs the keys.
- XConf {display = dpy, theRoot = rootw} <- ask
- io $ do
- at <- internAtom dpy "REGRAB_KEYCODES" False
- m <- internAtom dpy "" False
- allocaXEvent $ \ev -> do
- setEventType ev clientMessage
- setClientMessageEvent ev rootw at 32 m currentTime
- sendEvent dpy rootw False structureNotifyMask ev
- sync dpy False
- return (All True)
-
- eventHandler e@ClientMessageEvent { ev_message_type = atom } = do
- -- We are asked to regrab the keycodes, so we'll do that.
- dpy <- asks display
- name <- io $ getAtomName dpy atom
-
- if name == Just "REGRAB_KEYCODES"
- then grabKeycodes >> return (All False)
- else return (All True)
-
- eventHandler _ = return (All True)
-
-getKeycodeMap :: X (Maybe KeyCodeActionMap)
-getKeycodeMap = XC.ask
-
-getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
-getKeyCodesForKeysym dpy keysym = do
- let (minCode, maxCode) = displayKeycodes dpy
- allCodes = [fromIntegral minCode .. fromIntegral maxCode]
-
- syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
- let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
-
- -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
- -- want to grab those whenever someone accidentally uses def :: KeySym
- let keysymMap = Map.delete noSymbol keysymMap'
- let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
-
- return $ keysymToKeycodes keysym
-
-
-doGrab :: Display -> Window -> (KeyMask, KeySymOrKeyCode) -> X ()
-doGrab dpy win (keyMask, keySymOrKeyCode) = do
- let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
-
- codes <-
- case keySymOrKeyCode of
- Ks keysym ->
- io $ getKeyCodesForKeysym dpy keysym
- Kc keycode -> return [keycode]
-
- forM_ codes $ \kc ->
- mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
-
-grabKeycodes :: X ()
-grabKeycodes = do
- XConf {display = dpy, theRoot = rootw} <- ask
-
- mKeycodeBinds <- getKeycodeMap
- forM_ mKeycodeBinds $ \keycodeBinds -> do
- forM_ (Map.toList keycodeBinds) $ \((m, kc), _) -> do
- doGrab dpy rootw (m, Kc kc)
+ in
+ setupKeycodeMapping keycodeBinds $
+ config {
+ keys = keyBinds,
+ mouseBindings = buttonBinds
+ }
documentation :: XConfig l -> Binder () -> String
documentation conf binder =
diff --git a/src/Rahm/Desktop/Keys/Grab.hs b/src/Rahm/Desktop/Keys/Grab.hs
new file mode 100644
index 0000000..b9b57cd
--- /dev/null
+++ b/src/Rahm/Desktop/Keys/Grab.hs
@@ -0,0 +1,37 @@
+module Rahm.Desktop.Keys.Grab where
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import XMonad
+import Control.Monad (forM_, forM)
+
+data KeySymOrKeyCode = Ks KeySym | Kc KeyCode
+ deriving (Ord, Eq, Show, Read)
+
+doGrab :: Display -> Window -> (KeyMask, KeySymOrKeyCode) -> X ()
+doGrab dpy win (keyMask, keySymOrKeyCode) = do
+ let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
+
+ codes <-
+ case keySymOrKeyCode of
+ Ks keysym ->
+ io $ getKeyCodesForKeysym dpy keysym
+ Kc keycode -> return [keycode]
+
+ forM_ codes $ \kc ->
+ mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
+
+getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
+getKeyCodesForKeysym dpy keysym = do
+ let (minCode, maxCode) = displayKeycodes dpy
+ allCodes = [fromIntegral minCode .. fromIntegral maxCode]
+
+ syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
+ let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
+
+ -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
+ -- want to grab those whenever someone accidentally uses def :: KeySym
+ let keysymMap = Map.delete noSymbol keysymMap'
+ let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
+
+ return $ keysymToKeycodes keysym
diff --git a/src/Rahm/Desktop/Keys/KeyCodeMapping.hs b/src/Rahm/Desktop/Keys/KeyCodeMapping.hs
new file mode 100644
index 0000000..564cc18
--- /dev/null
+++ b/src/Rahm/Desktop/Keys/KeyCodeMapping.hs
@@ -0,0 +1,76 @@
+module Rahm.Desktop.Keys.KeyCodeMapping where
+
+import Rahm.Desktop.Keys.Grab
+import Data.Map (Map)
+import qualified Data.Map as Map
+import XMonad
+import qualified XMonad.Util.ExtensibleConf as XC
+import Control.Monad (forM_)
+import Control.Monad.RWS (All(All))
+
+type KeyCodeActionMap = Map (KeyMask, KeyCode) (X ())
+
+getKeycodeMap :: X (Maybe KeyCodeActionMap)
+getKeycodeMap = XC.ask
+
+setupKeycodeMapping ::
+ (forall l. XConfig l -> KeyCodeActionMap) -> XConfig l -> XConfig l
+setupKeycodeMapping actionMap config =
+ XC.once
+ ( \c ->
+ c
+ { handleEventHook = handleEventHook c <> eventHandler,
+ startupHook = startupHook c >> startupHandler
+ }
+ )
+ (actionMap config)
+ config
+ where
+ startupHandler = grabKeycodes
+
+ eventHandler
+ e@( KeyEvent
+ { ev_event_type = t,
+ ev_keycode = kc,
+ ev_state = m
+ }
+ )
+ | t == keyPress = do
+ mapM_ (sequence_ . Map.lookup (m, kc))
+ =<< getKeycodeMap
+ return (All True)
+ eventHandler e@MappingNotifyEvent {} = do
+ -- Ideally, we'd like to grab the keys here, but XMonad regrabs its keys
+ -- after the user event handlers run and in the process ungrab any keys
+ -- we just grabbed.
+ --
+ -- So, we'll emit an X11 ClientMessage to tell us to regrab the keys
+ -- instead. This will then run after xmonad ungrabs the keys.
+ XConf {display = dpy, theRoot = rootw} <- ask
+ io $ do
+ at <- internAtom dpy "REGRAB_KEYCODES" False
+ m <- internAtom dpy "" False
+ allocaXEvent $ \ev -> do
+ setEventType ev clientMessage
+ setClientMessageEvent ev rootw at 32 m currentTime
+ sendEvent dpy rootw False structureNotifyMask ev
+ sync dpy False
+ return (All True)
+ eventHandler e@ClientMessageEvent {ev_message_type = atom} = do
+ -- We are asked to regrab the keycodes, so we'll do that.
+ dpy <- asks display
+ name <- io $ getAtomName dpy atom
+
+ if name == Just "REGRAB_KEYCODES"
+ then grabKeycodes >> return (All False)
+ else return (All True)
+ eventHandler _ = return (All True)
+
+grabKeycodes :: X ()
+grabKeycodes = do
+ XConf {display = dpy, theRoot = rootw} <- ask
+
+ mKeycodeBinds <- getKeycodeMap
+ forM_ mKeycodeBinds $ \keycodeBinds -> do
+ forM_ (Map.toList keycodeBinds) $ \((m, kc), _) -> do
+ doGrab dpy rootw (m, Kc kc)
diff --git a/src/Rahm/Desktop/RebindKeys.hs b/src/Rahm/Desktop/RebindKeys.hs
index 8712b31..fb8899b 100644
--- a/src/Rahm/Desktop/RebindKeys.hs
+++ b/src/Rahm/Desktop/RebindKeys.hs
@@ -25,7 +25,7 @@ import qualified Data.Map as Map
lookup,
)
import Data.Monoid (All (..))
-import Rahm.Desktop.Keys.Dsl2 (KeySymOrKeyCode (..), doGrab, getKeyCodesForKeysym)
+import Rahm.Desktop.Keys.Grab (KeySymOrKeyCode (..), doGrab, getKeyCodesForKeysym)
import XMonad
( Default (def),
Display,
generated by cgit (git 2.34.1) at 2026-02-22 11:26:05 +0000