From 7451146b8738db5bd31c968e9fc6703fcbff6078 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 4 Dec 2023 11:47:40 -0700
Subject: Change the rotate-screen-left/right to just swap current screen with
 left/right. It is more intuitive and is more flexible. As a part of this, I
 incresed the timeout for multiple button bindings to 5000ms like how
 keystrokes work.

---
 src/Rahm/Desktop/Hooks/WindowChange.hs |  3 +--
 src/Rahm/Desktop/Keys.hs               | 16 ++++++++++++----
 src/Rahm/Desktop/Keys/Wml.hs           | 11 +++++++++++
 src/Rahm/Desktop/Submap.hs             |  2 +-
 4 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs
index 4cb2371..32c854b 100644
--- a/src/Rahm/Desktop/Hooks/WindowChange.hs
+++ b/src/Rahm/Desktop/Hooks/WindowChange.hs
@@ -4,8 +4,7 @@ import Control.Monad (when)
 import Control.Monad.State (gets)
 import Data.Default (Default (..))
 import Rahm.Desktop.Common
-  ( Location (Location),
-    getCurrentScreen,
+  ( getCurrentScreen,
     getCurrentWorkspace,
   )
 import qualified Rahm.Desktop.StackSet as W (peek)
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index e92cfdf..f4ccb72 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -85,6 +85,8 @@ import Rahm.Desktop.Keys.Wml
     readNextWorkspace,
     readWindowsetMacro,
     readWorkspaceMacro,
+    workspaceForStringT,
+    workspaceForString,
     workspaceName,
   )
 import Rahm.Desktop.Layout (nLayouts)
@@ -1058,12 +1060,18 @@ mouseMap = runButtons $ do
                     noWindow $ windows W.focusDown
                   ),
                   ( button7,
-                    "Rotate the visible workspaces on the screens to the right",
-                    noWindow $ windows W.screenRotateForward
+                    "Swap the current screen with the one to the right",
+                    noWindow $ do
+                      click
+                      runMaybeT_ $
+                        (lift . gotoWorkspaceFn) =<< workspaceForStringT ",."
                   ),
                   ( button6,
-                    "Rotate the visible workspaces on the screens to the left",
-                    noWindow $ windows W.screenRotateBackward
+                    "Swap the current screen with the one to the left",
+                    noWindow $ do
+                      click
+                      runMaybeT_ $
+                        (lift . gotoWorkspaceFn) =<< workspaceForStringT ";."
                   )
                 ]
 
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index d1e381c..7a59cbd 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -31,6 +31,8 @@ module Rahm.Desktop.Keys.Wml
     feedKeysT,
     workspaceForKeysT,
     workspaceForKeys,
+    workspaceForStringT,
+    workspaceForString,
     locationSetForKeysT,
     locationSetForKeys,
     readNextWorkspaceName,
@@ -366,6 +368,15 @@ workspaceForKeysT str = feedKeysT str readNextWorkspace
 workspaceForKeys :: KeyString -> X (Maybe Workspace)
 workspaceForKeys = runMaybeT . workspaceForKeysT
 
+-- Returns a workspace for the given string. Note that workspaces which are
+-- defined by special masks and symbols will not work. I.e. macros will not
+-- work.
+workspaceForStringT :: String -> MaybeT X Workspace
+workspaceForStringT = workspaceForKeysT . map (\c -> (def, def, [c]))
+
+workspaceForString :: String -> X (Maybe Workspace)
+workspaceForString = runMaybeT . workspaceForStringT
+
 -- Like the above, but unwrap the MaybeT
 locationSetForKeysT :: KeyString -> MaybeT X [Location]
 locationSetForKeysT s = feedKeysT s readNextLocationSet
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 5eb8ea0..2cb71c3 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -135,7 +135,7 @@ nextButton = do
   io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
 
   ret <- io $
-    getMaskEventWithTimeout 1000 d buttonPressMask $ \xEv -> do
+    getMaskEventWithTimeout 5000 d buttonPressMask $ \xEv -> do
       ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv
       return (m, button)
 
-- 
cgit