Fixed bug where multiple configures would override previous configures for window-specific bindings

3 files changed, 19 insertions, 17 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)
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index dfb1429..f834796 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -28,13 +28,6 @@ class Bindable k where
 
   bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
 
-instance Semigroup (KeysM l ()) where
-  (<>) = mappend
-
-instance Monoid (KeysM l ()) where
-  mempty = return ()
-  mappend = (>>)
-
 runKeys :: KeysM l a -> XConfig l -> Map (KeyMask, KeySym) (X ())
 runKeys (KeysM stateM) config =
   snd $ execState stateM (config, Map.empty)
diff --git a/src/Main.hs b/src/Main.hs
index a83f1c3..0b4a181 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -60,6 +60,10 @@ main = do
          , className =? "mpv" --> doFloat
          , className =? "gnubby_ssh_prompt" --> doFloat
          ]
+         -- This config uses dynamic workspaces, but I have to seed XMonad
+         -- with something. However, this configuration only supports 36
+         -- monitors on boot. If you need more than 36 monitors, you'll have to
+         -- configure those ones after starting XMonad.
        , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
        , handleEventHook =
            composeAll [