-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.TagWindows
-- Description  : Functions for tagging windows and selecting them by tags.
-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
-- License      : BSD
--
-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
-- Stability    : unstable
-- Portability  : unportable
--
-- Functions for tagging windows and selecting them by tags.
-----------------------------------------------------------------------------

module XMonad.Actions.TagWindows (
                 -- * Usage
                 -- $usage
                 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 :: a -> IOException -> m a
econst = m a -> IOException -> m a
forall a b. a -> b -> a
const (m a -> IOException -> m a)
-> (a -> m a) -> a -> IOException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- $usage
--
-- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.TagWindows
-- > import XMonad.Prompt    -- to use tagPrompt
--
-- and add keybindings such as the following:
--
-- >   , ((modm,                 xK_f  ), withFocused (addTag "abc"))
-- >   , ((modm .|. controlMask, xK_f  ), withFocused (delTag "abc"))
-- >   , ((modm .|. shiftMask,   xK_f  ), withTaggedGlobalP "abc" W.sink)
-- >   , ((modm,                 xK_d  ), withTaggedP "abc" (W.shiftWin "2"))
-- >   , ((modm .|. shiftMask,   xK_d  ), withTaggedGlobalP "abc" shiftHere)
-- >   , ((modm .|. controlMask, xK_d  ), focusUpTaggedGlobal "abc")
-- >   , ((modm,                 xK_g  ), tagPrompt def (\s -> withFocused (addTag s)))
-- >   , ((modm .|. controlMask, xK_g  ), tagDelPrompt def)
-- >   , ((modm .|. shiftMask,   xK_g  ), tagPrompt def (\s -> withTaggedGlobal s float))
-- >   , ((modWinMask,                xK_g  ), tagPrompt def (\s -> withTaggedP s (W.shiftWin "2")))
-- >   , ((modWinMask .|. shiftMask,  xK_g  ), tagPrompt def (\s -> withTaggedGlobalP s shiftHere))
-- >   , ((modWinMask .|. controlMask, xK_g ), tagPrompt def (\s -> focusUpTaggedGlobal s))
--
-- NOTE: Tags are saved as space separated strings and split with
--       'unwords'. Thus if you add a tag \"a b\" the window will have
--       the tags \"a\" and \"b\" but not \"a b\".
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- | set multiple tags for a window at once (overriding any previous tags)
setTags :: [String] -> Window -> X ()
setTags :: [String] -> Window -> X ()
setTags = String -> Window -> X ()
setTag (String -> Window -> X ())
-> ([String] -> String) -> [String] -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords

-- | set a tag for a window (overriding any previous tags)
--   writes it to the \"_XMONAD_TAGS\" window property
setTag :: String -> Window -> X ()
setTag :: String -> Window -> X ()
setTag String
s Window
w = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d ->
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
internAtom Display
d String
"_XMONAD_TAGS" Bool
False IO Window -> (Window -> IO ()) -> IO ()
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

-- | read all tags of a window
--   reads from the \"_XMONAD_TAGS\" window property
getTags :: Window -> X [String]
getTags :: Window -> X [String]
getTags Window
w = (Display -> X [String]) -> X [String]
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X [String]) -> X [String])
-> (Display -> X [String]) -> X [String]
forall a b. (a -> b) -> a -> b
$ \Display
d ->
    IO [String] -> X [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [String] -> X [String]) -> IO [String] -> X [String]
forall a b. (a -> b) -> a -> b
$ IO [String] -> (IOException -> IO [String]) -> IO [String]
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 IO Window -> (Window -> IO TextProperty) -> IO TextProperty
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w IO TextProperty -> (TextProperty -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                Display -> TextProperty -> IO [String]
wcTextPropertyToTextList Display
d)
               ([String] -> IOException -> IO [String]
forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst [[]]) IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> [String]
words (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords)

-- | check a window for the given tag
hasTag :: String -> Window -> X Bool
hasTag :: String -> Window -> X Bool
hasTag String
s Window
w = (String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([String] -> Bool) -> X [String] -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X [String]
getTags Window
w

-- | add a tag to the existing ones
addTag :: String -> Window -> X ()
addTag :: String -> Window -> X ()
addTag String
s Window
w = do
    [String]
tags <- Window -> X [String]
getTags Window
w
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
tags) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ [String] -> Window -> X ()
setTags (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
tags) Window
w

-- | remove a tag from a window, if it exists
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 ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
s) [String]
tags) Window
w

-- | remove all tags
unTag :: Window -> X ()
unTag :: Window -> X ()
unTag = String -> Window -> X ()
setTag String
""

