{-# LANGUAGE TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.Place
-- Description :  Automatic placement of floating windows.
-- Copyright   :  Quentin Moser <moserq@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  orphaned
-- Stability   :  unstable
-- Portability :  unportable
--
-- Automatic placement of floating windows.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.Place   ( -- * Usage
                              -- $usage

                              -- * Placement actions
                              placeFocused
                            , placeHook

                              -- * Placement policies
                              -- $placements
                            , Placement
                            , smart
                            , simpleSmart
                            , fixed
                            , underMouse
                            , inBounds
                            , withGaps

                              -- * Others
                            , purePlaceWindow ) where


import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as S

import XMonad.Layout.WindowArranger
import XMonad.Actions.FloatKeys

import qualified Data.Map as M
import Data.Ratio ((%))
import Control.Monad.Trans (lift)

-- $usage
-- This module provides a 'ManageHook' that automatically places
-- floating windows at appropriate positions on the screen, as well
-- as an 'X' action to manually trigger repositioning.
--
-- You can use this module by including the following in your @xmonad.hs@:
--
-- > import XMonad.Hooks.Place
--
-- and adding 'placeHook' to your 'manageHook', for example:
--
-- > main = xmonad $ def { manageHook = placeHook simpleSmart
-- >                                    <> manageHook def }
--
-- Note that 'placeHook' should be applied after most other hooks, especially hooks
-- such as 'doFloat' and 'doShift'. Since hooks combined with '<>' are applied from
-- right to left, this means that 'placeHook' should be the /first/ hook in your chain.
--
-- You can also define a key to manually trigger repositioning with 'placeFocused' by
-- adding the following to your keys definition:
--
-- > , ((modm, xK_w), placeFocused simpleSmart)
--
-- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies
-- the placement policy to use (smart, under the mouse, fixed position, etc.). See
-- 'Placement' for a list of available policies.



{- Placement policies -}

-- $placements
-- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'.
--
-- A few examples:
--
-- * Basic smart placement
--
-- > myPlacement = simpleSmart
--
-- * Under the mouse (pointer at the top-left corner), but constrained
--   inside of the screen area
--
-- > myPlacement = inBounds (underMouse (0, 0))
--
-- * Smart placement with a preference for putting windows near
-- the center of the screen, and with 16px gaps at the top and bottom
-- of the screen where no window will be placed
--
-- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5))


-- | The type of placement policies
data Placement = Smart (Rational, Rational)
               | Fixed (Rational, Rational)
               | UnderMouse (Rational, Rational)
               | Bounds (Dimension, Dimension, Dimension, Dimension) Placement
                 deriving (Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placement] -> ShowS
$cshowList :: [Placement] -> ShowS
show :: Placement -> String
$cshow :: Placement -> String
showsPrec :: Int -> Placement -> ShowS
$cshowsPrec :: Int -> Placement -> ShowS
Show, ReadPrec [Placement]
ReadPrec Placement
Int -> ReadS Placement
ReadS [Placement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Placement]
$creadListPrec :: ReadPrec [Placement]
readPrec :: ReadPrec Placement
$creadPrec :: ReadPrec Placement
readList :: ReadS [Placement]
$creadList :: ReadS [Placement]
readsPrec :: Int -> ReadS Placement
$creadsPrec :: Int -> ReadS Placement
Read, Placement -> Placement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Placement -> Placement -> Bool
$c/= :: Placement -> Placement -> Bool
== :: Placement -> Placement -> Bool
$c== :: Placement -> Placement -> Bool
Eq)


-- | Try to place windows with as little overlap as possible
smart :: (Rational, Rational) -- ^ Where the window should be placed inside
                              -- the available area. See 'fixed'.
      -> Placement
smart :: (Rational, Rational) -> Placement
smart = (Rational, Rational) -> Placement
Smart

simpleSmart :: Placement
simpleSmart :: Placement
simpleSmart = Placement -> Placement
inBounds forall a b. (a -> b) -> a -> b
$ (Rational, Rational) -> Placement
smart (Rational
0,Rational
0)


