-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.FloatSnap
-- Copyright : (c) 2009 Anders Engstrom <ankaan@gmail.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Anders Engstrom <ankaan@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- Move and resize floating windows using other windows and the edge of the
-- screen as guidelines.
-----------------------------------------------------------------------------
module XMonad.Actions.FloatSnap (
-- * Usage
-- $usage
Direction2D(..),
snapMove,
snapGrow,
snapShrink,
snapMagicMove,
snapMagicResize,
snapMagicMouseResize) where
import XMonad
import Control.Applicative((<$>))
import Data.List (sort)
import Data.Maybe (listToMaybe,fromJust,isNothing)
import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageDocks (calcGap)
import XMonad.Util.Types (Direction2D(..))
import qualified Data.Set as S
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.FloatSnap
--
-- Then add appropriate key bindings, for example:
--
-- > , ((modMask x, xK_Left), withFocused $ snapMove L Nothing)
-- > , ((modMask x, xK_Right), withFocused $ snapMove R Nothing)
-- > , ((modMask x, xK_Up), withFocused $ snapMove U Nothing)
-- > , ((modMask x, xK_Down), withFocused $ snapMove D Nothing)
-- > , ((modMask x .|. shiftMask, xK_Left), withFocused $ snapShrink R Nothing)
-- > , ((modMask x .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
-- > , ((modMask x .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing)
-- > , ((modMask x .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing)
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- And possibly add an appropriate mouse binding, for example:
--
-- > , ((modMask x, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w))
-- > , ((modMask x .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))
-- > , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w))
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
--
-- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place.
-- Note that the order in which the commands are applied in the mouse bindings are important.
--
-- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap
-- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against).
--
-- For 'snapMagicMove', 'snapMagicResize' and 'snapMagicMouseResize', try instead setting it to the same as the maximum snapping distance.
--
-- When a value is specified it can be geometrically conceived as adding a border with the specified width around the window and then checking which
-- windows it should collide with.
-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. Use the location of the
-- mouse over the window to decide which edges to snap. In corners, the two adjoining edges will be snapped, along the middle of an edge only that edge
-- will be snapped. In the center of the window all edges will snap. Intended to be used together with "XMonad.Actions.FlexibleResize" or
-- "XMonad.Actions.FlexibleManipulate".
snapMagicMouseResize
:: Rational -- ^ How big the middle snap area of each axis should be.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
-> Window -- ^ The window to move and resize.
-> X ()
snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
wa <- io $ getWindowAttributes d w
(_, _, _, px, py, _, _, _) <- io $ queryPointer d w
let x = (fromIntegral px - wx wa)/(ww wa)
y = (fromIntegral py - wy wa)/(wh wa)
ml = if x <= (0.5 - middle/2) then [L] else []
mr = if x > (0.5 + middle/2) then [R] else []
mu = if y <= (0.5 - middle/2) then [U] else []
md = if y > (0.5 + middle/2) then [D] else []
mdir = ml++mr++mu++md
dir = if mdir == []
then [L,R,U,D]
else mdir
snapMagicResize dir collidedist snapdist w
where
wx = fromIntegral.wa_x
wy = fromIntegral.wa_y
ww = fromIntegral.wa_width
wh = fromIntegral.wa_height
-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen.
snapMagicResize
:: [Direction2D] -- ^ The edges to snap.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
-> Window -- ^ The window to move and resize.
-> X ()
snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w
wa <- io $ getWindowAttributes d w
(xbegin,xend) <- handleAxis True d wa
(ybegin,yend) <- handleAxis False d wa
let xbegin' = if L `elem` dir then xbegin else (wx wa)
xend' = if R `elem` dir then xend else (wx wa + ww wa)
ybegin' = if U `elem` dir then ybegin else (wy wa)
yend' = if D `elem` dir then yend else (wy wa + wh wa)
io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')
io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
float w
where
wx = fromIntegral.wa_x
wy = fromIntegral.wa_y
ww = fromIntegral.wa_width
wh = fromIntegral.wa_height
handleAxis horiz d wa = do
((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w
let begin = if bs
then wpos wa
else case (mbl,mbr) of
(Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br
(Just bl,Nothing) -> bl
(Nothing,Just br) -> br
(Nothing,Nothing) -> wpos wa
end = if fs
then wpos wa + wdim wa
else case (if mfl==(Just begin) then Nothing else mfl,mfr) of
(Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
(Just fl,Nothing) -> fl
(Nothing,Just fr) -> fr
(Nothing,Nothing) -> wpos wa + wdim wa
begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)
end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)
return (begin',end')
where
(wpos, wdim, _, _) = constructors horiz
-- | Move a window by both axises in any direction to snap against the closest part of other windows or the edge of the screen.
snapMagicMove
:: Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
-> Window -- ^ The window to move.
-> X ()
snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w
wa <- io $ getWindowAttributes d w
nx <- handleAxis True d wa
ny <- handleAxis False d wa
io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
float w
where
handleAxis horiz d wa = do
((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w
return $ if bs || fs
then wpos wa
else let b = case (mbl,mbr) of
(Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br
(Just bl,Nothing) -> bl
(Nothing,Just br) -> br
(Nothing,Nothing) -> wpos wa
f = case (mfl,mfr) of
(Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
(Just fl,Nothing) -> fl
(Nothing,Just fr) -> fr
(Nothing,Nothing) -> wpos wa
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)
where
(wpos, wdim, _, _) = constructors horiz
-- | Move a window in the specified direction until it snaps against another window or the edge of the screen.
snapMove
:: Direction2D -- ^ What direction to move the window in.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Window -- ^ The window to move.
-> X ()
snapMove L = doSnapMove True True
snapMove R = doSnapMove True False
snapMove U = doSnapMove False True
snapMove D = doSnapMove False False
doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w
wa <- io $ getWindowAttributes d w
((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
let (mb,mf) = if rev then (bl,fl)
else (br,fr)
newpos = fromIntegral $ case (mb,mf) of
(Just b,Nothing) -> b
(Nothing,Just f) -> f - wdim wa
(Just b,Just f) -> if rev /= (b < f - wdim wa)
then b
else f - wdim wa
_ -> wpos wa
if horiz then io $ moveWindow d w newpos (fromIntegral $ wa_y wa)
else io $ moveWindow d w (fromIntegral $ wa_x wa) newpos
float w
where
(wpos, wdim, _, _) = constructors horiz
-- | Grow the specified edge of a window until it snaps against another window or the edge of the screen.
snapGrow
:: Direction2D -- ^ What edge of the window to grow.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Window -- ^ The window to grow.
-> X ()
snapGrow = snapResize True
-- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen.
snapShrink
:: Direction2D -- ^ What edge of the window to shrink.
-> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
-> Window -- ^ The window to shrink.
-> X ()
snapShrink = snapResize False
snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w
wa <- io $ getWindowAttributes d w
mr <- case dir of
L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
return $ case (if grow then mg else ms) of
Just v -> Just (v, wy wa, ww wa + wx wa - v, wh wa)
_ -> Nothing
R -> do ((_,_,_),(ms,mg,_)) <- getSnap True collidedist d w
return $ case (if grow then mg else ms) of
Just v -> Just (wx wa, wy wa, v - wx wa, wh wa)
_ -> Nothing
U -> do ((mg,ms,_),(_,_,_)) <- getSnap False collidedist d w
return $ case (if grow then mg else ms) of
Just v -> Just (wx wa, v, ww wa, wh wa + wy wa - v)
_ -> Nothing
D -> do ((_,_,_),(ms,mg,_)) <- getSnap False collidedist d w
return $ case (if grow then mg else ms) of
Just v -> Just (wx wa, wy wa, ww wa, v - wy wa)
_ -> Nothing
case mr of
Nothing -> return ()
Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
else return ()
float w
where
wx = fromIntegral.wa_x
wy = fromIntegral.wa_y
ww = fromIntegral.wa_width
wh = fromIntegral.wa_height
getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int,Maybe Int,Bool),(Maybe Int,Maybe Int,Bool))
getSnap horiz collidedist d w = do
wa <- io $ getWindowAttributes d w
screen <- W.current <$> gets windowset
let sr = screenRect $ W.screenDetail screen
wl = W.integrate' . W.stack $ W.workspace screen
gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
return ( neighbours (back wa sr gr wla) (wpos wa)
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)
)
where
wborder = fromIntegral.wa_border_width
(wpos, wdim, rpos, rdim) = constructors horiz
(refwpos, refwdim, _, _) = constructors $ not horiz
back wa sr gr wla = dropWhile (< rpos sr) $
takeWhile (< rpos sr + rdim sr) $
sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):
foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla
front wa sr gr wla = dropWhile (<= rpos sr) $
takeWhile (<= rpos sr + rdim sr) $
sort $ (rpos gr - 2*wborder wa):(rpos gr + rdim gr - 2*wborder wa):(rpos sr + rdim sr - 2*wborder wa):
foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla
neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l
, listToMaybe $ dropWhile (<= v) l
, v `elem` l
)
collides wa oa = case collidedist of
Nothing -> True
Just dist -> ( refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
&& refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )
constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
constructors True = ( fromIntegral.wa_x
, fromIntegral.wa_width
, fromIntegral.rect_x
, fromIntegral.rect_width
)
constructors False = ( fromIntegral.wa_y
, fromIntegral.wa_height
, fromIntegral.rect_y
, fromIntegral.rect_height
)
