    ----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.WindowMenu
    -- Copyright   :  (c) Jan Vornberger 2009
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- Uses "XMonad.Actions.GridSelect" to display a number of actions related to
    -- window management in the center of the focused window. Actions include: Closing,
    -- maximizing, minimizing and shifting the window to another workspace.
    --
    -- Note: For maximizing and minimizing to actually work, you will need
    -- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your
    -- setup.  See the documentation of those modules for more information.
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.WindowMenu (
                                 -- * Usage
                                 -- $usage
                                 windowMenu
                                  ) where

    import XMonad
    import qualified XMonad.StackSet as W
    import XMonad.Actions.GridSelect
    import XMonad.Layout.Maximize
    import XMonad.Actions.Minimize
    import XMonad.Util.XUtils (fi)

    -- $usage
    --
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- >    import XMonad.Actions.WindowMenu
    --
    -- Then add a keybinding, e.g.
    --
    -- >    , ((modm,               xK_o ), windowMenu)

    colorizer :: a -> Bool -> X (String, String)
    colorizer :: a -> Bool -> X (String, String)
    colorizer _ isFg :: Bool
    isFg = do
        String
    fBC <- (XConf -> String) -> X String
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> String
    forall (l :: * -> *). XConfig l -> String
    focusedBorderColor (XConfig Layout -> String)
    -> (XConf -> XConfig Layout) -> XConf -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
        String
    nBC <- (XConf -> String) -> X String
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> String
    forall (l :: * -> *). XConfig l -> String
    normalBorderColor (XConfig Layout -> String)
    -> (XConf -> XConfig Layout) -> XConf -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
        (String, String) -> X (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String, String) -> X (String, String))
    -> (String, String) -> X (String, String)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    isFg
                    then (String
    fBC, String
    nBC)
                    else (String
    nBC, String
    fBC)

    windowMenu :: X ()
    windowMenu :: X ()
    windowMenu = (Window -> X ()) -> X ()
    withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \w :: Window
    w -> do
        [String]
    tags <- (XConf -> [String]) -> X [String]
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> [String]
    forall (l :: * -> *). XConfig l -> [String]
    workspaces (XConfig Layout -> [String])
    -> (XConf -> XConfig Layout) -> XConf -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
        Rectangle x :: Position
    x y :: Position
    y wh :: Dimension
    wh ht :: Dimension
    ht <- Window -> X Rectangle
    getSize Window
    w
        Rectangle sx :: Position
    sx sy :: Position
    sy swh :: Dimension
    swh sht :: Dimension
    sht <- (XState -> Rectangle) -> X Rectangle
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> Rectangle) -> X Rectangle)
    -> (XState -> Rectangle) -> X Rectangle
    forall a b. (a -> b) -> a -> b
    $ ScreenDetail -> Rectangle
    screenRect (ScreenDetail -> Rectangle)
    -> (XState -> ScreenDetail) -> XState -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Window) Window ScreenId ScreenDetail
    -> ScreenDetail
    forall i l a sid sd. Screen i l a sid sd -> sd
    W.screenDetail (Screen String (Layout Window) Window ScreenId ScreenDetail
     -> ScreenDetail)
    -> (XState
        -> Screen String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (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 (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> Screen String (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset
        let originFractX :: Double
    originFractX = (Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    x Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    sx Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Dimension -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    wh Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 2) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Dimension -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    swh
            originFractY :: Double
    originFractY = (Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    y Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    sy Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Dimension -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    ht Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 2) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Dimension -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    sht
            gsConfig :: GSConfig a
    gsConfig = ((a -> Bool -> X (String, String)) -> GSConfig a
    forall a. (a -> Bool -> X (String, String)) -> GSConfig a
    buildDefaultGSConfig a -> Bool -> X (String, String)
    forall a. a -> Bool -> X (String, String)
    colorizer)
                        { gs_originFractX :: Double
    gs_originFractX = Double
    originFractX
                        , gs_originFractY :: Double
    gs_originFractY = Double
    originFractY }
            actions :: [(String, X ())]
    actions = [ ("Cancel menu", () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                      , ("Close"      , X ()
    kill)
                      , ("Maximize"   , MaximizeRestore -> X ()
    forall a. Message a => a -> X ()
    sendMessage (MaximizeRestore -> X ()) -> MaximizeRestore -> X ()
    forall a b. (a -> b) -> a -> b
    $ Window -> MaximizeRestore
    maximizeRestore Window
    w)
                      , ("Minimize"   , Window -> X ()
    minimizeWindow Window
    w)
                      ] [(String, X ())] -> [(String, X ())] -> [(String, X ())]
    forall a. [a] -> [a] -> [a]
    ++
                      [ ("Move to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    tag, (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> X ()
    windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
      -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
     -> X ())
    -> (StackSet String (Layout Window) Window ScreenId ScreenDetail
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> X ()
    forall a b. (a -> b) -> a -> b
    $ String
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> StackSet i l a s sd -> StackSet i l a s sd
    W.shift String
    tag)
                        | String
    tag <- [String]
    tags ]
        GSConfig (X ()) -> [(String, X ())] -> X ()
    runSelectedAction GSConfig (X ())
    forall a. GSConfig a
    gsConfig [(String, X ())]
    actions

    getSize :: Window -> X (Rectangle)
    getSize :: Window -> X Rectangle
    getSize w :: Window
    w = do
      Display
    d  <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      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
    w
      let x :: Position
    x = 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
          y :: Position
    y = 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
          wh :: Dimension
    wh = CInt -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> Dimension) -> CInt -> Dimension
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_width WindowAttributes
    wa
          ht :: Dimension
    ht = CInt -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> Dimension) -> CInt -> Dimension
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_height WindowAttributes
    wa
      Rectangle -> X Rectangle
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x Position
    y Dimension
    wh Dimension
    ht)