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
|
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.DynamicWorkspaceGroups
-- Copyright : (c) Brent Yorgey 2009
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <byorgey@gmail.com>
-- Stability : experimental
-- Portability : unportable
--
-- Dynamically manage \"workspace groups\", sets of workspaces being
-- used together for some common task or purpose, to allow switching
-- between workspace groups in a single action. Note that this only
-- makes sense for multi-head setups.
--
-----------------------------------------------------------------------------
module XMonad.Actions.DynamicWorkspaceGroups
( -- * Usage
-- $usage
WSGroupId
, addWSGroup
, addCurrentWSGroup
, forgetWSGroup
, viewWSGroup
, promptWSGroupView
, promptWSGroupAdd
, promptWSGroupForget
) where
import Data.List (find)
import Control.Arrow ((&&&))
import qualified Data.Map as M
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Prompt
import qualified XMonad.Util.ExtensibleState as XS
-- $usage
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
--
-- > import XMonad.Actions.DynamicWorkspaceGroups
--
-- Then add keybindings like the following (this example uses
-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary):
--
-- > , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
-- > , ("M-y g", promptWSGroupView myXPConfig "Go to group: ")
-- > , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
--
type WSGroup = [(ScreenId,WorkspaceId)]
type WSGroupId = String
data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
deriving (Typeable, Read, Show)
withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
withWSG f = WSG . f . unWSG
instance ExtensionClass WSGroupStorage where
initialValue = WSG $ M.empty
extensionType = PersistentExtension
-- | Add a new workspace group with the given name.
addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
addWSGroup name wids = withWindowSet $ \w -> do
let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
wmap = mapM (strength . (flip lookup wss &&& id)) wids
case wmap of
Just ps -> XS.modify . withWSG . M.insert name $ ps
Nothing -> return ()
where strength (ma, b) = ma >>= \a -> return (a,b)
-- | Give a name to the current workspace group.
addCurrentWSGroup :: WSGroupId -> X ()
addCurrentWSGroup name = withWindowSet $ \w ->
addWSGroup name $ map (W.tag . W.workspace) (W.current w : W.visible w)
-- | Delete the named workspace group from the list of workspace
-- groups. Note that this has no effect on the workspaces involved;
-- it simply forgets the given name.
forgetWSGroup :: WSGroupId -> X ()
forgetWSGroup = XS.modify . withWSG . M.delete
-- | View the workspace group with the given name.
viewWSGroup :: WSGroupId -> X ()
viewWSGroup name = do
WSG m <- XS.get
case M.lookup name m of
Just grp -> mapM_ (uncurry viewWS) grp
Nothing -> return ()
-- | View the given workspace on the given screen.
viewWS :: ScreenId -> WorkspaceId -> X ()
viewWS sid wid = do
mw <- findScreenWS sid
case mw of
Just w -> do
windows $ W.view w
windows $ W.greedyView wid
Nothing -> return ()
-- | Find the workspace which is currently on the given screen.
findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
findScreenWS sid = withWindowSet $
return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
data WSGPrompt = WSGPrompt String
instance XPrompt WSGPrompt where
showXPrompt (WSGPrompt s) = s
-- | Prompt for a workspace group to view.
promptWSGroupView :: XPConfig -> String -> X ()
promptWSGroupView xp s = do
gs <- fmap (M.keys . unWSG) XS.get
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
-- | Prompt for a name for the current workspace group.
promptWSGroupAdd :: XPConfig -> String -> X ()
promptWSGroupAdd xp s =
mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup
-- | Prompt for a workspace group to forget.
promptWSGroupForget :: XPConfig -> String -> X ()
promptWSGroupForget xp s = do
gs <- fmap (M.keys . unWSG) XS.get
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup
|
