From d15ea771e45b60f32c83bfd90386c60d192299c0 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 11:52:34 -0600
Subject: Add (some) ability to send keys to other windows

---
 src/Internal/Keys.hs       | 21 +++++++++++++++++++++
 src/Internal/RebindKeys.hs |  6 ++++++
 src/Internal/Windows.hs    |  9 ++++++++-
 src/Main.hs                |  4 ++--
 4 files changed, 37 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 5d4e6fe..13112cb 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Control.Monad.Trans.Class
+import Control.Monad.Reader
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
@@ -41,6 +43,7 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
+import Internal.Windows
 import Internal.Lib
 import Internal.DMenu
 import Internal.PassMenu
@@ -112,8 +115,26 @@ keymap = runKeys $ do
     -- something goes wrong with the keyboard layout and for first-time boots
     -- where dmenu/alacritty may not be installed.
     rawMask mod4Mask $ spawn "xterm"
+
+    -- Moves xmobar to different monitors.
     justMod $ spawn "pkill -SIGUSR1 xmobar"
 
+  bind xK_F1 $ do
+    -- Experimental. Sends 'a' to all windows.
+    --
+    -- I've discovered that many clients ignore such synthetic events, including
+    -- Spotify, Chrome and Gedit. Some, like Chrome, seem to honor them if it's
+    -- focused. It's pretty annoying because it keeps me from doing some cool
+    -- things all for BS security theater, but I guess there might be some way
+    -- to do this via XTest?
+    shiftMod $ forAllWindows  $ \w -> do
+      logs $ "Try send to " ++ show w
+      sendKey (0, xK_a) w
+
+    -- Experimental. Sends 'A' 10 times to the focused window.
+    justMod $
+      replicateM_ 10 $ withFocused (sendKey (shiftMask, xK_a))
+
   bind xK_F10 $ do
     justMod playPause
 
diff --git a/src/Internal/RebindKeys.hs b/src/Internal/RebindKeys.hs
index 22b0165..7c5d47c 100644
--- a/src/Internal/RebindKeys.hs
+++ b/src/Internal/RebindKeys.hs
@@ -91,6 +91,12 @@ remapKey keyFrom action = do
     XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
       Map.insert (window, keyFrom) action keyMap
 
+-- sendKey, but as a query.
+sendKeyQ :: (KeyMask, KeySym) -> Query ()
+sendKeyQ key = do
+  win <- ask
+  liftX (sendKey key win)
+
 sendKey :: (KeyMask, KeySym) -> Window -> X ()
 sendKey (keymask, keysym) w = do
   XConf { display = disp, theRoot = rootw } <- ask
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
index b6f5335..c6a2b8b 100644
--- a/src/Internal/Windows.hs
+++ b/src/Internal/Windows.hs
@@ -1,7 +1,9 @@
 module Internal.Windows where
 
+import XMonad (windowset, X, Window, get)
+
 import Control.Applicative ((<|>))
-import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate, integrate')
+import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate, integrate', allWindows)
 import Data.Maybe (listToMaybe, catMaybes)
 import qualified Data.Map as Map
 
@@ -45,6 +47,11 @@ getLocationWorkspace _ = Nothing
 workspaceMember :: (Eq a) => Workspace i l a -> a -> Bool
 workspaceMember (Workspace _ _ s) w = w `elem` integrate' s
 
+forAllWindows :: (Window -> X ()) -> X ()
+forAllWindows fn = do
+  stackSet <- windowset <$> get
+  mapM_ fn (allWindows stackSet)
+
 {- Finds a Window and returns the screen its on and the workspace its on.
  - Returns nothing if the window doesn't exist. 
  -
diff --git a/src/Main.hs b/src/Main.hs
index b17f62a..0514a99 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,12 +12,12 @@ import System.Environment (setEnv)
 import Data.Monoid
 
 import Internal.XMobarLog
+import Internal.Windows
 import Internal.Keys
 import Internal.Layout
 import Internal.Logger
 import Internal.DMenu (menuCommandString)
 import Internal.RebindKeys
-import XMonad.Actions.WithAll (withAll)
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
@@ -89,7 +89,7 @@ windowHooks (Query readerT) config = do
 
   config {
     startupHook = do
-      withAll $ \w -> runReaderT readerT w
+      forAllWindows $ \w -> runReaderT readerT w
       startupHook config,
 
     manageHook = mappend (Query readerT >> return (Endo id)) (manageHook config)
-- 
cgit