----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.DecorationAddons
-- Description :  Various stuff that can be added to the decoration.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- Various stuff that can be added to the decoration. Most of it
-- is intended to be used by other modules. See
-- "XMonad.Layout.ButtonDecoration" for a module that makes use of this.
--
-----------------------------------------------------------------------------

module XMonad.Layout.DecorationAddons (
                                    titleBarButtonHandler
                                   ,defaultThemeWithButtons
                                   ,handleScreenCrossing
                                   ) where

import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.Decoration
import XMonad.Actions.WindowMenu
import XMonad.Actions.Minimize
import XMonad.Layout.Maximize
import XMonad.Hooks.ManageDocks
import XMonad.Util.Font
import XMonad.Util.PositionStore

import XMonad.Prelude
import qualified Data.Set as S

minimizeButtonOffset :: Int
minimizeButtonOffset :: Int
minimizeButtonOffset = Int
48

maximizeButtonOffset :: Int
maximizeButtonOffset :: Int
maximizeButtonOffset = Int
25

closeButtonOffset :: Int
closeButtonOffset :: Int
closeButtonOffset = Int
10

buttonSize :: Int
buttonSize :: Int
buttonSize = Int
10

-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration.
-- It will intercept clicks on the buttons of the decoration and invoke the associated action.
-- To actually see the buttons, you will need to use a theme that includes them.
-- See 'defaultThemeWithButtons' below.
titleBarButtonHandler :: Window -> Int -> Int -> X Bool
titleBarButtonHandler :: Window -> Int -> Int -> X Bool
titleBarButtonHandler Window
mainw Int
distFromLeft Int
distFromRight = do
    let action :: X Bool
action
          | forall a b. (Integral a, Num b) => a -> b
fi Int
distFromLeft forall a. Ord a => a -> a -> Bool
<= Int
3 forall a. Num a => a -> a -> a
* Int
buttonSize = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
windowMenu forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
>= Int
closeButtonOffset Bool -> Bool -> Bool
&&
            forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
<= Int
closeButtonOffset forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
kill forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
>= Int
maximizeButtonOffset Bool -> Bool -> Bool
&&
            forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
<= Int
maximizeButtonOffset forall a. Num a => a -> a -> a
+ (Int
2 forall a. Num a => a -> a -> a
* Int
buttonSize) = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Message a => a -> X ()
sendMessage (Window -> MaximizeRestore
maximizeRestore Window
mainw) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
>= Int
minimizeButtonOffset Bool -> Bool -> Bool
&&
            forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
<= Int
minimizeButtonOffset forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
minimizeWindow Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    X Bool
action

-- | Intended to be used together with 'titleBarButtonHandler'. See above.
defaultThemeWithButtons :: Theme
defaultThemeWithButtons :: Theme
defaultThemeWithButtons = forall a. Default a => a
def {
                            windowTitleAddons :: [(WorkspaceId, Align)]
windowTitleAddons = [ (WorkspaceId
" (M)", Align
AlignLeft)
                                                , (WorkspaceId
"_"   , Int -> Align
AlignRightOffset Int
minimizeButtonOffset)
                                                , (WorkspaceId
"[]"  , Int -> Align
AlignRightOffset Int
maximizeButtonOffset)
                                                , (WorkspaceId
"X"   , Int -> Align
AlignRightOffset Int
closeButtonOffset)
                                                ]
                            }

-- | A function intended to be plugged into the 'decorationAfterDraggingHook' of a decoration.
-- It will check if the window has been dragged onto another screen and shift it there.
-- The PositionStore is also updated accordingly, as this is designed to be used together
-- with "XMonad.Layout.PositionStoreFloat".
handleScreenCrossing :: Window -> Window -> X Bool
handleScreenCrossing :: Window -> Window -> X Bool
handleScreenCrossing Window
w Window
decoWin = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    Window
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    (Bool
_, Window
_, Window
_, CInt
px, CInt
py, 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
root
    WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    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 CInt
px) (forall a b. (Integral a, Num b) => a -> b
fi CInt
py)
    Maybe WorkspaceId
maybeWksp <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc
    let targetWksp :: Maybe WorkspaceId
targetWksp = Maybe WorkspaceId
maybeWksp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WorkspaceId
wksp ->
                        forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w WindowSet
ws forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WorkspaceId
currentWksp ->
                        if WorkspaceId
currentWksp forall a. Eq a => a -> a -> Bool
/= WorkspaceId
wksp
                            then forall a. a -> Maybe a
Just WorkspaceId
wksp
                            else forall a. Maybe a
Nothing
    case Maybe WorkspaceId
targetWksp of
        Just WorkspaceId
wksp -> do
                        -- find out window under cursor on target workspace
                        -- apparently we have to switch to the workspace first
                        -- to make this work, which unforunately introduces some flicker
                        (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ \WindowSet
ws' -> forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
wksp WindowSet
ws'
                        (Bool
_, Window
_, Window
selWin, CInt
_, CInt
_, 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
root

                        -- adjust PositionStore
                        let oldScreenRect :: Rectangle
oldScreenRect = 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
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws
                            newScreenRect :: Rectangle
newScreenRect = 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
                        {-- somewhat ugly hack to get proper ScreenRect,
                            creates unwanted inter-dependencies
                            TODO: get ScreenRects in a proper way --}
                        Rectangle
oldScreenRect' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Rectangle
oldScreenRect) (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])
                        Rectangle
newScreenRect' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Rectangle
newScreenRect) (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])
                        WindowAttributes
wa <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
decoWin
                        (PositionStore -> PositionStore) -> X ()
modifyPosStore (\PositionStore
ps ->
                            PositionStore
-> Window
-> Position
-> Position
-> Rectangle
-> Rectangle
-> PositionStore
posStoreMove PositionStore
ps Window
w (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)
                                Rectangle
oldScreenRect' Rectangle
newScreenRect')

                        -- set focus correctly so the window will be inserted
                        -- at the correct position on the target workspace
                        -- and then shift the window
                        (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ \WindowSet
ws' -> forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
wksp Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
selWin forall a b. (a -> b) -> a -> b
$ WindowSet
ws'

                        -- return True to signal that screen crossing has taken place
                        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe WorkspaceId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False