-- | Place windows at a fixed position
fixed :: (Rational, Rational) -- ^ Where windows should go.
                              --
                              --     * (0,0) -> top left of the screen
                              --
                              --     * (1,0) -> top right of the screen
                              --
                              --     * etc
      -> Placement
fixed :: (Rational, Rational) -> Placement
fixed = (Rational, Rational) -> Placement
Fixed


-- | Place windows under the mouse
underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to
                                   -- the window's frame; see 'fixed'.
           -> Placement
underMouse :: (Rational, Rational) -> Placement
underMouse = (Rational, Rational) -> Placement
UnderMouse


-- | Apply the given placement policy, constraining the
-- placed windows inside the screen boundaries.
inBounds :: Placement -> Placement
inBounds :: Placement -> Placement
inBounds = (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
Bounds (Dimension
0,Dimension
0,Dimension
0,Dimension
0)


-- | Same as 'inBounds', but allows specifying gaps along the screen's edges
withGaps :: (Dimension, Dimension, Dimension, Dimension)
         -- ^ top, right, bottom and left gaps
         -> Placement -> Placement
withGaps :: (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
withGaps = (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
Bounds



{- Placement functions -}


-- | Repositions the focused window according to a placement policy. Works for
-- both \"real\" floating windows and windows in a 'WindowArranger'-based
-- layout.
placeFocused :: Placement -> X ()
placeFocused :: Placement -> X ()
placeFocused Placement
p = (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
window -> do
                   (Workspace String (Layout Window) Window, Rectangle)
info <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
                   [Window]
floats <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset

                   r' :: Rectangle
r'@(Rectangle Position
x' Position
y' Dimension
_ Dimension
_) <- Placement
-> Window
-> (Workspace String (Layout Window) Window, Rectangle)
-> [Window]
-> X Rectangle
placeWindow Placement
p Window
window (Workspace String (Layout Window) Window, Rectangle)
info [Window]
floats

                     -- use X.A.FloatKeys if the window is floating, send
                     -- a WindowArranger message otherwise.
                   if Window
window forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats
                     then P -> (Rational, Rational) -> Window -> X ()
keysMoveWindowTo (Position
x', Position
y') (Rational
0, Rational
0) Window
window
                     else forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Rectangle -> WindowArrangerMsg
SetGeometry Rectangle
r'


-- | Hook to automatically place windows when they are created.
placeHook :: Placement -> ManageHook
placeHook :: Placement -> ManageHook
placeHook Placement
p = do Window
window <- forall r (m :: * -> *). MonadReader r m => m r
ask
                 Rectangle
r <- forall a. ReaderT Window X a -> Query a
Query forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Window -> X Rectangle
getWindowRectangle Window
window
                 Map Window Rectangle
allRs <- forall a. ReaderT Window X a -> Query a
Query forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift X (Map Window Rectangle)
getAllRectangles
                 P
pointer <- forall a. ReaderT Window X a -> Query a
Query forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Window -> X P
getPointer Window
window

                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \WindowSet
theWS -> forall a. a -> Maybe a -> a
fromMaybe WindowSet
theWS forall a b. (a -> b) -> a -> b
$
                   do let currentRect :: Rectangle
currentRect = ScreenDetail -> Rectangle
screenRect forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
theWS
                          floats :: [Window]
floats = forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
theWS

                      forall (f :: * -> *). Alternative f => Bool -> f ()
guard(Window
window forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats )

                        -- Look for the workspace(s) on which the window is to be
                        -- spawned. Each of them also needs an associated screen
                        -- rectangle; for hidden workspaces, we use the current
                        -- workspace's screen.
                      let infos :: Maybe (Workspace String (Layout Window) Window, Rectangle)
infos = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Window
window forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. Maybe (Stack w) -> [w]
stackContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
                                     forall a b. (a -> b) -> a -> b
$ [forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
theWS]
                                        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo (forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
theWS)
                                        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (, Rectangle
currentRect) (forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden WindowSet
theWS)

                      case Maybe (Workspace String (Layout Window) Window, Rectangle)
infos of
                        Maybe (Workspace String (Layout Window) Window, Rectangle)
Nothing   -> forall (f :: * -> *) a. Alternative f => f a
empty
                        Just (Workspace String (Layout Window) Window, Rectangle)
info -> do
                          let (Workspace String (Layout Window) Window
workspace, Rectangle
screen) = (Workspace String (Layout Window) Window, Rectangle)
info
                              rs :: [Rectangle]
rs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Window Rectangle
allRs)
                                   forall a b. (a -> b) -> a -> b
$ forall a b. Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients Workspace String (Layout Window) Window
workspace Window
window [Window]
floats
                              r' :: Rectangle
r' = Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow Placement
p Rectangle
screen [Rectangle]
rs P
pointer Rectangle
r
                              newRect :: RationalRect
newRect = Rectangle -> Rectangle -> RationalRect
r2rr Rectangle
screen Rectangle
r'
                              newFloats :: Map Window RationalRect
newFloats = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
window RationalRect
newRect (forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
theWS)

                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WindowSet
theWS { floating :: Map Window RationalRect
S.floating = Map Window RationalRect
newFloats }


placeWindow :: Placement -> Window
            -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle)
                 -- ^ The workspace with reference to which the window should be placed,
                 -- and the screen's geometry.
            -> [Window]
                 -- ^ The list of floating windows.
            -> X Rectangle
placeWindow :: Placement
-> Window
-> (Workspace String (Layout Window) Window, Rectangle)
-> [Window]
-> X Rectangle
placeWindow Placement
p Window
window (Workspace String (Layout Window) Window
ws, Rectangle
s) [Window]
floats
  = do (Rectangle
r, [Rectangle]
rs, P
pointer) <- Window
-> Workspace String (Layout Window) Window
-> [Window]
-> X (Rectangle, [Rectangle], P)
getNecessaryData Window
window Workspace String (Layout Window) Window
ws [Window]
floats
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow Placement
p Rectangle
s [Rectangle]
rs P
pointer Rectangle
r


-- | Compute the new position of a window according to a placement policy.
purePlaceWindow :: Placement -- ^ The placement strategy
                -> Rectangle -- ^ The screen
                -> [Rectangle] -- ^ The other visible windows
                -> (Position, Position) -- ^ The pointer's position.
                -> Rectangle -- ^ The window to be placed
                -> Rectangle
purePlaceWindow :: Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow (Bounds (Dimension
t,Dimension
r,Dimension
b,Dimension
l) Placement
p') (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) [Rectangle]
rs P
p Rectangle
w
  = let s' :: Rectangle
s' = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
l) (Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
t) (Dimension
sw forall a. Num a => a -> a -> a
- Dimension
l forall a. Num a => a -> a -> a
- Dimension
r) (Dimension
sh forall a. Num a => a -> a -> a
- Dimension
t forall a. Num a => a -> a -> a
- Dimension
b)
    in Rectangle -> Rectangle -> Rectangle
checkBounds Rectangle
s' forall a b. (a -> b) -> a -> b
$ Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow Placement
p' Rectangle
s' [Rectangle]
rs P
p Rectangle
w

purePlaceWindow (Fixed (Rational, Rational)
ratios) Rectangle
s [Rectangle]
_ P
_ Rectangle
w = (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle
placeRatio (Rational, Rational)
ratios Rectangle
s Rectangle
w

purePlaceWindow (UnderMouse (Rational
rx, Rational
ry)) Rectangle
_ [Rectangle]
_ (Position
px, Position
py) (Rectangle Position
_ Position
_ Dimension
w Dimension
h)
  = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
px forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
rx forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi Dimension
w)) (Position
py forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
ry forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)) Dimension
w Dimension
h

