Move Intercept to RebindKeys. Remove the intercept subsystem as it was experimental and I do not have a real use for it anymore.

5 files changed, 38 insertions, 86 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index aeb3602..9a45f7e 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
-import Internal.Intercept (setIntercept)
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
@@ -46,6 +45,7 @@ import Internal.Lib
 import Internal.DMenu
 import Internal.PassMenu
 import Internal.Logger
+import Internal.RebindKeys
 import Internal.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -246,12 +246,6 @@ keymap = runKeys $ do
           if (x' - x) < 0
             then mediaPrev
             else mediaNext
-
-      bind xK_t $
-
-        (justMod -|- noMod) $
-          setIntercept (modMask config, xK_i) $
-            logs $ "Intercepted!"
  
   bind xK_r $ do
     justMod runDMenu
diff --git a/src/Internal/Logger.hs b/src/Internal/Logger.hs
index f1960fb..cc52c7e 100644
--- a/src/Internal/Logger.hs
+++ b/src/Internal/Logger.hs
@@ -4,17 +4,13 @@ import XMonad
 import qualified XMonad.Util.ExtensibleState as XS
 import System.IO
 
+import Internal.NoPersist
+
 data LoggerState =
   LoggerState {
-    logHandle :: Maybe Handle
+    logHandle :: Maybe (NoPersist Handle)
   }
 
-instance Read LoggerState where
-  readsPrec i s = map (\(_, s) -> (LoggerState Nothing, s)) (readsPrec i s :: [((), String)])
-
-instance Show LoggerState where
-  show _ = show ()
-
 instance ExtensionClass LoggerState where
   initialValue = LoggerState Nothing
 
@@ -26,10 +22,10 @@ logs s = do
     case handle' of
       Nothing -> do
         handle <- io $ openFile "/tmp/xmonad.log" AppendMode
-        XS.put $ LoggerState (Just handle)
+        XS.put $ LoggerState $ Just $ NoPersist handle
         return handle
 
-      Just h -> return h
+      Just (NoPersist h) -> return h
   
   io $ do
     hPutStrLn handle s
diff --git a/src/Internal/Intercept.hs b/src/Internal/RebindKeys.hs
index c99ce09..22b0165 100644
--- a/src/Internal/Intercept.hs
+++ b/src/Internal/RebindKeys.hs
@@ -2,7 +2,7 @@
 -- Module for intercepting key presses not explicity mapped in the key bindings.
 -- This uses some deep magic with grabKey and windows and everything else, but
 -- it makes window-specific key bindings awesome!
-module Internal.Intercept where
+module Internal.RebindKeys where
 
 import XMonad
 
@@ -17,28 +17,15 @@ import qualified XMonad.Util.ExtensibleState as XS
 import Data.Monoid (All(..))
 
 import Internal.Logger
+import Internal.NoPersist
 
 type WindowHook = Query ()
 
-newtype NoPersist a = NoPersist a
-  deriving (Typeable)
+data InterceptState =
+  InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
 
-instance Show (NoPersist a) where
-  show (NoPersist _) = show ()
-
-instance (Default a) => Read (NoPersist a) where
-  readsPrec i s = map (\(_, s) -> (NoPersist def, s)) (readsPrec i s :: [((), String)])
-
-instance (Default a) => Default (NoPersist a) where
-  def = NoPersist def
-
-instance (Default a, Typeable a) => ExtensionClass (NoPersist a) where
-  initialValue = NoPersist def
-
-
-data InterceptState = InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
-
-data RemapState = RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
+data RemapState =
+  RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
 
 instance ExtensionClass InterceptState where
   initialValue = InterceptState def
@@ -66,36 +53,6 @@ remapHook event = do
 
     _ -> return (All True)
 
-interceptHook :: Event -> X All
-interceptHook event = do
-  InterceptState (NoPersist map) <- XS.get
-  case event of
-    KeyEvent { ev_event_type = typ, ev_keycode = code, ev_state = m }
-        | typ == keyPress-> do
-      XConf {display = dpy, theRoot = rootw} <- ask
-      keysym <- io $ keycodeToKeysym dpy code 0
-
-      case Map.lookup (m, keysym) map of
-
-        Just xdo -> do
-          xdo
-          mapM_ (\m' -> io $ ungrabKey dpy code (m .|. m') rootw)
-              =<< extraModifiers
-          return (All False)
-
-        Nothing -> return (All True)
-
-    _ -> return (All True)
-
-setIntercept :: (KeyMask, KeySym) -> X () -> X ()
-setIntercept (keyMask, keysym) action = do
-  XS.modify $ \(InterceptState (NoPersist m)) -> InterceptState $ NoPersist $
-    Map.insert (keyMask, keysym) action m
-  XConf { display = dpy, theRoot = rootw } <- ask
-
-  doGrab dpy rootw (keyMask, keysym)
-
-
 getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
 getKeyCodesForKeysym dpy keysym = do
   let (minCode, maxCode) = displayKeycodes dpy
