{-# LANGUAGE TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.WindowBringer
-- Description :  Dmenu operations to bring windows to you, and bring you to windows.
-- Copyright   :  Devin Mullins <me@twifkak.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Devin Mullins <me@twifkak.com>
-- Stability   :  stable
-- Portability :  unportable
--
-- dmenu operations to bring windows to you, and bring you to windows.
-- That is to say, it pops up a dmenu with window names, in case you forgot
-- where you left your XChat.
--
-----------------------------------------------------------------------------

module XMonad.Actions.WindowBringer (
                    -- * Usage
                    -- $usage
                    WindowBringerConfig(..),
                    gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
                    bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
                    windowMap, windowAppMap, windowMap', bringWindow, actionMenu
                   ) where

import Control.Monad
import qualified Data.Map as M

import qualified XMonad.StackSet as W
import XMonad
import qualified XMonad as X
import XMonad.Util.Dmenu (menuMapArgs)
import XMonad.Util.NamedWindows (getName, getNameWMClass)

-- $usage
--
-- Import the module into your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.WindowBringer
--
-- and define appropriate key bindings:
--
-- > , ((modm .|. shiftMask, xK_g     ), gotoMenu)
-- > , ((modm .|. shiftMask, xK_b     ), bringMenu)
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".

data WindowBringerConfig = WindowBringerConfig
    { WindowBringerConfig -> String
menuCommand :: String -- ^ The shell command that will handle window selection
    , WindowBringerConfig -> [String]
menuArgs :: [String] -- ^ Arguments to be passed to menuCommand
    , WindowBringerConfig -> WindowSpace -> Window -> X String
windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window
    , WindowBringerConfig -> Window -> X Bool
windowFilter :: Window -> X Bool -- ^ Filter function to decide which windows to consider
    }

instance Default WindowBringerConfig where
    def :: WindowBringerConfig
def = WindowBringerConfig :: String
-> [String]
-> (WindowSpace -> Window -> X String)
-> (Window -> X Bool)
-> WindowBringerConfig
WindowBringerConfig{ menuCommand :: String
menuCommand = String
"dmenu"
                             , menuArgs :: [String]
menuArgs = [String
"-i"]
                             , windowTitler :: WindowSpace -> Window -> X String
windowTitler = WindowSpace -> Window -> X String
decorateName
                             , windowFilter :: Window -> X Bool
windowFilter = \Window
_ -> Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                             }

-- | Pops open a dmenu with window titles. Choose one, and you will be
--   taken to the corresponding workspace.
gotoMenu :: X ()
gotoMenu :: X ()
gotoMenu = WindowBringerConfig -> X ()
gotoMenuConfig WindowBringerConfig
forall a. Default a => a
def

-- | Pops open a dmenu with window titles. Choose one, and you will be
--   taken to the corresponding workspace. This version accepts a configuration
--   object.
gotoMenuConfig :: WindowBringerConfig -> X ()
gotoMenuConfig :: WindowBringerConfig -> X ()
gotoMenuConfig WindowBringerConfig
wbConfig = WindowBringerConfig -> (Window -> WindowSet -> WindowSet) -> X ()
actionMenu WindowBringerConfig
wbConfig 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

-- | Pops open a dmenu with window titles. Choose one, and you will be
--   taken to the corresponding workspace. This version takes a list of
--   arguments to pass to dmenu.
gotoMenuArgs :: [String] -> X ()
gotoMenuArgs :: [String] -> X ()
gotoMenuArgs [String]
args = WindowBringerConfig -> X ()
gotoMenuConfig WindowBringerConfig
forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args }

-- | Pops open an application with window titles given over stdin. Choose one,
--   and you will be taken to the corresponding workspace.
gotoMenu' :: String -> X ()
gotoMenu' :: String -> X ()
gotoMenu' String
cmd = WindowBringerConfig -> X ()
gotoMenuConfig WindowBringerConfig
forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [], menuCommand :: String
menuCommand = String
cmd }

