aboutsummaryrefslogtreecommitdiff
path: root/src/Internal/Keys.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Internal/Keys.hs')
-rw-r--r--src/Internal/Keys.hs25
1 files changed, 15 insertions, 10 deletions
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index ad3d6b8..ce48dfd 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RankNTypes, FlexibleContexts #-}
module Internal.Keys (applyKeys) where
import Data.Monoid (Endo(..))
import Control.Monad.Trans.Class
import Control.Monad.Reader
+import Control.Monad.Writer
import Control.Monad.Loops (iterateWhile)
import Control.Monad.Fix (fix)
import Graphics.X11.ExtraTypes.XF86;
@@ -486,9 +487,13 @@ mouseMap = runButtons $ do
-- This is useful to create hotkeys in applications where hot keys are not
-- configurable, or to remove keybindings that are irritating (looking at you,
-- ctrl+w in Chrome!!).
-windowSpecificBindings :: Query (KeysM l ())
-windowSpecificBindings = do
- w <- ask
+windowSpecificBindings ::
+ XConfig l -> WriterT (Map (KeyMask, KeySym) (X ())) Query ()
+windowSpecificBindings config = do
+
+ w <- lift ask
+
+ let configureIf b k = tell =<< lift (b --> return (runKeys k config))
configureIf (flip elem browsers <$> className) $ do
@@ -576,10 +581,6 @@ windowSpecificBindings = do
-- [C, S, M, C + M, C + S, M + S, C + S + M, 0]
permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
-
- configureIf :: Query Bool -> KeysM l () -> Query (KeysM l ())
- configureIf b k = b --> return k
-
windowBindings :: XConfig l -> XConfig l
windowBindings xconfig =
xconfig {
@@ -593,8 +594,12 @@ windowBindings xconfig =
where
doQuery :: Query ()
doQuery = do
- keysM <- windowSpecificBindings
- forM_ (Map.toList $ runKeys keysM xconfig) $ \(key, action) -> do
+ map <- execWriterT $ windowSpecificBindings xconfig
+ w <- ask
+
+ liftX $ logs $ printf "For Window: %s" (show w)
+ forM_ (Map.toList map) $ \(key, action) -> do
+ liftX $ logs $ printf " -- remap: %s" (show key)
remapKey key action
applyKeys :: XConfig l -> IO (XConfig l)