@@ -134,19 +91,24 @@ remapKey keyFrom action = do
     XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
       Map.insert (window, keyFrom) action keyMap
 
+sendKey :: (KeyMask, KeySym) -> Window -> X ()
+sendKey (keymask, keysym) w = do
+  XConf { display = disp, theRoot = rootw } <- ask
+
+  codes <- io $ getKeyCodesForKeysym disp keysym
+
+  case codes of
+    (keycode:_) ->
+      io $ allocaXEvent $ \xEv -> do
+        setEventType xEv keyPress
+        setKeyEvent xEv w rootw none keymask keycode True
+        sendEvent disp w True keyPressMask xEv
+
+        setEventType xEv keyRelease
+        sendEvent disp w True keyReleaseMask xEv
+
+    _ -> return ()
+
 rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
-rebindKey keyFrom keyTo = do
-  window <- ask
-  remapKey keyFrom $ do
-    XConf { display = disp, theRoot = rootw } <- ask
-    codes <- io $ getKeyCodesForKeysym disp (snd keyTo)
-    case codes of
-      (keyCode:_) -> do
-        io $ allocaXEvent $ \xEv -> do
-          setEventType xEv keyPress
-          setKeyEvent xEv window rootw none (fst keyTo) keyCode True
-          sendEvent disp window True keyPressMask xEv
-          setEventType xEv keyRelease
-          sendEvent disp window True keyPressMask xEv
-
-      _ -> return ()
+rebindKey keyFrom keyTo =
+  (remapKey keyFrom . sendKey keyTo) =<< ask
diff --git a/src/Internal/ScreenRotate.hs b/src/Internal/ScreenRotate.hs
index ff6417c..8108381 100644
--- a/src/Internal/ScreenRotate.hs
+++ b/src/Internal/ScreenRotate.hs
@@ -2,15 +2,15 @@ module Internal.ScreenRotate where
 
 import XMonad.StackSet as W
 
-screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateForward (W.StackSet current visible others floating) = do
+screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateBackward (W.StackSet current visible others floating) = do
   let screens = current : visible
       workspaces = tail $ cycle $ map W.workspace screens
       (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
       in W.StackSet current' visible' others floating
 
-screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateBackward (W.StackSet current visible others floating) = do
+screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateForward (W.StackSet current visible others floating) = do
   let screens = current : visible
       workspaces = rcycle $ map W.workspace screens
       (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
diff --git a/src/Main.hs b/src/Main.hs
index 379131c..b17f62a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,7 +16,7 @@ import Internal.Keys
 import Internal.Layout
 import Internal.Logger
 import Internal.DMenu (menuCommandString)
-import Internal.Intercept
+import Internal.RebindKeys
 import XMonad.Actions.WithAll (withAll)
 
 import qualified XMonad as X
@@ -70,7 +70,7 @@ main = do
          ]
        , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
        , handleEventHook =
-           composeAll [fullscreenEventHook, interceptHook, remapHook]
+           composeAll [fullscreenEventHook, remapHook]
        , focusFollowsMouse = False
        , clickJustFocuses = False
        , logHook = xMobarLogHook xmobar