purePlaceWindow (Smart (Rational, Rational)
ratios) Rectangle
s [Rectangle]
rs P
_ Rectangle
w
  = (Rational, Rational)
-> Rectangle -> [Rectangle] -> Dimension -> Dimension -> Rectangle
placeSmart (Rational, Rational)
ratios Rectangle
s [Rectangle]
rs (Rectangle -> Dimension
rect_width Rectangle
w) (Rectangle -> Dimension
rect_height Rectangle
w)


-- | Helper: Places a Rectangle at a fixed position indicated by two Rationals
-- inside another,
placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle
placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle
placeRatio (Rational
rx, Rational
ry) (Rectangle Position
x1 Position
y1 Dimension
w1 Dimension
h1) (Rectangle Position
_ Position
_ Dimension
w2 Dimension
h2)
  = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
rx Position
x1 (Position
x1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2))
              (forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
ry Position
y1 (Position
y1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2))
              Dimension
w2 Dimension
h2


-- | Helper: Ensures its second parameter is contained inside the first
-- by possibly moving it.
checkBounds :: Rectangle -> Rectangle -> Rectangle
checkBounds :: Rectangle -> Rectangle -> Rectangle
checkBounds (Rectangle Position
x1 Position
y1 Dimension
w1 Dimension
h1) (Rectangle Position
x2 Position
y2 Dimension
w2 Dimension
h2)
  = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a. Ord a => a -> a -> a
