From 4e718217ada0367b220f0e2134dbf6cbdcb28977 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 24 Mar 2022 10:38:05 -0600
Subject: Add more mouse motions. Add bindings for navigation to button15+<>

---
 src/Internal/Keys.hs         | 48 +++++++++++++++++++++++++++++++++++---------
 src/Internal/ScreenRotate.hs | 19 ++++++++++++++++++
 src/Main.hs                  |  5 +++--
 3 files changed, 60 insertions(+), 12 deletions(-)
 create mode 100644 src/Internal/ScreenRotate.hs

(limited to 'src')

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 195e12f..1118788 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -45,6 +45,7 @@ import Internal.Lib
 import Internal.DMenu
 import Internal.PassMenu
 import Internal.Logger
+import Internal.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -376,6 +377,17 @@ mouseMap = runButtons $ do
           Map.lookup button (mouseMap config)
       subMouse = submapButtonsWithKey defaultButtons . flip runButtons config
 
+
+  let continuous :: [(Button, X ())] -> Button -> Window -> X ()
+      continuous actions button w = do
+        case find ((==button) . fst) actions of
+          Just (_, action) -> action
+          Nothing -> return ()
+
+        (subMouse $
+          forM_ (map fst actions) $ \b ->
+            bind b $ noMod $ \w -> continuous actions b w) w
+
   bind button1 $ do
     justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
 
@@ -406,6 +418,9 @@ mouseMap = runButtons $ do
       bind button14 $ do
         noMod $ \_ -> click >> sendMessage ToggleZoom
 
+      bind button15 $ do
+        noMod $ \_ -> spawn "pavucontrol"
+
       let mediaButtons = [
             (button4, increaseVolume),
             (button5, decreaseVolume),
@@ -416,19 +431,32 @@ mouseMap = runButtons $ do
             (button7, mediaNext)
             ]
 
+      forM_ (map fst mediaButtons) $ \b ->
+        bind b $ noMod $ continuous mediaButtons b
 
-      let continuous :: [(Button, X ())] -> Button -> Window -> X ()
-          continuous actions button w = do
-            case find ((==button) . fst) actions of
-              Just (_, action) -> action
-              Nothing -> return ()
+  bind button15 $ do
 
-            (subMouse $
-              forM_ (map fst mediaButtons) $ \b ->
-                bind b $ noMod $ \w -> continuous actions b w) w
+    noMod $ subMouse $ do
+      
+      bind button15 $ do
+        noMod $ \_ -> jumpToLast
 
-      forM_ (map fst mediaButtons) $ \b ->
-        bind b $ noMod $ continuous mediaButtons b
+
+      let workspaceButtons = [
+            (button2, swapMaster),
+
+            (button9, relativeWorkspaceShift next),
+            (button8, relativeWorkspaceShift prev),
+
+            (button4, windows W.focusUp),
+            (button5, windows W.focusDown),
+
+            (button7, windows screenRotateForward),
+            (button6, windows screenRotateBackward)
+            ]
+
+      forM_ (map fst workspaceButtons) $ \b ->
+        bind b $ noMod $ continuous workspaceButtons b
 
 applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config =
diff --git a/src/Internal/ScreenRotate.hs b/src/Internal/ScreenRotate.hs
new file mode 100644
index 0000000..ff6417c
--- /dev/null
+++ b/src/Internal/ScreenRotate.hs
@@ -0,0 +1,19 @@
+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
+  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
+  let screens = current : visible
+      workspaces = rcycle $ map W.workspace screens
+      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
+      in W.StackSet current' visible' others floating
+
+  where rcycle l = last l : l
diff --git a/src/Main.hs b/src/Main.hs
index cda3ae2..5433c2e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -48,8 +48,9 @@ main = do
          , title =? "Event Tester" --> doFloat
          , title =? "Floating Term" --> doCenterFloat
          , title =? "Notes" --> doCenterFloat
-         , title =? "xmessage" --> doFloat
-         , title =? "gxmessage" --> doFloat
+         , title =? "xmessage" --> doCenterFloat
+         , title =? "gxmessage" --> doCenterFloat
+         , title =? "Volume Control" --> doCenterFloat
          , className =? "mpv" --> doFloat
          , className =? "gnubby_ssh_prompt" --> doFloat
          ]
-- 
cgit