-- | Move the focus in a group of windows, which share the same given tag.
--   The Global variants move through all workspaces, whereas the other
--   ones operate only on the current workspace
focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X ()
focusUpTagged :: String -> X ()
focusUpTagged         = (WindowSet -> [Window]) -> String -> X ()
focusTagged' ([Window] -> [Window]
forall a. [a] -> [a]
reverse ([Window] -> [Window])
-> (WindowSet -> [Window]) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
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' WindowSet -> [Window]
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' ([Window] -> [Window]
forall a. [a] -> [a]
reverse ([Window] -> [Window])
-> (WindowSet -> [Window]) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
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' WindowSet -> [Window]
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 :: StackSet i l a s sd -> [a]
wsToList StackSet i l a s sd
ws = [a]
crs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
cls
    where
        ([a]
crs, [a]
cls) = ((Stack a -> [a]) -> [a]
forall a. (Stack a -> [a]) -> [a]
cms Stack a -> [a]
forall a. Stack a -> [a]
down, (Stack a -> [a]) -> [a]
forall a. (Stack a -> [a]) -> [a]
cms ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Stack a -> [a]) -> Stack a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> [a]
forall a. Stack a -> [a]
up))
        cms :: (Stack a -> [a]) -> [a]
cms Stack a -> [a]
f = [a] -> (Stack a -> [a]) -> Maybe (Stack a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack a -> [a]
f (Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack (Workspace i l a -> Maybe (Stack a))
-> (StackSet i l a s sd -> Workspace i l a)
-> StackSet i l a s sd
-> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen i l a s sd -> Workspace i l a)
-> (StackSet i l a s sd -> Screen i l a s sd)
-> StackSet i l a s sd
-> Workspace i l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> Screen i l a s sd
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 -> Maybe (Stack a))
-> StackSet i l a s sd -> Maybe (Stack a)
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 :: StackSet i l a s sd -> [a]
wsToListGlobal StackSet i l a s sd
ws = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]
crs] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
rws [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
lws [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]
cls])
    where
        curtag :: i
curtag = StackSet i l a s sd -> i
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) = ((Stack a -> [a]) -> [a]
forall a. (Stack a -> [a]) -> [a]
cms Stack a -> [a]
forall a. Stack a -> [a]
down, (Stack a -> [a]) -> [a]
forall a. (Stack a -> [a]) -> [a]
cms ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Stack a -> [a]) -> Stack a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> [a]
forall a. Stack a -> [a]
up))
        cms :: (Stack a -> [a]) -> [a]
cms Stack a -> [a]
f = [a] -> (Stack a -> [a]) -> Maybe (Stack a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack a -> [a]
f (Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack (Workspace i l a -> Maybe (Stack a))
-> (StackSet i l a s sd -> Workspace i l a)
-> StackSet i l a s sd
-> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen i l a s sd -> Workspace i l a)
-> (StackSet i l a s sd -> Screen i l a s sd)
-> StackSet i l a s sd
-> Workspace i l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> Screen i l a s sd
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 -> Maybe (Stack a))
-> StackSet i l a s sd -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
ws)
        ([[a]]
lws, [[a]]
rws) = ((i -> i -> Bool) -> [[a]]
mws i -> i -> Bool
forall a. Ord a => a -> a -> Bool
(<), (i -> i -> Bool) -> [[a]]
mws i -> i -> Bool
forall a. Ord a => a -> a -> Bool
(>))
        mws :: (i -> i -> Bool) -> [[a]]