max Position
x1 (forall a. Ord a => a -> a -> a
min (Position
x1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2) Position
x2))
              (forall a. Ord a => a -> a -> a
max Position
y1 (forall a. Ord a => a -> a -> a
min (Position
y1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2) Position
y2))
              Dimension
w2 Dimension
h2





{- Utilities -}

scale :: (RealFrac a, Integral b) => a -> b -> b -> b
scale :: forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale a
r b
n1 b
n2 = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ a
r forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi b
n2 forall a. Num a => a -> a -> a
+ (a
1 forall a. Num a => a -> a -> a
- a
r) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi b
n1


r2rr :: Rectangle -> Rectangle -> S.RationalRect
r2rr :: Rectangle -> Rectangle -> RationalRect
r2rr (Rectangle Position
x0 Position
y0 Dimension
w0 Dimension
h0) (Rectangle Position
x Position
y Dimension
w Dimension
h)
  = Rational -> Rational -> Rational -> Rational -> RationalRect
S.RationalRect ((forall a b. (Integral a, Num b) => a -> b
fi Position
xforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fi Position
x0) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0)
                   ((forall a b. (Integral a, Num b) => a -> b
fi Position
yforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fi Position
y0) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
h0)
                   (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0)
                   (forall a b. (Integral a, Num b) => a -> b
fi Dimension
h forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
h0)



{- Querying stuff -}

stackContents :: Maybe (S.Stack w) -> [w]
stackContents :: forall w. Maybe (Stack w) -> [w]
stackContents = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
S.integrate

screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)
screenInfo :: forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo S.Screen{ workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace = Workspace i l a
ws, screenDetail :: forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail = (SD Rectangle
s)} = (Workspace i l a
ws, Rectangle
s)

getWindowRectangle :: Window -> X Rectangle
getWindowRectangle :: Window -> X Rectangle
getWindowRectangle Window
window
  = do Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
       (Window
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
_, CInt
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
d Window
window

         -- We can't use the border width returned by
         -- getGeometry because it will be 0 if the
         -- window isn't mapped yet.
       Dimension
b <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> Dimension
borderWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config

       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w forall a. Num a => a -> a -> a
+ Dimension
2forall a. Num a => a -> a -> a
*Dimension
b) (Dimension
h forall a. Num a => a -> a -> a
+ Dimension
2forall a. Num a => a -> a -> a
*Dimension
b)

getAllRectangles :: X (M.Map Window Rectangle)
getAllRectangles :: X (Map Window Rectangle)
getAllRectangles = do WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
                      let allWindows :: [Window]
allWindows = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall w. Maybe (Stack w) -> [w]
stackContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack)
                                         forall a b. (a -> b) -> a -> b
$ (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current) WindowSet
ws
                                         forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible) WindowSet
ws
                                         forall a. [a] -> [a] -> [a]
++ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden WindowSet
ws
                      [Rectangle]
allRects <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X Rectangle
getWindowRectangle [Window]
allWindows

                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
allWindows [Rectangle]
allRects

organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients :: forall a b. Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients Workspace a b Window
ws Window
w [Window]
floats
  = let ([Window]
floatCs, [Window]
layoutCs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Window
w)
                              forall a b. (a -> b) -> a -> b
$ forall w. Maybe (Stack w) -> [w]
stackContents forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace a b Window
ws
    in forall a. [a] -> [a]
