Add new 'selected windows' feature

This new feature creates a 'selected windows' buffer which allows
the user to select windows. These windows are then automatically
made the argument for a Wml window operation such as shifting.

This is great for when one wants to apply an action to a set of windows
which are too difficult to describe with Wml expressions.

In addition, I have added a bunch of mouse bindings and key bindings
to this.

1 files changed, 40 insertions, 13 deletions

diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 2cb71c3..f5d8f9f 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -8,6 +8,7 @@ module Rahm.Desktop.Submap
     submap,
     submapDefault,
     submapDefaultWithKey,
+    escape,
   )
 where
 
@@ -19,15 +20,17 @@ import Data.Map (Map)
 import qualified Data.Map as Map (findWithDefault, lookup)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import Data.Word (Word64)
-import Rahm.Desktop.Common (runMaybeT_)
+import Rahm.Desktop.Common (pointerWindow, runMaybeT_)
 import XMonad
   ( Button,
     ButtonMask,
     Display,
     Event (..),
+    ExtensionClass (initialValue),
     KeyMask,
     KeySym,
     MonadReader (ask),
+    StateExtension,
     Window,
     X,
     XConf (..),
@@ -52,6 +55,23 @@ import XMonad
     ungrabPointer,
     (.|.),
   )
+import qualified XMonad.Util.ExtensibleState as XS
+
+newtype Escape = Escape Bool
+
+instance ExtensionClass Escape where
+  initialValue = Escape False
+
+-- Escape a submapping. Useful for continuous submappings where a final
+-- button/key should finish the mapping.
+escape :: X ()
+escape = XS.put (Escape True)
+
+getEscape :: X Bool
+getEscape = do
+  (Escape cur) <- XS.get
+  XS.put (Escape False)
+  return cur
 
 currentTimeMillis :: IO Int
 currentTimeMillis = round . (* 1000) <$> getPOSIXTime
@@ -131,17 +151,23 @@ submap = submapDefault (return ())
 -- next button is pressed.
 nextButton :: X (Maybe (ButtonMask, Button))
 nextButton = do
-  XConf {theRoot = root, display = d} <- ask
-  io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
+  b <- getEscape
+  if b
+    then return Nothing
+    else nextButton'
+  where
+    nextButton' = do
+      XConf {theRoot = root, display = d} <- ask
+      io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
 
-  ret <- io $
-    getMaskEventWithTimeout 5000 d buttonPressMask $ \xEv -> do
-      ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv
-      return (m, button)
+      ret <- io $
+        getMaskEventWithTimeout 5000 d buttonPressMask $ \xEv -> do
+          ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv
+          return (m, button)
 
-  io $ ungrabPointer d currentTime
+      io $ ungrabPointer d currentTime
 
-  return ret
+      return ret
 
 {- Grabs the mouse and reports the next mouse motion. -}
 nextMotion :: X (Int, Int)
@@ -184,9 +210,10 @@ submapButtonsWithKey ::
 submapButtonsWithKey defaultAction actions window = do
   maybe
     (return ())
-    ( \arg@(_, button) ->
-        case Map.lookup arg actions of
-          Nothing -> defaultAction arg window
-          Just fn -> fn window
+    ( \key -> do
+        win' <- pointerWindow
+        case Map.lookup key actions of
+          Nothing -> defaultAction key win'
+          Just fn -> fn win'
     )
     =<< nextButton