-- | Pops open an application with window titles given over stdin. Choose one,
--   and you will be taken to the corresponding workspace. This version takes a
--   list of arguments to pass to dmenu.
gotoMenuArgs' :: String -> [String] -> X ()
gotoMenuArgs' :: String -> [String] -> X ()
gotoMenuArgs' String
cmd [String]
args = WindowBringerConfig -> X ()
gotoMenuConfig WindowBringerConfig
forall a. Default a => a
def { menuCommand :: String
menuCommand = String
cmd, menuArgs :: [String]
menuArgs = [String]
args }

-- | Pops open a dmenu with window titles. Choose one, and it will be
--   dragged, kicking and screaming, into your current workspace.
bringMenu :: X ()
bringMenu :: X ()
bringMenu = [String] -> X ()
bringMenuArgs [String]
forall a. Default a => a
def

-- | Pops open a dmenu with window titles. Choose one, and it will be
--   dragged, kicking and screaming, into your current workspace. This version
--   accepts a configuration object.
bringMenuConfig :: WindowBringerConfig -> X ()
bringMenuConfig :: WindowBringerConfig -> X ()
bringMenuConfig WindowBringerConfig
wbConfig = WindowBringerConfig -> (Window -> WindowSet -> WindowSet) -> X ()
actionMenu WindowBringerConfig
wbConfig Window -> WindowSet -> WindowSet
bringWindow

-- | Pops open a dmenu with window titles. Choose one, and it will be
--   dragged, kicking and screaming, into your current workspace. This version
--   takes a list of arguments to pass to dmenu.
bringMenuArgs :: [String] -> X ()
bringMenuArgs :: [String] -> X ()
bringMenuArgs [String]
args = WindowBringerConfig -> X ()
bringMenuConfig WindowBringerConfig
forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args }

-- | Pops open an application with window titles given over stdin. Choose one,
--   and it will be dragged, kicking and screaming, into your current
--   workspace.
bringMenu' :: String -> X ()
bringMenu' :: String -> X ()
bringMenu' String
cmd = WindowBringerConfig -> X ()
bringMenuConfig WindowBringerConfig
forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [], menuCommand :: String
menuCommand = String
cmd }

-- | Pops open an application with window titles given over stdin. Choose one,
--   and it will be dragged, kicking and screaming, into your current
--   workspace. This version allows arguments to the chooser to be specified.
bringMenuArgs' :: String -> [String] -> X ()
bringMenuArgs' :: String -> [String] -> X ()
bringMenuArgs' String
cmd [String]
args = WindowBringerConfig -> X ()
bringMenuConfig WindowBringerConfig
forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args, menuCommand :: String
menuCommand = String
cmd }

-- | Brings the specified window into the current workspace.
bringWindow :: Window -> X.WindowSet -> X.WindowSet
bringWindow :: Window -> WindowSet -> WindowSet
bringWindow Window
w WindowSet
ws = String -> 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 (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) Window
w WindowSet
ws

-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
--   if found.
actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
actionMenu :: WindowBringerConfig -> (Window -> WindowSet -> WindowSet) -> X ()
actionMenu c :: WindowBringerConfig
c@WindowBringerConfig{ menuCommand :: WindowBringerConfig -> String
menuCommand = String
cmd, menuArgs :: WindowBringerConfig -> [String]
menuArgs = [String]
args } Window -> WindowSet -> WindowSet
action =
  WindowBringerConfig -> X (Map String Window)
windowMap' WindowBringerConfig
c X (Map String Window)
-> (Map String Window -> X (Maybe Window)) -> X (Maybe Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map String Window -> X (Maybe Window)
forall a. Map String a -> X (Maybe a)
menuMapFunction X (Maybe Window) -> (Maybe Window -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Window -> (Window -> X ()) -> X ())
-> (Window -> X ()) -> Maybe Window -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
X.whenJust ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
action)
    where
      menuMapFunction :: M.Map String a -> X (Maybe a)
      menuMapFunction :: forall a. Map String a -> X (Maybe a)
