From bfb70428f7791000239ac1d90635677ff577fee7 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 29 Mar 2022 14:26:40 -0600
Subject: Fixed bug where multiple configures would override previous
 configures for window-specific bindings

---
 src/Internal/Keys.hs | 25 +++++++++++++++----------
 1 file changed, 15 insertions(+), 10 deletions(-)

(limited to 'src/Internal/Keys.hs')

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)
-- 
cgit