Bunch of changes. Not good git ettiquite

 - Added ShiftAndSwap functionality, which allows user to shift a
   <windowset> to a <workspace> and then swap that workspace with
   another <workspace>

   e.g. move Spotify to workspace 's' and put workspace 's' on the last
   monitor.

   This replaces the shift-and-follow as this is more powerful (shift
   and follow just puts the "shifted-to" workspace on the current
   monitor.)

   ofc if the two workspaces to swap are not visible, this just operates
   as a normal shift command.

 - Moved more dragging functionality to the Dragging.hs file and cleaned
   it up a little. More is certainly needed.

 - With the more powerful dragging functionality, many bindings are made
   redundant. I replaced one of these redundant bindings (button13 ->
   mouseWheel). This used to move the focused window around the stack,
   but this has been made redundant by the drag-to-swap functionality
   (button14 -> left-click-drag), so now it changes the master region
   size.

1 files changed, 56 insertions, 102 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index f84ccad..fe96338 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -276,6 +276,8 @@ mapWindows fn (W.StackSet cur vis hidden float) =
     mapScreen fn (W.Screen ws s sd) = W.Screen (mapWorkspace fn ws) s sd
     mapWorkspace fn (W.Workspace t l s) = W.Workspace t l (fmap (fmap fn) s)
 
+data ShiftType = JustShift | ShiftAndFollow | ShiftAndSwap
+
 keymap :: XConfig l -> KeyBindings
 keymap = runKeys $ do
   config <- getConfig
@@ -608,21 +610,42 @@ keymap = runKeys $ do
         sendMessage rotateLayout
 
   bind xK_s $ do
-    forM_ [(False, justMod), (True, shiftMod)] $ \(doView, f) ->
+    forM_ [(JustShift, justMod), (ShiftAndSwap, shiftMod), (ShiftAndFollow, controlMod)] $ \(shiftType, f) ->
       f $
         doc
