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
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.DynamicWorkspaces
-- Copyright : (c) David Roundy <droundy@darcs.net>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : David Roundy <droundy@darcs.net>
-- Stability : unstable
-- Portability : unportable
--
-- Provides bindings to add and delete workspaces. Note that you may only
-- delete a workspace that is already empty.
--
-----------------------------------------------------------------------------
module XMonad.Actions.DynamicWorkspaces (
-- * Usage
-- $usage
addWorkspace, removeWorkspace,
withWorkspace,
selectWorkspace, renameWorkspace,
toNthWorkspace, withNthWorkspace
) where
import Control.Monad.Reader ( asks )
import Control.Monad.State ( gets )
import Data.List ( sort )
import XMonad ( X, XState(..), WindowSet, config, layoutHook )
import XMonad.Operations
import XMonad.StackSet hiding (filter, modify, delete)
import XMonad.Prompt.Workspace
import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
-- $usage
-- You can use this module with the following in your Config.hs file:
--
-- > import XMonad.Actions.DynamicWorkspaces
--
-- > , ((modMask .|. shiftMask, xK_BackSpace), removeWorkspace)
-- > , ((modMask x .|. shiftMask, xK_v ), selectWorkspace defaultXPConfig)
-- > , ((modMask x, xK_m ), withWorkspace defaultXPConfig (windows . W.shift))
-- > , ((modMask x .|. shiftMask, xK_m ), withWorkspace defaultXPConfig (windows . copy))
-- > , ((modMask x .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig)
--
-- > -- mod-[1..9] %! Switch to workspace N
-- > -- mod-shift-[1..9] %! Move client to workspace N
-- > ++
-- > zip (zip (repeat modMask) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
-- > ++
-- > zip (zip (repeat (modMask .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
data Wor = Wor String
instance XPrompt Wor where
showXPrompt (Wor x) = x
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)
let ts = sort $ map tag 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 $ \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 ws <- gets (sort . map tag . workspaces . windowset)
case drop wnum ws of
(w:_) -> job w
[] -> return ()
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = do ws <- gets (sort . map tag . 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
addWorkspace :: String -> X ()
addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
addHiddenWorkspace :: String -> X ()
addHiddenWorkspace newtag = do l <- asks (layoutHook . config)
windows (addHiddenWorkspace' newtag l)
removeWorkspace :: X ()
removeWorkspace = do s <- gets windowset
case s of
StackSet { current = Screen { workspace = torem }
, hidden = (w:_) }
-> do windows $ view (tag w)
windows (removeWorkspace' (tag torem))
_ -> return ()
addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }
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 = (w:ws) })
| tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }
, hidden = ws }
where meld Nothing Nothing = Nothing
meld x Nothing = x
meld Nothing x = x
meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
removeWorkspace' _ s = s
|