menuMapFunction = String -> [String] -> Map String a -> X (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
String -> [String] -> Map String a -> m (Maybe a)
menuMapArgs String
cmd [String]
args


-- | A map from window names to Windows.
windowMap :: X (M.Map String Window)
windowMap :: X (Map String Window)
windowMap = WindowBringerConfig -> X (Map String Window)
windowMap' WindowBringerConfig
forall a. Default a => a
def

-- | A map from application executable names to Windows.
windowAppMap :: X (M.Map String Window)
windowAppMap :: X (Map String Window)
windowAppMap = WindowBringerConfig -> X (Map String Window)
windowMap' WindowBringerConfig
forall a. Default a => a
def { windowTitler :: WindowSpace -> Window -> X String
windowTitler = WindowSpace -> Window -> X String
decorateAppName }

-- | A map from window names to Windows, given a windowTitler function.
windowMap' :: WindowBringerConfig -> X (M.Map String Window)
windowMap' :: WindowBringerConfig -> X (Map String Window)
windowMap' WindowBringerConfig{ windowTitler :: WindowBringerConfig -> WindowSpace -> Window -> X String
windowTitler = WindowSpace -> Window -> X String
titler, windowFilter :: WindowBringerConfig -> Window -> X Bool
windowFilter = Window -> X Bool
include } = do
  WindowSet
windowSet <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
X.windowset
  [(String, Window)] -> Map String Window
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Window)] -> Map String Window)
-> ([[(String, Window)]] -> [(String, Window)])
-> [[(String, Window)]]
-> Map String Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(String, Window)]] -> [(String, Window)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(String, Window)]] -> Map String Window)
-> X [[(String, Window)]] -> X (Map String Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WindowSpace -> X [(String, Window)])
-> [WindowSpace] -> X [[(String, Window)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WindowSpace -> X [(String, Window)]
keyValuePairs (WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
windowSet)
 where keyValuePairs :: WindowSpace -> X [(String, Window)]
keyValuePairs WindowSpace
ws = let wins :: [Window]
wins = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (WindowSpace -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack WindowSpace
ws)
                           in (Window -> X (String, Window)) -> [Window] -> X [(String, Window)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WindowSpace -> Window -> X (String, Window)
keyValuePair WindowSpace
ws) ([Window] -> X [(String, Window)])
-> X [Window] -> X [(String, Window)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Window -> X Bool
include [Window]
wins
       keyValuePair :: WindowSpace -> Window -> X (String, Window)
keyValuePair WindowSpace
ws Window
w = (, Window
w) (String -> (String, Window)) -> X String -> X (String, Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowSpace -> Window -> X String
titler WindowSpace
ws Window
w

-- | Returns the window name as will be listed in dmenu.
--   Tagged with the workspace ID, to guarantee uniqueness, and to let the user
--   know where he's going.
decorateName :: X.WindowSpace -> Window -> X String
decorateName :: WindowSpace -> Window -> X String
decorateName WindowSpace
ws Window
w = do
  String
name <- NamedWindow -> String
forall a. Show a => a -> String
show (NamedWindow -> String) -> X NamedWindow -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X NamedWindow
getName Window
w
  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ WindowSpace -> String
forall i l a. Workspace i l a -> i
W.tag WindowSpace
ws String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

-- | Returns the window name as will be listed in dmenu.  This will
-- return the executable name of the window along with it's workspace
-- ID.
decorateAppName :: X.WindowSpace -> Window -> X String
decorateAppName :: WindowSpace -> Window -> X String
decorateAppName WindowSpace
ws Window
w = do
  String
name <- NamedWindow -> String
forall a. Show a => a -> String
show (NamedWindow -> String) -> X NamedWindow -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X NamedWindow
getNameWMClass Window
w
  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ WindowSpace -> String
forall i l a. Workspace i l a -> i
W.tag WindowSpace
ws String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"