aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Actions/FloatSnap.hs
blob: cc618cd95f68c4b2cce1587993dd0fa0f619056c (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
-----------------------------------------------------------------------------
-- |
-- 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
                Direction(..),
                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 (Direction(..),calcGap)

-- $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
    :: [Direction] -- ^ 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
    :: Direction -- ^ 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
    :: Direction -- ^ 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
    :: Direction -- ^ 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 -> Direction -> 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 [L,R,U,D]
    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
                     )