{-# LANGUAGE TupleSections #-}
module XMonad.Actions.WindowBringer (
WindowBringerConfig(..),
gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs',
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)
import XMonad.Actions.CopyWindow (copyWindow)
data WindowBringerConfig = WindowBringerConfig
{ WindowBringerConfig -> String
menuCommand :: String
, :: [String]
, WindowBringerConfig -> WindowSpace -> Window -> X String
windowTitler :: X.WindowSpace -> Window -> X String
, WindowBringerConfig -> Window -> X Bool
windowFilter :: Window -> X Bool
}
instance Default WindowBringerConfig where
def :: WindowBringerConfig
def = 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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
}
gotoMenu :: X ()
= WindowBringerConfig -> X ()
gotoMenuConfig forall a. Default a => a
def
gotoMenuConfig :: WindowBringerConfig -> X ()
WindowBringerConfig
wbConfig = WindowBringerConfig -> (Window -> WindowSet -> WindowSet) -> X ()
actionMenu WindowBringerConfig
wbConfig 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
gotoMenuArgs :: [String] -> X ()
[String]
args = WindowBringerConfig -> X ()
gotoMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args }
gotoMenu' :: String -> X ()
String
cmd = WindowBringerConfig -> X ()
gotoMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [], menuCommand :: String
menuCommand = String
cmd }
gotoMenuArgs' :: String -> [String] -> X ()
String
cmd [String]
args = WindowBringerConfig -> X ()
gotoMenuConfig forall a. Default a => a
def { menuCommand :: String
menuCommand = String
cmd, menuArgs :: [String]
menuArgs = [String]
args }
copyMenu :: X ()
= [String] -> X ()
copyMenuArgs forall a. Default a => a
def
copyMenuConfig :: WindowBringerConfig -> X ()
WindowBringerConfig
wbConfig = WindowBringerConfig -> (Window -> WindowSet -> WindowSet) -> X ()
actionMenu WindowBringerConfig
wbConfig Window -> WindowSet -> WindowSet
copyBringWindow
copyMenuArgs :: [String] -> X ()
[String]
args = WindowBringerConfig -> X ()
copyMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args }
copyMenu' :: String -> X ()
String
cmd = WindowBringerConfig -> X ()
copyMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [], menuCommand :: String
menuCommand = String
cmd }
copyMenuArgs' :: String -> [String] -> X ()
String
cmd [String]
args = WindowBringerConfig -> X ()
copyMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args, menuCommand :: String
menuCommand = String
cmd }
copyBringWindow :: Window -> X.WindowSet -> X.WindowSet
copyBringWindow :: Window -> WindowSet -> WindowSet
copyBringWindow Window
w WindowSet
ws = forall a i s l sd.
(Eq a, Eq i, Eq s) =>
a -> i -> StackSet i l a s sd -> StackSet i l a s sd
copyWindow Window
w (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) WindowSet
ws
bringMenu :: X ()
= [String] -> X ()
bringMenuArgs forall a. Default a => a
def
bringMenuConfig :: WindowBringerConfig -> X ()
WindowBringerConfig
wbConfig = WindowBringerConfig -> (Window -> WindowSet -> WindowSet) -> X ()
actionMenu WindowBringerConfig
wbConfig Window -> WindowSet -> WindowSet
bringWindow
bringMenuArgs :: [String] -> X ()
[String]
args = WindowBringerConfig -> X ()
bringMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args }
bringMenu' :: String -> X ()
String
cmd = WindowBringerConfig -> X ()
bringMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [], menuCommand :: String
menuCommand = String
cmd }
bringMenuArgs' :: String -> [String] -> X ()
String
cmd [String]
args = WindowBringerConfig -> X ()
bringMenuConfig forall a. Default a => a
def { menuArgs :: [String]
menuArgs = [String]
args, menuCommand :: String
menuCommand = String
cmd }
bringWindow :: Window -> X.WindowSet -> X.WindowSet
bringWindow :: Window -> WindowSet -> WindowSet
bringWindow Window
w 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 (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) Window
w WindowSet
ws
actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Map String a -> X (Maybe a)
menuMapFunction forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
X.whenJust ((WindowSet -> WindowSet) -> X ()
windows 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 = forall (m :: * -> *) a.
MonadIO m =>
String -> [String] -> Map String a -> m (Maybe a)
menuMapArgs String
cmd [String]
args
windowMap :: X (M.Map String Window)
windowMap :: X (Map String Window)
windowMap = WindowBringerConfig -> X (Map String Window)
windowMap' forall a. Default a => a
def
windowAppMap :: X (M.Map String Window)
windowAppMap :: X (Map String Window)
windowAppMap = WindowBringerConfig -> X (Map String Window)
windowMap' forall a. Default a => a
def { windowTitler :: WindowSpace -> Window -> X String
windowTitler = WindowSpace -> Window -> X String
decorateAppName }
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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
X.windowset
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WindowSpace -> X [(String, Window)]
keyValuePairs (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 = forall a. Maybe (Stack a) -> [a]
W.integrate' (forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack WindowSpace
ws)
in 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) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowSpace -> Window -> X String
titler WindowSpace
ws Window
w
decorateName :: X.WindowSpace -> Window -> X String
decorateName :: WindowSpace -> Window -> X String
decorateName WindowSpace
ws Window
w = do
String
name <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X NamedWindow
getName Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
name forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ forall i l a. Workspace i l a -> i
W.tag WindowSpace
ws forall a. [a] -> [a] -> [a]
++ String
"]"
decorateAppName :: X.WindowSpace -> Window -> X String
decorateAppName :: WindowSpace -> Window -> X String
decorateAppName WindowSpace
ws Window
w = do
String
name <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X NamedWindow
getNameWMClass Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
name forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ forall i l a. Workspace i l a -> i
W.tag WindowSpace
ws forall a. [a] -> [a] -> [a]
++ String
"]"