Cleanup implementation of tiled window dragging

files/.xmonad/lib/Config.hs

@@ -6,13 +6,14 @@ module Config (main) where
 import qualified Data.Map.Strict as M
 import Control.Concurrent
 import           Control.Exception              ( catch , SomeException)
-import           Control.Monad                  ( filterM, when )
+import           Control.Monad                  ( filterM )
 import           Control.Arrow                  ( (>>>) )
 import           Data.List                      ( isPrefixOf , isSuffixOf)
 import System.Exit (exitSuccess)
 
 import qualified Rofi
 import qualified DescribedSubmap
+import qualified TiledDragging
 
 
 import Data.Foldable                  ( for_ )
@@ -47,12 +48,10 @@ import XMonad.Layout.ThreeColumns
 
 import XMonad.Layout.WindowSwitcherDecoration
 import XMonad.Layout.DraggingVisualizer
-import XMonad.Layout.DecorationAddons
 
 import           XMonad.Util.EZConfig           ( additionalKeysP
                                                 , removeKeysP
                                                 , checkKeymap
-                                                , additionalMouseBindings
                                                 )
 import XMonad.Util.NamedScratchpad
 import XMonad.Util.Run
@@ -60,10 +59,6 @@ import XMonad.Util.SpawnOnce (spawnOnce)
 import XMonad.Util.WorkspaceCompare   ( getSortByXineramaPhysicalRule , getSortByIndex)
 
 import qualified Data.Monoid
-import           Data.Monoid                    ( All
-                                                , All(..)
-                                                )
-import           Data.Int                       ( Int32 )
 import qualified System.IO                           as SysIO
 import qualified XMonad.Actions.Navigation2D         as Nav2d
 import qualified XMonad.Config.Desktop               as Desktop
@@ -75,9 +70,7 @@ import qualified XMonad.Layout.MultiToggle.Instances as MTog
 import qualified XMonad.Layout.ToggleLayouts         as ToggleLayouts
 import qualified XMonad.StackSet                     as W
 import qualified XMonad.Util.XSelection              as XSel
-import           XMonad.Util.XUtils             ( fi )
 import qualified XMonad.Layout.PerScreen             as PerScreen