reverse [Window]
layoutCs forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [Window]
floatCs
      -- About the ordering: the smart algorithm will overlap windows
      -- starting ith the head of the list. So:
      --  - we put the non-floating windows first since they'll
      --    probably be below the floating ones,
      --  - we reverse the lists, since the newer/more important
      --    windows are usually near the head.

getPointer :: Window -> X (Position, Position)
getPointer :: Window -> X P
getPointer Window
window = do Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
                       (Bool
_,Window
_,Window
_,CInt
x,CInt
y,CInt
_,CInt
_,Modifier
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
window
                       forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fi CInt
x,forall a b. (Integral a, Num b) => a -> b
fi CInt
y)

-- | Return values are, in order: window's rectangle,
-- other windows' rectangles and pointer's coordinates.
getNecessaryData :: Window
                 -> S.Workspace WorkspaceId (Layout Window) Window
                 -> [Window]
                 -> X (Rectangle, [Rectangle], (Position, Position))
getNecessaryData :: Window
-> Workspace String (Layout Window) Window
-> [Window]
-> X (Rectangle, [Rectangle], P)
getNecessaryData Window
window Workspace String (Layout Window) Window
ws [Window]
floats
  = do Rectangle
r <- Window -> X Rectangle
getWindowRectangle Window
window

       [Rectangle]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X Rectangle
getWindowRectangle (forall a b. Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients Workspace String (Layout Window) Window
ws Window
window [Window]
floats)

       P
pointer <- Window -> X P
getPointer Window
window

       forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
r, [Rectangle]
rs, P
pointer)




{- Smart placement algorithm -}

-- | Alternate representation for rectangles.
data SmartRectangle a = SR
  { forall a. SmartRectangle a -> a
sr_x0, forall a. SmartRectangle a -> a
sr_y0 :: a -- ^ Top left coordinates, inclusive
  , forall a. SmartRectangle a -> a
sr_x1, forall a. SmartRectangle a -> a
sr_y1 :: a -- ^ Bottom right coorsinates, exclusive
  } deriving (Int -> SmartRectangle a -> ShowS
forall a. Show a => Int -> SmartRectangle a -> ShowS
forall a. Show a => [SmartRectangle a] -> ShowS
forall a. Show a => SmartRectangle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmartRectangle a] -> ShowS
$cshowList :: forall a. Show a => [SmartRectangle a] -> ShowS
show :: SmartRectangle a -> String
$cshow :: forall a. Show a => SmartRectangle a -> String
showsPrec :: Int -> SmartRectangle a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SmartRectangle a -> ShowS
Show, SmartRectangle a -> SmartRectangle a -> Bool
forall a. Eq a => SmartRectangle a -> SmartRectangle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmartRectangle a -> SmartRectangle a -> Bool
$c/= :: forall a. Eq a => SmartRectangle a -> SmartRectangle a -> Bool
== :: SmartRectangle a -> SmartRectangle a -> Bool
$c== :: forall a. Eq a => SmartRectangle a -> SmartRectangle a -> Bool
Eq)

r2sr :: Rectangle -> SmartRectangle Position
r2sr :: Rectangle -> SmartRectangle Position
r2sr (Rectangle Position
x Position
y Dimension
w Dimension
h) = forall a. a -> a -> a -> a -> SmartRectangle a
SR Position
x Position
y (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)

sr2r :: SmartRectangle Position -> Rectangle
sr2r :: SmartRectangle Position -> Rectangle
sr2r (SR Position
x0 Position
y0 Position
x1 Position
y1) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x0 Position
y0 (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
x1 forall a. Num a => a -> a -> a
- Position
x0) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
y1 forall a. Num a => a -> a -> a
- Position
y0)

width :: Num a => SmartRectangle a -> a
width :: forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r = forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r forall a. Num a => a -> a -> a
- forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r

height :: Num a => SmartRectangle a -> a
height :: forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r = forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r forall a. Num a => a -> a -> a
- forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r

isEmpty :: Real a => SmartRectangle a -> Bool
isEmpty :: forall a. Real a => SmartRectangle a -> Bool
isEmpty SmartRectangle a
r = (forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r forall a. Ord a => a -> a -> Bool
<= a
0) Bool -> Bool -> Bool
|| (forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r forall a. Ord a => a -> a -> Bool
<= a
0)

contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool
contains :: forall a. Real a => SmartRectangle a -> SmartRectangle a -> Bool
contains SmartRectangle a
r1 SmartRectangle a
r2 = forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
<= forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r2
                 Bool -> Bool -> Bool
&& forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
<= forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r2
                 Bool -> Bool -> Bool
&& forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
>= forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r2
                 Bool -> Bool -> Bool
&& forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
>= forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r2


-- | Main placement function
placeSmart :: (Rational, Rational) -- ^ point of the screen where windows
                                   -- should be placed first, if possible.
           -> Rectangle -- ^ screen
           -> [Rectangle] -- ^ other clients
           -> Dimension -- ^ width
           -> Dimension -- ^ height
           -> Rectangle
placeSmart :: (Rational, Rational)
-> Rectangle -> [Rectangle] -> Dimension -> Dimension -> Rectangle
placeSmart (Rational
rx, Rational
ry) s :: Rectangle
s@(Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) [Rectangle]
rs Dimension
w Dimension
h
  = let free :: [Rectangle]
free = forall a b. (a -> b) -> [a] -> [b]
map SmartRectangle Position -> Rectangle
sr2r forall a b. (a -> b) -> a -> b
$ forall a.
Real a =>
SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
findSpace (Rectangle -> SmartRectangle Position
r2sr Rectangle
s) (forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> SmartRectangle Position
r2sr [Rectangle]
rs) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)
    in [Rectangle]
-> Position -> Position -> Dimension -> Dimension -> Rectangle
position [Rectangle]
free (forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
rx Position
sx (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
sw forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
w))
                     (forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
ry Position
sy (Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
sh forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h))
                     Dimension
w Dimension
h

-- | Second part of the algorithm:
-- Chooses the best position in which to place a window,
-- according to a list of free areas and an ideal position for
-- the top-left corner.
-- We can't use semi-open surfaces for this, so we go back to
-- X11 Rectangles/Positions/etc instead.
position :: [Rectangle] -- ^ Free areas
         -> Position -> Position -- ^ Ideal coordinates
         -> Dimension -> Dimension -- ^ Width and height of the window
         -> Rectangle
position :: [Rectangle]
-> Position -> Position -> Dimension -> Dimension -> Rectangle
position [Rectangle]
rs Position
x Position
y Dimension
w Dimension
h = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy Rectangle -> Rectangle -> Ordering
distanceOrder forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Rectangle
closest [Rectangle]
rs
  where distanceOrder :: Rectangle -> Rectangle -> Ordering
distanceOrder Rectangle
r1 Rectangle
r2
          = forall a. Ord a => a -> a -> Ordering
compare (forall {b} {a}. (Integral b, Integral a) => (a, a) -> (a, a) -> b
distance (Rectangle -> Position
rect_x Rectangle
r1,Rectangle -> Position
rect_y Rectangle
r1) (Position
x,Position
y) :: Dimension)
                    (forall {b} {a}. (Integral b, Integral a) => (a, a) -> (a, a) -> b
distance (Rectangle -> Position
rect_x Rectangle
r2,Rectangle -> Position
rect_y Rectangle
r2) (Position
x,Position
y) :: Dimension)
        distance :: (a, a) -> (a, a) -> b
distance (a
x1,a
y1) (a
x2,a
y2) = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ (forall a. Floating a => a -> a
sqrt :: Double -> Double)
                                   forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ (a
x1 forall a. Num a => a -> a -> a
- a
x2)forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)
                                        forall a. Num a => a -> a -> a
+ (a
y1 forall a. Num a => a -> a -> a
- a
y2)forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)
        closest :: Rectangle -> Rectangle
closest Rectangle
r = Rectangle -> Rectangle -> Rectangle
checkBounds Rectangle
r (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
h)


-- | First part of the algorithm:
-- Tries to find an area in which to place a new
-- rectangle so that it overlaps as little as possible with
-- other rectangles already present. The first rectangles in
-- the list will be overlapped first.
findSpace :: Real a =>
             SmartRectangle a -- ^ The total available area
          -> [SmartRectangle a] -- ^ The parts already in use
          -> a -- ^ Width of the rectangle to place
          -> a -- ^ Height of the rectangle to place
          -> [SmartRectangle a]
