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
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.LinkWorkspaces
-- Copyright : (c) Jan-David Quesel <quesel@gmail.org>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : none
-- Stability : unstable
-- Portability : unportable
--
-- Provides bindings to add and delete links between workspaces. It is aimed
-- at providing useful links between workspaces in a multihead setup. Linked
-- workspaces are view at the same time.
--
-----------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}
module XMonad.Actions.LinkWorkspaces (
-- * Usage
-- $usage
switchWS,
removeAllMatchings,
unMatch,
toggleLinkWorkspaces,
defaultMessageConf,
MessageConfig(..)
) where
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.IndependentScreens(countScreens)
import qualified XMonad.Util.ExtensibleState as XS (get, put)
import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen')
import qualified Data.Map as M
( insert, delete, Map, lookup, empty, filter )
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.LinkWorkspaces
--
-- and add a function to print messages like
-- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1)
-- > message_color_func c1 c2 msg = dzenColor c1 c2 msg
-- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen
--
-- alternatively you can use the noMessages function as the argument
--
-- Then add keybindings like the following:
--
-- > ,((modm, xK_p), toggleLinkWorkspaces message)
-- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message)
--
-- > [ ((modm .|. m, k), a i)
-- > | (a, m) <- [(switchWS view message, 0),(\x -> switchWS (shift x . view x) message, shiftMask)]
-- > , (i, k) <- zip [1..] [xK_1 .. xK_9]]
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
, foreground :: [Char]
, alertedForeground :: [Char]
, background :: [Char]
}
defaultMessageConf :: MessageConfig
defaultMessageConf = MessageConfig { messageFunction = noMessageFn
, background = "#000000"
, alertedForeground = "#ff7701"
, foreground = "#00ff00" }
noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
noMessageFn _ _ _ _ = return () :: X ()
-- | Stuff for linking workspaces
data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
instance ExtensionClass WorkspaceMap
where initialValue = WorkspaceMap M.empty
extensionType = PersistentExtension
switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X ()
switchWS f m ws = switchWS' f m ws Nothing
-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
-- | we already did switching on
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X ()
switchWS' switchFn message workspace stopAtScreen = do
ws <- gets windowset
nScreens <- countScreens
let now = W.screen (W.current ws)
let next = ((now + 1) `mod` nScreens)
switchFn workspace
case stopAtScreen of
Nothing -> sTM now next (Just now)
Just sId -> if sId == next then return () else sTM now next (Just sId)
where sTM = switchToMatching (switchWS' switchFn message) message workspace
-- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
-> ScreenId -> (Maybe ScreenId) -> X ()
switchToMatching f message t now next stopAtScreen = do
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
case (M.lookup t matchings) of
Nothing -> return () :: X()
Just newWorkspace -> do
onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace))
-- | Insert a mapping between t1 and t2 or remove it was already present
toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
toggleMatching message t1 t2 = do
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
case (M.lookup t1 matchings) of
Nothing -> setMatching message t1 t2 matchings
Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
return ()
-- | Insert a mapping between t1 and t2 and display a message
setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
setMatching message t1 t2 matchings = do
ws <- gets windowset
let now = W.screen (W.current ws)
XS.put $ WorkspaceMap $ M.insert t1 t2 matchings
messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2))
-- currently this function is called manually this means that if workspaces
-- were deleted, some links stay in the RAM even though they are not used
-- anymore... because of the small amount of memory used for those there is no
-- special cleanup so far
removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
removeMatching' message t1 t2 matchings = do
ws <- gets windowset
let now = W.screen (W.current ws)
XS.put $ WorkspaceMap $ M.delete t1 matchings
messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2)
-- | Remove all maps between workspaces
removeAllMatchings :: MessageConfig -> X ()
removeAllMatchings message = do
ws <- gets windowset
let now = W.screen (W.current ws)
XS.put $ WorkspaceMap $ M.empty
messageFunction message now (alertedForeground message) (background message) "All links removed!"
-- | remove all matching regarding a given workspace
unMatch :: WorkspaceId -> X ()
unMatch workspace = do
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings)
-- | Toggle the currently displayed workspaces as matching. Starting from the one with focus
-- | a linked list of workspaces is created that will later be iterated by switchToMatching.
toggleLinkWorkspaces :: MessageConfig -> X ()
toggleLinkWorkspaces message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message
toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X ()
toggleLinkWorkspaces' first message = do
ws <- gets windowset
nScreens <- countScreens
let now = W.screen (W.current ws)
let next = (now + 1) `mod` nScreens
if next == first then return () else do -- this is also the case if there is only one screen
case (W.lookupWorkspace next ws) of
Nothing -> return ()
Just name -> toggleMatching message (W.currentTag ws) (name)
onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next
|
