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
200
201
202
203
204
205
206
207
208
209
210
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.DynamicWorkspaces
-- Copyright : (c) David Roundy <droundy@darcs.net>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : none
-- Stability : unstable
-- Portability : unportable
--
-- Provides bindings to add and delete workspaces.
--
-----------------------------------------------------------------------------
module XMonad.Actions.DynamicWorkspaces (
-- * Usage
-- $usage
addWorkspace, addWorkspacePrompt,
appendWorkspace, appendWorkspacePrompt,
addWorkspaceAt,
removeWorkspace,
removeWorkspaceByTag,
removeEmptyWorkspace,
removeEmptyWorkspaceAfter,
removeEmptyWorkspaceAfterExcept,
addHiddenWorkspace, addHiddenWorkspaceAt,
withWorkspace,
selectWorkspace, renameWorkspace,
renameWorkspaceByName,
toNthWorkspace, withNthWorkspace
) where
import XMonad hiding (workspaces)
import XMonad.StackSet hiding (filter, modify, delete)
import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
import XMonad.Prompt ( XPConfig, mkXPrompt )
import XMonad.Util.WorkspaceCompare ( getSortByIndex )
import Data.List (find)
import Data.Maybe (isNothing)
import Control.Monad (when)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.DynamicWorkspaces
-- > import XMonad.Actions.CopyWindow(copy)
--
-- Then add keybindings like the following:
--
-- > , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace)
-- > , ((modm .|. shiftMask, xK_v ), selectWorkspace def)
-- > , ((modm, xK_m ), withWorkspace def (windows . W.shift))
-- > , ((modm .|. shiftMask, xK_m ), withWorkspace def (windows . copy))
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def)
--
-- > -- mod-[1..9] %! Switch to workspace N
-- > -- mod-shift-[1..9] %! Move client to workspace N
-- > ++
-- > zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
-- > ++
-- > zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'.
mkCompl :: [String] -> String -> IO [String]
mkCompl l s = return $ filter (\x -> take (length s) x == s) l
withWorkspace :: XPConfig -> (String -> X ()) -> X ()
withWorkspace c job = do ws <- gets (workspaces . windowset)
sort <- getSortByIndex
let ts = map tag $ sort ws
job' t | t `elem` ts = job t
| otherwise = addHiddenWorkspace t >> job t
mkXPrompt (Wor "") c (mkCompl ts) job'
renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = workspacePrompt conf renameWorkspaceByName
renameWorkspaceByName :: String -> X ()
renameWorkspaceByName w = windows $ \s -> let sett wk = wk { tag = w }
setscr scr = scr { workspace = sett $ workspace scr }
sets q = q { current = setscr $ current q }
in sets $ removeWorkspace' w s
toNthWorkspace :: (String -> X ()) -> Int -> X ()
toNthWorkspace job wnum = do sort <- getSortByIndex
ws <- gets (map tag . sort . workspaces . windowset)
case drop wnum ws of
(w:_) -> job w
[] -> return ()
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = do sort <- getSortByIndex
ws <- gets (map tag . sort . workspaces . windowset)
case drop wnum ws of
(w:_) -> windows $ job w
[] -> return ()
selectWorkspace :: XPConfig -> X ()
selectWorkspace conf = workspacePrompt conf $ \w ->
do s <- gets windowset
if tagMember w s
then windows $ greedyView w
else addWorkspace w
-- | Add a new workspace with the given name, or do nothing if a
-- workspace with the given name already exists; then switch to the
-- newly created workspace.
addWorkspace :: String -> X ()
addWorkspace = addWorkspaceAt (:)
-- | Same as addWorkspace, but adds the workspace to the end of the list of workspaces
appendWorkspace :: String -> X()
appendWorkspace = addWorkspaceAt (flip (++) . return)
-- | Adds a new workspace with the given name to the current list of workspaces.
-- This function allows the user to pass a function that inserts an element
-- into a list at an arbitrary spot.
addWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
addWorkspaceAt add newtag = addHiddenWorkspaceAt add newtag >> windows (greedyView newtag)
-- | Prompt for the name of a new workspace, add it if it does not
-- already exist, and switch to it.
addWorkspacePrompt :: XPConfig -> X ()
addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace
-- | Prompt for the name of a new workspace, appending it to the end of the list of workspaces
-- if it does not already exist, and switch to it.
appendWorkspacePrompt :: XPConfig -> X ()
appendWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) appendWorkspace
-- | Add a new hidden workspace with the given name, or do nothing if
-- a workspace with the given name already exists. Takes a function to insert
-- the workspace at an arbitrary spot in the list.
addHiddenWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
addHiddenWorkspaceAt add newtag =
whenX (gets (not . tagMember newtag . windowset)) $ do
l <- asks (layoutHook . config)
windows (addHiddenWorkspace' add newtag l)
-- | Add a new hidden workspace with the given name, or do nothing if
-- a workspace with the given name already exists.
addHiddenWorkspace :: String -> X ()
addHiddenWorkspace = addHiddenWorkspaceAt (:)
-- | Remove the current workspace if it contains no windows.
removeEmptyWorkspace :: X ()
removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag
-- | Remove the current workspace.
removeWorkspace :: X ()
removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag
-- | Remove workspace with specific tag if it contains no windows.
removeEmptyWorkspaceByTag :: String -> X ()
removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t
-- | Remove workspace with specific tag.
removeWorkspaceByTag :: String -> X ()
removeWorkspaceByTag torem = do
s <- gets windowset
case s of
StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do
when (torem==tag cur) $ windows $ view $ tag w
windows $ removeWorkspace' torem
_ -> return ()
-- | Remove the current workspace after an operation if it is empty and hidden.
-- Can be used to remove a workspace if it is empty when leaving it. The
-- operation may only change workspace once, otherwise the workspace will not
-- be removed.
removeEmptyWorkspaceAfter :: X () -> X ()
removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept []
-- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces,
-- whose entries will never be removed.
removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
removeEmptyWorkspaceAfterExcept sticky f = do
before <- gets (currentTag . windowset)
f
after <- gets (currentTag . windowset)
when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before
isEmpty :: String -> X Bool
isEmpty t = do wsl <- gets $ workspaces . windowset
let mws = find (\ws -> tag ws == t) wsl
return $ maybe True (isNothing . stack) mws
addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }
-- | Remove the hidden workspace with the given tag from the StackSet, if
-- it exists. All the windows in that workspace are moved to the current
-- workspace.
removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
, hidden = hs })
= let (xs, ys) = break ((== torem) . tag) hs
in removeWorkspace'' xs ys
where meld Nothing Nothing = Nothing
meld x Nothing = x
meld Nothing x = x
meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
removeWorkspace'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }
, hidden = xs ++ ys }
removeWorkspace'' _ _ = s
|
