module XMonad.Actions.TiledWindowDragging
(
dragWindow
)
where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Layout.DraggingVisualizer
dragWindow :: Window -> X ()
dragWindow :: Window -> X ()
dragWindow Window
window = X Bool -> X () -> X ()
whenX (Window -> X Bool
isClient Window
window) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy Window
window ((WindowAttributes -> X ()) -> X ())
-> (WindowAttributes -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
Window -> X ()
focus Window
window
(offsetX, offsetY) <- Window -> X (Int, Int)
getPointerOffset Window
window
let (winX, winY, winWidth, winHeight) = getWindowPlacement wa
mouseDrag
(\Position
posX Position
posY ->
let rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
winX Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Position
posX Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
offsetX)))
(Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
winY Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Position
posY Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
offsetY)))
(Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
winWidth)
(Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
winHeight)
in DraggingVisualizerMsg -> X ()
forall a. Message a => a -> X ()
sendMessage (DraggingVisualizerMsg -> X ()) -> DraggingVisualizerMsg -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> Rectangle -> DraggingVisualizerMsg
DraggingWindow Window
window Rectangle
rect
)
(sendMessage DraggingStopped >> performWindowSwitching window)
getPointerOffset :: Window -> X (Int, Int)
getPointerOffset :: Window -> X (Int, Int)
getPointerOffset Window
win = do
(_, _, _, oX, oY, _, _, _) <- (Display
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a. (Display -> X a) -> X a
withDisplay (\Display
d -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
win)
return (fi oX, fi oY)
getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
getWindowPlacement WindowAttributes
wa = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_height WindowAttributes
wa)
performWindowSwitching :: Window -> X ()
performWindowSwitching :: Window -> X ()
performWindowSwitching Window
win = do
root <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
(_, _, selWin, _, _, _, _, _) <- withDisplay (\Display
d -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
root)
ws <- gets windowset
let allWindows = WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
ws
when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
let allWindowsSwitched = (Window -> Window) -> [Window] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window -> Window -> Window -> Window
forall {a}. Eq a => a -> a -> a -> a
switchEntries Window
win Window
selWin) [Window]
allWindows
(ls, t : rs) <- pure $ break (== win) allWindowsSwitched
let newStack = Window -> [Window] -> [Window] -> Stack Window
forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
t ([Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
ls) [Window]
rs
windows $ W.modify' $ const newStack
where
switchEntries :: a -> a -> a -> a
switchEntries a
a a
b a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a = a
b
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = a
a
| Bool
otherwise = a
x