mws i -> i -> Bool
cmp = (Workspace i l a -> [a]) -> [Workspace i l a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
integrate' (Maybe (Stack a) -> [a])
-> (Workspace i l a -> Maybe (Stack a)) -> Workspace i l a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack) ([Workspace i l a] -> [[a]])
-> (StackSet i l a s sd -> [Workspace i l a])
-> StackSet i l a s sd
-> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Workspace i l a] -> [Workspace i l a]
forall l a. [Workspace i l a] -> [Workspace i l a]
sortByTag ([Workspace i l a] -> [Workspace i l a])
-> (StackSet i l a s sd -> [Workspace i l a])
-> StackSet i l a s sd
-> [Workspace i l a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace i l a -> Bool) -> [Workspace i l a] -> [Workspace i l a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Workspace i l a
w -> Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag Workspace i l a
w i -> i -> Bool
`cmp` i
curtag) ([Workspace i l a] -> [Workspace i l a])
-> (StackSet i l a s sd -> [Workspace i l a])
-> StackSet i l a s sd
-> [Workspace i l a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> [Workspace i l a]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (StackSet i l a s sd -> [[a]]) -> StackSet i l a s sd -> [[a]]
forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
ws
        sortByTag :: [Workspace i l a] -> [Workspace i l a]
sortByTag = (Workspace i l a -> Workspace i l a -> Ordering)
-> [Workspace i l a] -> [Workspace i l a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Workspace i l a
x Workspace i l a
y -> i -> i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag Workspace i l a
x) (Workspace i l a -> i
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 = (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset X WindowSet -> (WindowSet -> X (Maybe Window)) -> X (Maybe Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> X Bool) -> [Window] -> X (Maybe Window)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (String -> Window -> X Bool
hasTag String
t) ([Window] -> X (Maybe Window))
-> (WindowSet -> [Window]) -> WindowSet -> X (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
wl X (Maybe Window) -> (Maybe Window -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    X () -> (Window -> X ()) -> Maybe Window -> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((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
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)

findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
findM :: (a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
_ []      = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
findM a -> m Bool
p (a
x:[a]
xs)  = do Bool
b <- a -> m Bool
p a
x
                     if Bool
b then Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x) else (a -> m Bool) -> [a] -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
p [a]
xs

-- | apply a pure function to windows with a tag
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 = Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Window]
tw [Window] -> [Window] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ ((WindowSet -> WindowSet)
 -> (WindowSet -> WindowSet) -> WindowSet -> WindowSet)
-> [WindowSet -> WindowSet] -> WindowSet -> WindowSet
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((Window -> WindowSet -> WindowSet)
-> [Window] -> [WindowSet -> WindowSet]
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 ((Window -> X ()) -> [Window] -> X ()
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 ((Window -> X ()) -> [Window] -> X ()
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 = (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset X WindowSet -> (WindowSet -> X [Window]) -> X [Window]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> Window -> X Bool
hasTag String
t) ([Window] -> X [Window])
-> (WindowSet -> [Window]) -> WindowSet -> X [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
index X [Window] -> ([Window] -> X ()) -> X ()
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 = (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset X WindowSet -> (WindowSet -> X [Window]) -> X [Window]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> Window -> X Bool
hasTag String
t) ([Window] -> X [Window])
-> (WindowSet -> [Window]) -> WindowSet -> X [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace String (Layout Window) Window -> [Window])
-> [Workspace String (Layout Window) Window] -> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
integrate' (Maybe (Stack Window) -> [Window])
-> (Workspace String (Layout Window) Window
    -> Maybe (Stack Window))
-> Workspace String (Layout Window) Window
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack) ([Workspace String (Layout Window) Window] -> [Window])
-> (WindowSet -> [Workspace String (Layout Window) Window])
-> WindowSet
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces X [Window] -> ([Window] -> X ()) -> X ()
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 ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ (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
f

shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
shiftHere :: a -> StackSet i l a s sd -> StackSet i l a s sd
shiftHere a
w StackSet i l a s sd
s = i -> a -> StackSet i l a s sd -> StackSet 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 (StackSet i l a s sd -> i
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 :: 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 (Screen i l a s sd -> Bool)
-> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Screen i l a s sd
m -> s
sid s -> s -> Bool
forall a. Eq a => a -> a -> Bool
/= Screen i l a s sd -> s
forall i l a sid sd. Screen i l a sid sd -> sid
screen Screen i l a s sd
m) (StackSet i l a s sd -> Screen i l a s sd
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
sScreen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. a -> [a] -> [a]
:StackSet i l a s sd -> [Screen i l a s sd]
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]
_)   -> i -> a -> StackSet i l a s sd -> StackSet 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 (Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag (Workspace i l a -> i)
-> (Screen i l a s sd -> Workspace i l a) -> Screen i l a s sd -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen i l a s sd -> i) -> Screen i l a s sd -> i
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
  TagPrompt -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
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 = (XState -> [Window]) -> X [Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Workspace String (Layout Window) Window -> [Window])
-> [Workspace String (Layout Window) Window] -> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
integrate' (Maybe (Stack Window) -> [Window])
-> (Workspace String (Layout Window) Window
    -> Maybe (Stack Window))
-> Workspace String (Layout Window) Window
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack) ([Workspace String (Layout Window) Window] -> [Window])
-> (XState -> [Workspace String (Layout Window) Window])
-> XState
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces (WindowSet -> [Workspace String (Layout Window) Window])
-> (XState -> WindowSet)
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
           X [Window] -> ([Window] -> X [[String]]) -> X [[String]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> X [String]) -> [Window] -> X [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X [String]
getTags
           X [[String]] -> ([[String]] -> [String]) -> X [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat


tagDelPrompt :: XPConfig -> X ()
tagDelPrompt :: XPConfig -> X ()
tagDelPrompt XPConfig
c = do
  [String]
sc <- X [String]
tagDelComplList
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
sc [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
    TagPrompt -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
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 ((Window -> X ()) -> X ())
-> (String -> Window -> X ()) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Window -> X ()
delTag)

tagDelComplList :: X [String]
tagDelComplList :: X [String]
tagDelComplList = (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset X WindowSet -> (WindowSet -> X [String]) -> X [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= X [String] -> (Window -> X [String]) -> Maybe Window -> X [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> X [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Window -> X [String]
getTags (Maybe Window -> X [String])
-> (WindowSet -> Maybe Window) -> WindowSet -> X [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek