----------------------------------------------------------------------------
-- |
-- 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 = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Theme -> Window -> X ()
positionStoreInit Maybe Theme
mDecoTheme forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall m. Monoid m => m
idHook

positionStoreInit :: Maybe Theme -> Window -> X ()
positionStoreInit :: Maybe Theme -> Window -> X ()
positionStoreInit Maybe Theme
mDecoTheme Window
w  = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
        let decoH :: EventType
decoH = 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 <- 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 forall a. Eq a => a -> a -> Bool
== CInt
0) Bool -> Bool -> Bool
&& (WindowAttributes -> CInt
wa_y WindowAttributes
wa 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail 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
W.current 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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Int
arbitraryOffsetX)
                                                   (Position
srY forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Int
arbitraryOffsetY)
                                                    (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa)
                                                    (EventType
decoH forall a. Num a => a -> a -> a
+ 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 <- forall a. a -> Maybe a -> a
fromMaybe (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> Position
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
pointScreen (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa)
                let sr :: Rectangle
sr = ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc
                Rectangle
sr' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Rectangle
sr) (Set Direction2D -> X (Rectangle -> Rectangle)
calcGap forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [forall a. Bounded a => a
minBound .. 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 (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_y WindowAttributes
wa) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi EventType
decoH)
                                            (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa) (EventType
decoH forall a. Num a => a -> a -> a
+ 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventType
et forall a. Eq a => a -> a -> Bool
== EventType
destroyNotify) forall a b. (a -> b) -> a -> b
$
        (PositionStore -> PositionStore) -> X ()
modifyPosStore (PositionStore -> Window -> PositionStore
`posStoreRemove` Window
w)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
positionStoreEventHook Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)