----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.PositionStoreHooks
-- Description :  Hooks for XMonad.Util.PositionStore.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- This module contains two hooks for the
-- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and
-- an EventHook.
--
-- The ManageHook can be used to fill the PositionStore with position and size
-- information about new windows. The advantage of using this hook is, that the
-- information is recorded independent of the currently active layout. So the
-- floating shape of the window can later be restored even if it was opened in a
-- tiled layout initially.
--
-- For windows, that do not request a particular position, a random position will
-- be assigned. This prevents windows from piling up exactly on top of each other.
--
-- The EventHook makes sure that windows are deleted from the PositionStore
-- when they are closed.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.PositionStoreHooks (
    -- * Usage
    -- $usage
    positionStoreManageHook,
    positionStoreEventHook
    ) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Util.PositionStore
import XMonad.Hooks.ManageDocks
import XMonad.Layout.Decoration

import System.Random(randomRIO)
import qualified Data.Set as S

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Hooks.PositionStoreHooks
--
-- and adding 'positionStoreManageHook' to your 'ManageHook' as well
-- as 'positionStoreEventHook' to your event hooks. To be accurate
-- about window sizes, the module needs to know if any decoration is in effect.
-- This is specified with the first argument: Supply 'Nothing' for no decoration,
-- otherwise use 'Just def' or similar to inform the module about the
-- decoration theme used.
--
-- > myManageHook = positionStoreManageHook Nothing <> manageHook def
-- > myHandleEventHook = positionStoreEventHook
-- >
-- > main = xmonad def { manageHook = myManageHook
-- >                   , handleEventHook = myHandleEventHook
-- >                   }
--

positionStoreManageHook :: Maybe Theme -> ManageHook
positionStoreManageHook :: Maybe Theme -> Query (Endo WindowSet)
positionStoreManageHook Maybe Theme
mDecoTheme = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> Query ()) -> Query ()
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= X () -> Query ()
forall a. X a -> Query a
liftX (X () -> Query ()) -> (Window -> X ()) -> Window -> Query ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Theme -> Window -> X ()
positionStoreInit Maybe Theme
mDecoTheme Query () -> Query (Endo WindowSet) -> Query (Endo WindowSet)
forall a b. Query a -> Query b -> Query b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Query (Endo WindowSet)
forall m. Monoid m => m
idHook

positionStoreInit :: Maybe Theme -> Window -> X ()
positionStoreInit :: Maybe Theme -> Window -> X ()
positionStoreInit Maybe Theme
mDecoTheme Window
w  = (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
d -> Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w ((WindowAttributes -> X ()) -> X ())
-> (WindowAttributes -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
        let decoH :: EventType
decoH = EventType -> (Theme -> EventType) -> Maybe Theme -> EventType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EventType
0 Theme -> EventType
decoHeight Maybe Theme
mDecoTheme   -- take decoration into account, which - in its current
                                                    -- form - makes windows smaller to make room for it
        WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
        Int
arbitraryOffsetX <- X Int
randomIntOffset
        Int
arbitraryOffsetY <- X Int
randomIntOffset
        if (WindowAttributes -> CInt
wa_x WindowAttributes
wa CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) Bool -> Bool -> Bool
&& (WindowAttributes -> CInt
wa_y WindowAttributes
wa CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
            then do
                let sr :: Rectangle
sr@(Rectangle Position
srX Position
srY EventType
_ EventType
_) = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (WindowSet -> ScreenDetail) -> WindowSet -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> ScreenDetail)
-> (WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet -> Rectangle) -> WindowSet -> Rectangle
forall a b. (a -> b) -> a -> b
$ WindowSet
ws
                (PositionStore -> PositionStore) -> X ()
modifyPosStore (\PositionStore
ps -> PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
posStoreInsert PositionStore
ps Window
w
                                        (Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (Position
srX Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
arbitraryOffsetX)
                                                   (Position
srY Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
arbitraryOffsetY)
                                                    (CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> EventType) -> CInt -> EventType
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa)
                                                    (EventType
decoH EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
+ CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_height WindowAttributes
wa))) Rectangle
sr )
            else do
                Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc <- Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a. a -> Maybe a -> a
fromMaybe (WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws) (Maybe
   (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> Position
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
pointScreen (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa)
                let sr :: Rectangle
sr = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenDetail)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Rectangle)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc
                Rectangle
sr' <- ((Rectangle -> Rectangle) -> Rectangle)
-> X (Rectangle -> Rectangle) -> X Rectangle
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$ Rectangle
sr) (Set Direction2D -> X (Rectangle -> Rectangle)
calcGap (Set Direction2D -> X (Rectangle -> Rectangle))
-> Set Direction2D -> X (Rectangle -> Rectangle)
forall a b. (a -> b) -> a -> b
$ [Direction2D] -> Set Direction2D
forall a. Ord a => [a] -> Set a
S.fromList [Direction2D
forall a. Bounded a => a
minBound .. Direction2D
forall a. Bounded a => a
maxBound]) -- take docks into account, accepting
                                                                                       -- a somewhat unfortunate inter-dependency
                                                                                       -- with 'XMonad.Hooks.ManageDocks'
                (PositionStore -> PositionStore) -> X ()
modifyPosStore (\PositionStore
ps -> PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
posStoreInsert PositionStore
ps Window
w
                                        (Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_y WindowAttributes
wa) Position -> Position -> Position
forall a. Num a => a -> a -> a
- EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi EventType
decoH)
                                            (CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> EventType) -> CInt -> EventType
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa) (EventType
decoH EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
+ CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_height WindowAttributes
wa))) Rectangle
sr' )
    where
        randomIntOffset :: X Int
        randomIntOffset :: X Int
randomIntOffset = IO Int -> X Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Int -> X Int) -> IO Int -> X Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
42, Int
242)

positionStoreEventHook :: Event -> X All
positionStoreEventHook :: Event -> X All
positionStoreEventHook DestroyWindowEvent{ev_window :: Event -> Window
ev_window = Window
w, ev_event_type :: Event -> EventType
ev_event_type = EventType
et} = do
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventType
et EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
destroyNotify) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
        (PositionStore -> PositionStore) -> X ()
modifyPosStore (PositionStore -> Window -> PositionStore
`posStoreRemove` Window
w)
    All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
positionStoreEventHook Event
_ = All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)