-import           Foreign.C.Types                ( CInt )
 {-# ANN module "HLint: ignore Redundant $" #-}
 {-# ANN module "HLint: ignore Redundant bracket" #-}
 {-# ANN module "HLint: ignore Move brackets to avoid $" #-}
@@ -223,6 +216,11 @@ myStartupHook = do
 
 -- Keymap --------------------------------------- {{{
 
+myMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
+myMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList
+  [((modMask' .|. shiftMask, button1), TiledDragging.tiledDrag)]
+
+
 multiMonitorOperation :: (WorkspaceId -> WindowSet -> WindowSet) -> ScreenId -> X ()
 multiMonitorOperation operation n = do
   monitor <- screenWorkspace n
@@ -496,75 +494,6 @@ polybarPP monitor = namedScratchpadFilterOutWorkspacePP . (if useSharedWorkspace
 
 -- }}}
 
-
--- Window dragging {{{
-
-myMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
-myMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList
-  [((modMask .|. shiftMask, button1), tiledDragging)]
-
-
-
-tiledDragging :: Window -> X ()
-tiledDragging window = whenX (isClient window) $ withDisplay $ \disp -> do
-  focus window
-  windows $ W.sink window
-  (offsetX, offsetY) <- getPointerOffset window disp
-  (winX, winY, winWidth, winHeight) <- io $ getWindowPlacement disp window
-
-  mouseDrag
-    (\posX posY -> let rect = Rectangle (fromIntegral (fromIntegral winX + (posX - fromIntegral offsetX)))
-                                        (fromIntegral (fromIntegral winY + (posY - fromIntegral offsetY)))
-                                        (fromIntegral winWidth)
-                                        (fromIntegral winHeight)
-                   in sendMessage $ DraggingWindow window rect)
-    (sendMessage DraggingStopped >> performWindowSwitching window)
-      
-
--- | get the pointer offset relative to the given windows root coordinates
-getPointerOffset :: Window -> Display -> X (Int, Int)
-getPointerOffset win disp = do
-  (_, _, _, offsetX, offsetY, _, _, _) <- io $ queryPointer disp win
-  return (fromIntegral offsetX, fromIntegral offsetY)
-  
--- | return a tuple of windowX, windowY, windowWidth, windowHeight
-getWindowPlacement :: Display -> Window -> IO (CInt, CInt, CInt, CInt)
-getWindowPlacement disp window = do
-  windowAttributes <- getWindowAttributes disp window
-  return (wa_x windowAttributes, wa_y windowAttributes, wa_width windowAttributes, wa_height windowAttributes)
-  
-
-handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
-handleTiledDraggingInProgress ex ey (mainw, r) x y = do
-  let rect = Rectangle (x - (fi ex - rect_x r))
-                       (y - (fi ey - rect_y r))
-                       (rect_width  r)
-                       (rect_height r)
-  sendMessage $ DraggingWindow mainw rect
-
-performWindowSwitching :: Window -> X ()
-performWindowSwitching win =
-  withDisplay $ \d -> do
-   root <- asks theRoot
-   (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root
-   ws <- gets windowset
-   let allWindows = W.index ws
-   when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
-     let allWindowsSwitched = map (switchEntries win selWin) allWindows
-     let (ls, t:rs) = break (== win) allWindowsSwitched
-     let newStack = W.Stack t (reverse ls) rs
-     windows $ W.modify' $ const newStack
-  where
-    switchEntries a b x
-        | x == a    = b
-        | x == b    = a
-        | otherwise = x
-
-
---}}}
-
-
-
 -- Utilities --------------------------------------------------- {{{
 
 (|>) :: a -> (a -> b) -> b

files/.xmonad/lib/TiledDragging.hs

@@ -0,0 +1,67 @@
+module TiledDragging
+  ( tiledDrag
+  )
+where
+import           XMonad
+
+import qualified XMonad.StackSet               as W
+import           XMonad.Layout.DraggingVisualizer
+import           Control.Monad
+
+
+-- | put this as a mouse mapping to be able to drag windows in tiled mode. 
+-- you need DraggingVisualizer for this to look good.
+tiledDrag :: Window -> X ()
+tiledDrag window = whenX (isClient window) $ do
+  focus window
+  (offsetX, offsetY)                <- getPointerOffset window
+  (winX, winY, winWidth, winHeight) <- getWindowPlacement window
+
+  mouseDrag
+    (\posX posY ->
+      let rect = Rectangle (fInt (fInt winX + (posX - fInt offsetX)))
+                           (fInt (fInt winY + (posY - fInt offsetY)))
+                           (fInt winWidth)
+                           (fInt winHeight)
+      in  sendMessage $ DraggingWindow window rect
+    )
+    (sendMessage DraggingStopped >> performWindowSwitching window)
+
+
+-- | get the pointer offset relative to the given windows root coordinates
+getPointerOffset :: Window -> X (Int, Int)
+getPointerOffset win = do
+  (_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win)
+  return (fInt oX, fInt oY)
+
+-- | return a tuple of windowX, windowY, windowWidth, windowHeight
+getWindowPlacement :: Window -> X (Int, Int, Int, Int)
+getWindowPlacement window = do
+  wa <- withDisplay (\d -> io $ getWindowAttributes d window)
+  return
+    (fInt $ wa_x wa, fInt $ wa_y wa, fInt $ wa_width wa, fInt $ wa_height wa)
+
+
+performWindowSwitching :: Window -> X ()
+performWindowSwitching win = do
+  root                          <- asks theRoot
+  (_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root)
+  ws                            <- gets windowset
+  let allWindows = W.index ws
+  when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
+    let allWindowsSwitched = map (switchEntries win selWin) allWindows
+    let (ls, t : rs)       = break (== win) allWindowsSwitched
+    let newStack           = W.Stack t (reverse ls) rs
+    windows $ W.modify' $ const newStack
+ where
+  switchEntries a b x | x == a    = b
+                      | x == b    = a
+                      | otherwise = x
+
+
+
+-- | shorthand for fromIntegral
+fInt :: Integral a => Integral b => a -> b
+fInt = fromIntegral
+
+

files/.xmonad/my-xmonad.cabal

@@ -10,6 +10,7 @@ executable my-xmonad
         Config
         Rofi
         DescribedSubmap
+        TiledDragging
 
     default-language: Haskell2010
     ghc-options:      -Wall -threaded -fno-warn-missing-signatures