----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.WindowMenu
-- Description :  Display window management actions in the center of the focused window.
-- 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.Prelude (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 a
_ 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
$ \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 Position
x Position
y Dimension
wh Dimension
ht <- Window -> X Rectangle
getSize Window
w
    Rectangle Position
sx Position
sy Dimension
swh 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
/ Double
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
/ Double
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 = [ (String
"Cancel menu", () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                  , (String
"Close"      , X ()
kill)
                  , (String
"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)
                  , (String
"Minimize"   , Window -> X ()
minimizeWindow Window
w)
                  ] [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++
                  [ (String
"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 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)