[feat] implement dragging the "alternate" workspace.HEADmain

2 files changed, 26 insertions, 9 deletions

diff --git a/src/Rahm/Desktop/Dragging.hs b/src/Rahm/Desktop/Dragging.hs
index c95deff..1f19290 100644
--- a/src/Rahm/Desktop/Dragging.hs
+++ b/src/Rahm/Desktop/Dragging.hs
@@ -11,7 +11,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import qualified Data.Set as Set
 import Graphics.X11.Xlib.Extras
 import Rahm.Desktop.BorderColors (BorderColor (BorderColor), setBorderColor)
-import Rahm.Desktop.Common (pointerLocation, pointerWindow, runMaybeT_, floatAll)
+import Rahm.Desktop.Common (floatAll, pointerLocation, pointerWindow, runMaybeT_)
 import Rahm.Desktop.Layout.Hole (addHoleForWindow, removeHoleForWindow, resetHole)
 import Rahm.Desktop.Layout.PinWindow (isWindowPinned, pinWindow, unpinWindow)
 import Rahm.Desktop.Logger
@@ -20,6 +20,7 @@ import qualified Rahm.Desktop.StackSet as W
 import XMonad (X, io)
 import qualified XMonad as X
 import XMonad.Util.WindowProperties (getProp32s)
+import Rahm.Desktop.Workspaces (accompanyingWorkspace)
 
 -- Action which happens after a dragging event.
 --
@@ -217,6 +218,17 @@ dragWorkspace = do
 
       lift $ X.windows $ W.switchWorkspaces ws1 ws2
 
+dragAlternateWorkspace :: X ()
+dragAlternateWorkspace = do
+  (ox, oy) <- pointerLocation
+  X.mouseDrag (\_ _ -> return ()) $ do
+    (nx, ny) <- pointerLocation
+    runMaybeT_ $ do
+      (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ X.pointScreen ox oy
+      (W.Screen (W.tag -> ws2) _ _) <- MaybeT $ X.pointScreen nx ny
+
+      lift $ X.windows $ W.switchWorkspaces (accompanyingWorkspace ws1) ws2
+
 dragWindow :: X ()
 dragWindow = do
   w <- pointerWindow
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 1985caf..4a2a426 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -150,6 +150,8 @@ import XMonad.Layout.Spacing
 import XMonad.Util.Run (hPutStrLn, safeSpawn, spawnPipe)
 import XMonad.Util.WindowProperties
 import Prelude hiding ((!!))
+import Rahm.Desktop.Dragging (windowsUnderCursor)
+import Control.Applicative
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 
@@ -163,9 +165,13 @@ safeSpawnX = safeSpawn
 
 selectedWindowsColor = BorderColor "#00ffff" "#00ffff"
 
-decreaseVolume = spawnX "set-app-volume.sh --down"
+decreaseVolume = do
+  wins <- (<|>[0]) <$> windowsUnderCursor
+  spawnX $ printf "set-app-volume.sh %d --down" (head wins)
 
-increaseVolume = spawnX "set-app-volume.sh --up"
+increaseVolume = do
+  wins <- (<|>[0]) <$> windowsUnderCursor
+  spawnX $ printf "set-app-volume.sh %d --up" (head wins)
 
 playPause = spawnX "media-control play"
 
@@ -1058,6 +1064,11 @@ bindings = do
             doc "Drag a workspace to a different screen" $
               noWindow D.dragWorkspace
 
+        bind button15 $
+          noMod $
+            doc "Drag a workspace to a different screen" $
+              noWindow D.dragAlternateWorkspace
+
         bind button1 $
           noMod $
             doc "Swap a window with another window by dragging." $
@@ -1069,12 +1080,6 @@ bindings = do
               noWindow $
                 click >> sendMessage togglePop
 
-        bind button15 $ do
-          noMod $
-            doc "Spawn 'pavucontrol'" $
-              noWindow $
-                spawnX "pavucontrol"
-
         let mediaButtons =
               [ (button4, "Increase volume", noWindow increaseVolume),
                 (button5, "Decrease volume", noWindow decreaseVolume),