1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.TagWindows
-- 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
) where
import Prelude hiding (catch)
import Data.List (nub,sortBy)
import Control.Monad
import Control.Exception
import XMonad.StackSet hiding (filter)
import XMonad.Prompt
import XMonad hiding (workspaces)
econst :: Monad m => a -> IOException -> m a
econst = const . 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 defaultXPConfig (\s -> withFocused (addTag s)))
-- > , ((modm .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig)
-- > , ((modm .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))
-- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (W.shiftWin "2")))
-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere))
-- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\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 = setTag . unwords
-- | set a tag for a window (overriding any previous tags)
-- writes it to the \"_XMONAD_TAGS\" window property
setTag :: String -> Window -> X ()
setTag s w = withDisplay $ \d ->
io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s
-- | read all tags of a window
-- reads from the \"_XMONAD_TAGS\" window property
getTags :: Window -> X [String]
getTags w = withDisplay $ \d ->
io $ catch (internAtom d "_XMONAD_TAGS" False >>=
getTextProperty d w >>=
wcTextPropertyToTextList d)
(econst [[]])
>>= return . words . unwords
-- | check a window for the given tag
hasTag :: String -> Window -> X Bool
hasTag s w = (s `elem`) `fmap` getTags w
-- | add a tag to the existing ones
addTag :: String -> Window -> X ()
addTag s w = do
tags <- getTags w
if (s `notElem` tags) then setTags (s:tags) w else return ()
-- | remove a tag from a window, if it exists
delTag :: String -> Window -> X ()
delTag s w = do
tags <- getTags w
setTags (filter (/= s) tags) w
-- | remove all tags
unTag :: Window -> X ()
unTag = setTag ""
-- | 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 = focusTagged' (reverse . wsToList)
focusDownTagged = focusTagged' wsToList
focusUpTaggedGlobal = focusTagged' (reverse . wsToListGlobal)
focusDownTaggedGlobal = focusTagged' wsToListGlobal
wsToList :: (Ord i) => StackSet i l a s sd -> [a]
wsToList ws = crs ++ cls
where
(crs, cls) = (cms down, cms (reverse . up))
cms f = maybe [] f (stack . workspace . current $ ws)
wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a]
wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls])
where
curtag = currentTag ws
(crs, cls) = (cms down, cms (reverse . up))
cms f = maybe [] f (stack . workspace . current $ ws)
(lws, rws) = (mws (<), mws (>))
mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws
sortByTag = sortBy (\x y -> compare (tag x) (tag y))
focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=
maybe (return ()) (windows . focusWindow)
findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
findM _ [] = return Nothing
findM p (x:xs) = do b <- p x
if b then return (Just x) else findM p xs
-- | apply a pure function to windows with a tag
withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
withTaggedP t f = withTagged' t (winMap f)
withTaggedGlobalP t f = withTaggedGlobal' t (winMap f)
winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X ()
winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw))
withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X ()
withTagged t f = withTagged' t (mapM_ f)
withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f)
withTagged' :: String -> ([Window] -> X ()) -> X ()
withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
withTaggedGlobal' t m = gets windowset >>=
filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
withFocusedP f = withFocused $ windows . f
shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
shiftHere w s = shiftWin (currentTag s) w s
shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
[] -> s
(t:_) -> shiftWin (tag . workspace $ t) w s
data TagPrompt = TagPrompt
instance XPrompt TagPrompt where
showXPrompt TagPrompt = "Select Tag: "
tagPrompt :: XPConfig -> (String -> X ()) -> X ()
tagPrompt c f = do
sc <- tagComplList
mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
tagComplList :: X [String]
tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
mapM getTags >>=
return . nub . concat
tagDelPrompt :: XPConfig -> X ()
tagDelPrompt c = do
sc <- tagDelComplList
if (sc /= [])
then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
else return ()
tagDelComplList :: X [String]
tagDelComplList = gets windowset >>= maybe (return []) getTags . peek
|