findSpace :: forall a.
Real a =>
SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
findSpace SmartRectangle a
total [] a
_ a
_ = [SmartRectangle a
total]
findSpace SmartRectangle a
total rs :: [SmartRectangle a]
rs@(SmartRectangle a
_:[SmartRectangle a]
rs') a
w a
h
  = case forall a. (a -> Bool) -> [a] -> [a]
filter SmartRectangle a -> Bool
largeEnough forall a b. (a -> b) -> a -> b
$ forall a. Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup forall a b. (a -> b) -> a -> b
$ forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [SmartRectangle a]
rs of
      [] -> forall a.
Real a =>
SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
findSpace SmartRectangle a
total [SmartRectangle a]
rs' a
w a
h
      [SmartRectangle a]
as -> [SmartRectangle a]
as
    where largeEnough :: SmartRectangle a -> Bool
largeEnough SmartRectangle a
r = forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r forall a. Ord a => a -> a -> Bool
>= a
w Bool -> Bool -> Bool
&& forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r forall a. Ord a => a -> a -> Bool
>= a
h


-- | Subtracts smaller rectangles from a total rectangle
-- , returning a list of remaining rectangular areas.
subtractRects :: Real a => SmartRectangle a
               -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects :: forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [] = [SmartRectangle a
total]
subtractRects SmartRectangle a
total (SmartRectangle a
r:[SmartRectangle a]
rs)
  = do SmartRectangle a
total' <- forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [SmartRectangle a]
rs
       forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => SmartRectangle a -> Bool
isEmpty)
                [ SmartRectangle a
total' {sr_y1 :: a
sr_y1 = forall a. Ord a => a -> a -> a
min (forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r)} -- Above
                , SmartRectangle a
total' {sr_x0 :: a
sr_x0 = forall a. Ord a => a -> a -> a
max (forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r)} -- Right
                , SmartRectangle a
total' {sr_y0 :: a
sr_y0 = forall a. Ord a => a -> a -> a
max (forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r)} -- Below
                , SmartRectangle a
total' {sr_x1 :: a
sr_x1 = forall a. Ord a => a -> a -> a
min (forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r)} -- Left
                ]


-- | "Nubs" a list of rectangles, dropping all those that are
-- already contained in another rectangle of the list.
cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup :: forall a. Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup [SmartRectangle a]
rs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
dropIfContained [] forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall a.
Real a =>
SmartRectangle a -> SmartRectangle a -> Ordering
sizeOrder [SmartRectangle a]
rs

sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering
sizeOrder :: forall a.
Real a =>
SmartRectangle a -> SmartRectangle a -> Ordering
sizeOrder SmartRectangle a
r1 SmartRectangle a
r2 | a
w1 forall a. Ord a => a -> a -> Bool
< a
w2 = Ordering
LT
                | a
w1 forall a. Eq a => a -> a -> Bool
== a
w2 Bool -> Bool -> Bool
&& a
h1 forall a. Ord a => a -> a -> Bool
< a
h2 = Ordering
LT
                | a
w1 forall a. Eq a => a -> a -> Bool
== a
w2 Bool -> Bool -> Bool
&& a
h1 forall a. Eq a => a -> a -> Bool
== a
h2 = Ordering
EQ
                | Bool
otherwise = Ordering
GT
                where w1 :: a
w1 = forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r1
                      w2 :: a
w2 = forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r2
                      h1 :: a
h1 = forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r1
                      h2 :: a
h2 = forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r2

dropIfContained :: Real a => SmartRectangle a
                -> [SmartRectangle a] -> [SmartRectangle a]
dropIfContained :: forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
dropIfContained SmartRectangle a
r [SmartRectangle a]
rs  = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Real a => SmartRectangle a -> SmartRectangle a -> Bool
`contains` SmartRectangle a
r) [SmartRectangle a]
rs
                        then [SmartRectangle a]
rs
                        else SmartRectangle a
rforall a. a -> [a] -> [a]
:[SmartRectangle a]
rs