    ----------------------------------------------------------------------------
    -- |
    -- 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
              | Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    distFromLeft Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    buttonSize = Window -> X ()
    focus Window
    mainw X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> X ()
    windowMenu X () -> X Bool -> X Bool
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
              | Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    distFromRight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    closeButtonOffset Bool -> Bool -> Bool
    &&
                Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    distFromRight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    closeButtonOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    buttonSize = Window -> X ()
    focus Window
    mainw X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> X ()
    kill X () -> X Bool -> X Bool
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
              | Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    distFromRight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maximizeButtonOffset Bool -> Bool -> Bool
    &&
                Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    distFromRight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maximizeButtonOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    buttonSize) = Window -> X ()
    focus Window
    mainw X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> MaximizeRestore -> X ()
    forall a. Message a => a -> X ()
    sendMessage (Window -> MaximizeRestore
    maximizeRestore Window
    mainw) X () -> X Bool -> X Bool
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
              | Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    distFromRight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    minimizeButtonOffset Bool -> Bool -> Bool
    &&
                Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    distFromRight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    minimizeButtonOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    buttonSize = Window -> X ()
    focus Window
    mainw X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Window -> X ()
    minimizeWindow Window
    mainw X () -> X Bool -> X Bool
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
              | Bool
    otherwise = Bool -> X Bool
    forall a. a -> X a
    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 = Theme
    forall a. Default a => a
    def {
                                windowTitleAddons = [ (" (M)", AlignLeft)
                                                    , ("_"   , AlignRightOffset minimizeButtonOffset)
                                                    , ("[]"  , AlignRightOffset maximizeButtonOffset)
                                                    , ("X"   , AlignRightOffset 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 = (Display -> X Bool) -> X Bool
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X Bool) -> X Bool) -> (Display -> X Bool) -> X Bool
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> do
        Window
    root <- (XConf -> Window) -> X Window
    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
    _) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
     -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    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 <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
        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
    px) (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    py)
        Maybe WorkspaceId
    maybeWksp <- ScreenId -> X (Maybe WorkspaceId)
    screenWorkspace (ScreenId -> X (Maybe WorkspaceId))
    -> ScreenId -> X (Maybe WorkspaceId)
    forall a b. (a -> b) -> a -> b
    $ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    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 Maybe WorkspaceId
    -> (WorkspaceId -> Maybe WorkspaceId) -> Maybe WorkspaceId
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \WorkspaceId
    wksp ->
                            Window -> WindowSet -> Maybe WorkspaceId
    forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
    W.findTag Window
    w WindowSet
    ws Maybe WorkspaceId
    -> (WorkspaceId -> Maybe WorkspaceId) -> Maybe WorkspaceId
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \WorkspaceId
    currentWksp ->
                            if WorkspaceId
    currentWksp WorkspaceId -> WorkspaceId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= WorkspaceId
    wksp
                                then WorkspaceId -> Maybe WorkspaceId
    forall a. a -> Maybe a
    Just WorkspaceId
    wksp
                                else Maybe WorkspaceId
    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 ((WindowSet -> WindowSet) -> X ())
    -> (WindowSet -> WindowSet) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \WindowSet
    ws' -> WorkspaceId -> WindowSet -> WindowSet
    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
    _) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
     -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    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 (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
    $ 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
                                newScreenRect :: Rectangle
    newScreenRect = 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
                            {-- somewhat ugly hack to get proper ScreenRect,
                                creates unwanted inter-dependencies
                                TODO: get ScreenRects in a proper way --}
                            Rectangle
    oldScreenRect' <- ((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
    oldScreenRect) (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])
                            Rectangle
    newScreenRect' <- ((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
    newScreenRect) (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])
                            WindowAttributes
    wa <- IO WindowAttributes -> X WindowAttributes
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO WindowAttributes -> X WindowAttributes)
    -> IO WindowAttributes -> X WindowAttributes
    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 (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)
                                    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 ((WindowSet -> WindowSet) -> X ())
    -> (WindowSet -> WindowSet) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \WindowSet
    ws' -> WorkspaceId -> Window -> WindowSet -> WindowSet
    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 (WindowSet -> WindowSet)
    -> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> WindowSet -> WindowSet
    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 (WindowSet -> WindowSet) -> WindowSet -> WindowSet
    forall a b. (a -> b) -> a -> b
    $ WindowSet
    ws'

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