-          ( if doView
-              then "Shift a windowset to a workspace and goto that workspace."
-              else "Shift a windowset to a workspace"
+          ( case shiftType of
+              ShiftAndFollow ->
+                "Shift-and-follow: Like shift-and-swap with the implicit \
+                \third parameter being the current workspace (.)"
+              ShiftAndSwap ->
+                "Shift-and-swap: Shift a windowset to a workspace then swap \
+                \that workspace with another. Primary use case is to move a \
+                \that workspace to a different screen than the current screen. \
+                \Note that this command will only work with normal workspaces."
+              JustShift -> "Shift a windowset to a workspace"
           )
-          $ pushPendingBuffer (if doView then "S " else "s ") $
-            runMaybeT_ $
+          $ pushPendingBuffer
+            ( case shiftType of
+                ShiftAndSwap -> "S "
+                JustShift -> "s "
+                ShiftAndFollow -> "^s "
+            )
+            $ runMaybeT_ $
               do
                 stackset <- lift $ X.windowset <$> X.get
                 selection <- mapMaybe locationWindow <$> readNextLocationSet
 
                 withBorderColorM "#00ffff" selection $ do
+                  lift $ addStringToPendingBuffer " "
                   ws <- readNextWorkspace
+                  finalSwap <-
+                    case shiftType of
+                      ShiftAndSwap -> do
+                        lift $ addStringToPendingBuffer " "
+                        wsName <- MaybeT . return $ workspaceName ws
+                        W.switchWorkspaces wsName <$> readNextWorkspaceName
+                      _ -> return id
+
                   lift $ do
                     (Endo allMovements) <-
                       mconcat
@@ -639,15 +662,15 @@ keymap = runKeys $ do
                         (W.findTag win stackset)
 
                     windows $
-                      ( \ss ->
-                          case () of
-                            ()
-                              | doView,
-                                (w : _) <- selection,
-                                Just ws <- W.findTag w ss ->
-                                W.greedyView ws ss
-                            _ -> ss
-                      )
+                      finalSwap
+                        . ( \ss ->
+                              case shiftType of
+                                ShiftAndFollow
+                                  | (w : _) <- selection,
+                                    Just ws <- W.findTag w ss ->
+                                    W.greedyView ws ss
+                                _ -> ss
+                          )
                         . allMovements
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
@@ -714,7 +737,7 @@ keymap = runKeys $ do
                 \have 'x' on 'z' instead. If a theater does explicity place a window,\n\t\
                 \the window is placed in the hidden workspace (which is '*')\n"
                 $ do
-                  addStringToPendingBuffer "g "
+                  addStringToPendingBuffer " g "
                   runMaybeT_ $
                     do
                       mapNextString $ \_ str -> lift $
@@ -923,6 +946,13 @@ buttonBindingsToButtonMap bindings config = Map.mapWithKey bindingToX (bindings
               )
               window
 
+myMouseMoveWindow =
+  D.mouseMoveWindowAndThen X.focus $
+    mconcat
+      [ D.ifReleased button3 D.sinkOnRelease,
+        D.ifReleased' button13 $ \w _ -> X.killWindow w
+      ]
+
 mouseMap :: forall l. XConfig l -> ButtonBindings
 mouseMap = runButtons $ do
   config <- getConfig
@@ -988,7 +1018,7 @@ mouseMap = runButtons $ do
           bind button1 $
             noMod $
               doc "Swap a window with another window by dragging." $
-                noWindow dragWindow
+                noWindow D.dragWindow
 
           bind button13 $ do
             noMod $
@@ -1028,17 +1058,8 @@ mouseMap = runButtons $ do
         subMouse $ do
           bind button1 $
             noMod $
-              doc "Start moving the window under the cursor" $
-                noWindow $
-                  D.mouseMoveWindow $ \win button ->
-                    if (button == button3)
-                      then D.thenSink win button
-                      else refresh
-
-          bind button14 $
-            noMod $
-              doc "Start moving the mouse under the cursor, but tile when completed." $
-                noWindow D.mouseMoveWindowAndSink
+              doc "Move the mouse under the cursor (like how Mod+leftMouse works)" $
+                myMouseMoveWindow
 
           bind button2 $
             noMod $
@@ -1049,19 +1070,19 @@ mouseMap = runButtons $ do
             noMod $
               doc "Resize the window under the cursor" mouseResizeWindow
 
-          let swapButtons =
+          let resizeButtons =
                 [ ( button4,
-                    "Swap the current window with the next one in the stack",
-                    noWindow $ windows W.swapDown
+                    "Increase the size of the master region",
+                    noWindow $ sendMessage Expand
                   ),
                   ( button5,
-                    "Swap the current window with the last one in the stack",
-                    noWindow $ windows W.swapUp
+                    "Shrink the size of the master region",
+                    noWindow $ sendMessage Shrink
                   )
                 ]
 
           continuous $
-            forM_ swapButtons $ \(b, d, a) ->
+            forM_ resizeButtons $ \(b, d, a) ->
               bind b $ noMod $ doc d a
 
           bind button13 $
@@ -1099,7 +1120,7 @@ mouseMap = runButtons $ do
           bind button1 $
             noMod $
               doc "'drag' a workspace to another screen" $
-                noWindow dragWorkspace
+                noWindow D.dragWorkspace
 
           let workspaceButtons =
                 [ ( button2,
@@ -1287,70 +1308,3 @@ modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
   where
     clip i | i < 0 = 0
     clip i = i
-
-dragWorkspace :: X ()
-dragWorkspace = do
-  (dpy, root) <- asks $ (,) <$> display <*> theRoot
-  (_, _, _, fromIntegral -> ox, fromIntegral -> oy, _, _, _) <- io $ queryPointer dpy root
-  mouseDrag (\_ _ -> return ()) $ do
-    (_, _, _, fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root
-    runMaybeT_ $ do
-      (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen ox oy
-      (W.Screen (W.tag -> ws2) _ _) <- MaybeT $ pointScreen nx ny
-
-      lift $ windows $ W.switchWorkspaces ws1 ws2
-
-dragWindow :: X ()
-dragWindow = do
-  (dpy, root) <- asks $ (,) <$> display <*> theRoot
-  (_, _, w, _, _, _, _, _) <- io $ queryPointer dpy root
-  if w == 0
-    then dragWorkspace
-    else do
-      cleanup <- setBorderColor "#00ffff" [w]
-
-      ref <- io $ newIORef (w, return ())
-
-      mouseDrag
-        ( \_ _ -> do
-            (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
-            (ow, ocleanup) <- io $ readIORef ref
-            logs Debug "%s, %s, %s\n" (show w) (show w') (show ow)
-            case () of
-              () | ow /= w' -> do
-                ocleanup
-                cleanup' <-
-                  if w' == 0 || w' == w
-                    then return (return ())
-                    else setBorderColor "#80a0a0" [w']
-                io $ writeIORef ref (w', cleanup')
-              () -> return ()
-
-            return ()
-        )
-        $ do
-          (_, _, w', fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root
-          (_, iocleanup) <- io $ readIORef ref
-          dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
-          desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
-          mbr <-
-            if w' == 0
-              then return Nothing
-              else getProp32s "_NET_WM_WINDOW_TYPE" w'
-
-          let isDock =
-                maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr
-          case w' of
-            _ | w' == 0 || isDock ->
-              runMaybeT_ $ do
-                (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen nx ny
-                lift $ do
-                  setAlternateWindows [w]
-                  windows $ W.sink w . W.shiftWin ws1 w
-            _ -> do
-              windows $ W.focusWindow w . W.swapWindows [(w, w')]
-
-              setAlternateWindows [w, w']
-
-              iocleanup
-              cleanup