From 79278d94754525930b18db46e4e3861b7a30e4f0 Mon Sep 17 00:00:00 2001
From: slotThe <soliditsallgood@mailbox.org>
Date: Thu, 25 Nov 2021 08:53:02 +0100
Subject: [PATCH] X.Operations: Use custom cursor for dragging/resizing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When dragging and resizing windows, users may expect the cursor to
change to indicate the respective behaviour.  In particular, many other
window managers already do this [1] [2].

Thus, introduce a new (non-exported) `mouseDragCursor` function that
takes a cursor shape and change the generic resize and move functions to
use that.  The reason that we don't change `mouseDrag` itself (for now)
is that this is exported and quite a few contrib modules use it—breaking
compatibility with xmonad-0.17.0 so soon after the release seems unwise.

Fixes: https://github.com/xmonad/xmonad/issues/348

[1]: https://git.suckless.org/dwm/file/dwm.c.html#l1567
[2]: https://github.com/awesomeWM/awesome/blob/7a8fa9d27a7907ab81e60274c925ba65d10015aa/lib/awful/mouse/resize.lua#L23
---
 CHANGES.md               |  4 ++++
 src/XMonad/Operations.hs | 21 +++++++++++++++------
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index b77c985..7ef2852 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,10 @@
 
 ## unknown
 
+### Enhancements
+
+  * Added custom cursor shapes for resizing and moving windows.
+
 ## 0.17.0 (October 27, 2021)
 
 ### Enhancements
diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs
index bfa661c..2422347 100644
--- a/src/XMonad/Operations.hs
+++ b/src/XMonad/Operations.hs
@@ -654,14 +654,20 @@ float w = do
 
 -- | Accumulate mouse motion events
 mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
-mouseDrag f done = do
+mouseDrag = mouseDragCursor Nothing
+
+-- | Like 'mouseDrag', but with the ability to specify a custom cursor
+-- shape.
+mouseDragCursor :: Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
+mouseDragCursor cursorGlyph f done = do
     drag <- gets dragging
     case drag of
         Just _ -> return () -- error case? we're already dragging
         Nothing -> do
             XConf { theRoot = root, display = d } <- ask
-            io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
-                    grabModeAsync grabModeAsync none none currentTime
+            io $ do cursor <- maybe (pure none) (createFontCursor d) cursorGlyph
+                    grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
+                      grabModeAsync grabModeAsync none cursor currentTime
             modify $ \s -> s { dragging = Just (motion, cleanup) }
  where
     cleanup = do
@@ -679,7 +685,9 @@ mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
     let ox = fromIntegral ox'
         oy = fromIntegral oy'
-    mouseDrag (\ex ey -> do
+    mouseDragCursor
+              (Just xC_fleur)
+              (\ex ey -> do
                   io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
                                       (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
                   float w
@@ -692,12 +700,13 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     wa <- io $ getWindowAttributes d w
     sh <- io $ getWMNormalHints d w
     io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
-    mouseDrag (\ex ey -> do
+    mouseDragCursor
+              (Just xC_bottom_right_corner)
+              (\ex ey -> do
                  io $ resizeWindow d w `uncurry`
                     applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
                                                ey - fromIntegral (wa_y wa))
                  float w)
-
               (float w)
 
 -- ---------------------------------------------------------------------