module XMonad.Actions.TagWindows (
addTag, delTag, unTag,
setTags, getTags, hasTag,
withTaggedP, withTaggedGlobalP, withFocusedP,
withTagged , withTaggedGlobal ,
focusUpTagged, focusUpTaggedGlobal,
focusDownTagged, focusDownTaggedGlobal,
shiftHere, shiftToScreen,
tagPrompt,
tagDelPrompt,
TagPrompt,
) where
import Control.Exception as E
import XMonad hiding (workspaces)
import XMonad.Prelude
import XMonad.Prompt
import XMonad.StackSet hiding (filter)
econst :: Monad m => a -> IOException -> m a
econst :: forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
setTags :: [String] -> Window -> X ()
setTags :: [String] -> Window -> X ()
setTags = String -> Window -> X ()
setTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords
setTag :: String -> Window -> X ()
setTag :: String -> Window -> X ()
setTag String
s Window
w = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
internAtom Display
d String
"_XMONAD_TAGS" Bool
False forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> Window -> String -> Window -> IO ()
setTextProperty Display
d Window
w String
s
getTags :: Window -> X [String]
getTags :: Window -> X [String]
getTags Window
w = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Display -> String -> Bool -> IO Window
internAtom Display
d String
"_XMONAD_TAGS" Bool
False forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Display -> TextProperty -> IO [String]
wcTextPropertyToTextList Display
d)
(forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst [[]]) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords)
hasTag :: String -> Window -> X Bool
hasTag :: String -> Window -> X Bool
hasTag String
s Window
w = (String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X [String]
getTags Window
w
addTag :: String -> Window -> X ()
addTag :: String -> Window -> X ()
addTag String
s Window
w = do
[String]
tags <- Window -> X [String]
getTags Window
w
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
tags) forall a b. (a -> b) -> a -> b
$ [String] -> Window -> X ()
setTags (String
sforall a. a -> [a] -> [a]
:[String]
tags) Window
w
delTag :: String -> Window -> X ()
delTag :: String -> Window -> X ()
delTag String
s Window
w = do
[String]
tags <- Window -> X [String]
getTags Window
w
[String] -> Window -> X ()
setTags (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
s) [String]
tags) Window
w
unTag :: Window -> X ()
unTag :: Window -> X ()
unTag = String -> Window -> X ()
setTag String
""
focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X ()
focusUpTagged :: String -> X ()
focusUpTagged = (WindowSet -> [Window]) -> String -> X ()
focusTagged' (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. Ord i => StackSet i l a s sd -> [a]
wsToList)
focusDownTagged :: String -> X ()
focusDownTagged = (WindowSet -> [Window]) -> String -> X ()
focusTagged' forall i l a s sd. Ord i => StackSet i l a s sd -> [a]
wsToList
focusUpTaggedGlobal :: String -> X ()
focusUpTaggedGlobal = (WindowSet -> [Window]) -> String -> X ()
focusTagged' (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. Ord i => StackSet i l a s sd -> [a]
wsToListGlobal)
focusDownTaggedGlobal :: String -> X ()
focusDownTaggedGlobal = (WindowSet -> [Window]) -> String -> X ()
focusTagged' forall i l a s sd. Ord i => StackSet i l a s sd -> [a]
wsToListGlobal
wsToList :: (Ord i) => StackSet i l a s sd -> [a]
wsToList :: forall i l a s sd. Ord i => StackSet i l a s sd -> [a]
wsToList StackSet i l a s sd
ws = [a]
crs forall a. [a] -> [a] -> [a]
++ [a]
cls
where
([a]
crs, [a]
cls) = (forall {a}. (Stack a -> [a]) -> [a]
cms forall a. Stack a -> [a]
down, forall {a}. (Stack a -> [a]) -> [a]
cms (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
up))
cms :: (Stack a -> [a]) -> [a]
cms Stack a -> [a]
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack a -> [a]
f (forall i l a. Workspace i l a -> Maybe (Stack a)
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
ws)
wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a]
wsToListGlobal :: forall i l a s sd. Ord i => StackSet i l a s sd -> [a]
wsToListGlobal StackSet i l a s sd
ws = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]
crs] forall a. [a] -> [a] -> [a]
++ [[a]]
rws forall a. [a] -> [a] -> [a]
++ [[a]]
lws forall a. [a] -> [a] -> [a]
++ [[a]
cls])
where
curtag :: i
curtag = forall i l a s sd. StackSet i l a s sd -> i
currentTag StackSet i l a s sd
ws
([a]
crs, [a]
cls) = (forall {a}. (Stack a -> [a]) -> [a]
cms forall a. Stack a -> [a]
down, forall {a}. (Stack a -> [a]) -> [a]
cms (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
up))
cms :: (Stack a -> [a]) -> [a]
cms Stack a -> [a]
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack a -> [a]
f (forall i l a. Workspace i l a -> Maybe (Stack a)
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
ws)
([[a]]
lws, [[a]]
rws) = ((i -> i -> Bool) -> [[a]]
mws forall a. Ord a => a -> a -> Bool
(<), (i -> i -> Bool) -> [[a]]
mws forall a. Ord a => a -> a -> Bool
(>))
mws :: (i -> i -> Bool) -> [[a]]
mws i -> i -> Bool
cmp = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe (Stack a) -> [a]
integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
stack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {l} {a}. [Workspace i l a] -> [Workspace i l a]
sortByTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Workspace i l a
w -> forall i l a. Workspace i l a -> i
tag Workspace i l a
w i -> i -> Bool
`cmp` i
curtag) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
ws
sortByTag :: [Workspace i l a] -> [Workspace i l a]
sortByTag = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Workspace i l a
x Workspace i l a
y -> forall a. Ord a => a -> a -> Ordering
compare (forall i l a. Workspace i l a -> i
tag Workspace i l a
x) (forall i l a. Workspace i l a -> i
tag Workspace i l a
y))
focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
focusTagged' WindowSet -> [Window]
wl String
t = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (String -> Window -> X Bool
hasTag String
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
wl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
focusWindow)
withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
withTaggedP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
withTaggedP String
t Window -> WindowSet -> WindowSet
f = String -> ([Window] -> X ()) -> X ()
withTagged' String
t ((Window -> WindowSet -> WindowSet) -> [Window] -> X ()
winMap Window -> WindowSet -> WindowSet
f)
withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
withTaggedGlobalP String
t Window -> WindowSet -> WindowSet
f = String -> ([Window] -> X ()) -> X ()
withTaggedGlobal' String
t ((Window -> WindowSet -> WindowSet) -> [Window] -> X ()
winMap Window -> WindowSet -> WindowSet
f)
winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X ()
winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X ()
winMap Window -> WindowSet -> WindowSet
f [Window]
tw = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Window]
tw forall a. Eq a => a -> a -> Bool
/= []) ((WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (forall a b. (a -> b) -> [a] -> [b]
map Window -> WindowSet -> WindowSet
f [Window]
tw))
withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X ()
withTagged :: String -> (Window -> X ()) -> X ()
withTagged String
t Window -> X ()
f = String -> ([Window] -> X ()) -> X ()
withTagged' String
t (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
f)
withTaggedGlobal :: String -> (Window -> X ()) -> X ()
withTaggedGlobal String
t Window -> X ()
f = String -> ([Window] -> X ()) -> X ()
withTaggedGlobal' String
t (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
f)
withTagged' :: String -> ([Window] -> X ()) -> X ()
withTagged' :: String -> ([Window] -> X ()) -> X ()
withTagged' String
t [Window] -> X ()
m = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> Window -> X Bool
hasTag String
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [a]
index forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Window] -> X ()
m
withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
withTaggedGlobal' String
t [Window] -> X ()
m = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> Window -> X Bool
hasTag String
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Maybe (Stack a) -> [a]
integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
stack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Window] -> X ()
m
withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
withFocusedP Window -> WindowSet -> WindowSet
f = (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
f
shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
shiftHere :: forall a s i l sd.
(Ord a, Eq s, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
shiftHere a
w StackSet i l a s sd
s = 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
shiftWin (forall i l a s sd. StackSet i l a s sd -> i
currentTag StackSet i l a s sd
s) a
w StackSet i l a s sd
s
shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftToScreen :: forall a s i l sd.
(Ord a, Eq s, Eq i) =>
s -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftToScreen s
sid a
w StackSet i l a s sd
s = case forall a. (a -> Bool) -> [a] -> [a]
filter (\Screen i l a s sd
m -> s
sid forall a. Eq a => a -> a -> Bool
/= forall i l a sid sd. Screen i l a sid sd -> sid
screen Screen i l a s sd
m) (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
sforall a. a -> [a] -> [a]
:forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
s) of
[] -> StackSet i l a s sd
s
(Screen i l a s sd
t:[Screen i l a s sd]
_) -> 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
shiftWin (forall i l a. Workspace i l a -> i
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace forall a b. (a -> b) -> a -> b
$ Screen i l a s sd
t) a
w StackSet i l a s sd
s
data TagPrompt = TagPrompt
instance XPrompt TagPrompt where
showXPrompt :: TagPrompt -> String
showXPrompt TagPrompt
TagPrompt = String
"Select Tag: "
tagPrompt :: XPConfig -> (String -> X ()) -> X ()
tagPrompt :: XPConfig -> (String -> X ()) -> X ()
tagPrompt XPConfig
c String -> X ()
f = do
[String]
sc <- X [String]
tagComplList
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt TagPrompt
TagPrompt XPConfig
c (XPConfig -> [String] -> ComplFunction
mkComplFunFromList' XPConfig
c [String]
sc) String -> X ()
f
tagComplList :: X [String]
tagComplList :: X [String]
tagComplList = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Maybe (Stack a) -> [a]
integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
stack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X [String]
getTags
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
tagDelPrompt :: XPConfig -> X ()
tagDelPrompt :: XPConfig -> X ()
tagDelPrompt XPConfig
c = do
[String]
sc <- X [String]
tagDelComplList
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
sc forall a. Eq a => a -> a -> Bool
/= []) forall a b. (a -> b) -> a -> b
$
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt TagPrompt
TagPrompt XPConfig
c (XPConfig -> [String] -> ComplFunction
mkComplFunFromList' XPConfig
c [String]
sc) ((Window -> X ()) -> X ()
withFocused forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Window -> X ()
delTag)
tagDelComplList :: X [String]
tagDelComplList :: X [String]
tagDelComplList = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return []) Window -> X [String]
getTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> Maybe a
peek