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
|
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.DynamicWorkspaceOrder
-- Copyright : (c) Brent Yorgey 2009
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <byorgey@gmail.com>
-- Stability : experimental
-- Portability : unportable
--
-- Remember a dynamically updateable ordering on workspaces, together
-- with tools for using this ordering with "XMonad.Actions.CycleWS"
-- and "XMonad.Hooks.DynamicLog".
--
-----------------------------------------------------------------------------
module XMonad.Actions.DynamicWorkspaceOrder
( -- * Usage
-- $usage
getWsCompareByOrder
, getSortByOrder
, swapWith
, moveTo
, moveToGreedy
, shiftTo
, withNthWorkspace
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort)
import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe (fromJust, fromMaybe)
import Data.Ord (comparing)
-- $usage
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
--
-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
--
-- Then add keybindings to swap the order of workspaces (these
-- examples use "XMonad.Util.EZConfig" emacs-style keybindings):
--
-- > , ("M-C-<R>", DO.swapWith Next NonEmptyWS)
-- > , ("M-C-<L>", DO.swapWith Prev NonEmptyWS)
--
-- See "XMonad.Actions.CycleWS" for information on the possible
-- arguments to 'swapWith'.
--
-- However, by itself this will do nothing; 'swapWith' does not change
-- the actual workspaces in any way. It simply keeps track of an
-- auxiliary ordering on workspaces. Anything which cares about the
-- order of workspaces must be updated to use the auxiliary ordering.
--
-- To change the order in which workspaces are displayed by
-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your
-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:
--
-- > ... dynamicLogWithPP $ byorgeyPP {
-- > ...
-- > , ppSort = DO.getSortByOrder
-- > ...
-- > }
--
-- To use workspace cycling commands like those from
-- "XMonad.Actions.CycleWS", use the versions of 'moveTo',
-- 'moveToGreedy', and 'shiftTo' exported by this module. For example:
--
-- > , ("M-S-<R>", DO.shiftTo Next HiddenNonEmptyWS)
-- > , ("M-S-<L>", DO.shiftTo Prev HiddenNonEmptyWS)
-- > , ("M-<R>", DO.moveTo Next HiddenNonEmptyWS)
-- > , ("M-<L>", DO.moveTo Prev HiddenNonEmptyWS)
--
-- For slight variations on these, use the source for examples and
-- tweak as desired.
-- | Extensible state storage for the workspace order.
data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
deriving (Typeable, Read, Show)
instance ExtensionClass WSOrderStorage where
initialValue = WSO Nothing
extensionType = PersistentExtension
-- | Lift a Map function to a function on WSOrderStorage.
withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int)
-> (WSOrderStorage -> WSOrderStorage)
withWSO f = WSO . fmap f . unWSO
-- | Update the ordering storage: initialize if it doesn't yet exist;
-- add newly created workspaces at the end as necessary.
updateOrder :: X ()
updateOrder = do
WSO mm <- XS.get
case mm of
Nothing -> do
-- initialize using ordering of workspaces from the user's config
ws <- asks (workspaces . config)
XS.put . WSO . Just . M.fromList $ zip ws [0..]
Just m -> do
-- check for new workspaces and add them at the end
curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset)
let mappedWs = M.keysSet m
newWs = curWs `S.difference` mappedWs
nextIndex = 1 + maximum (-1 : M.elems m)
newWsIxs = zip (S.toAscList newWs) [nextIndex..]
XS.modify . withWSO . M.union . M.fromList $ newWsIxs
-- | A comparison function which orders workspaces according to the
-- stored dynamic ordering.
getWsCompareByOrder :: X WorkspaceCompare
getWsCompareByOrder = do
updateOrder
-- after the call to updateOrder we are guaranteed that the dynamic
-- workspace order is initialized and contains all existing
-- workspaces.
WSO (Just m) <- XS.get
return $ comparing (fromMaybe 1000 . flip M.lookup m)
-- | Sort workspaces according to the stored dynamic ordering.
getSortByOrder :: X WorkspaceSort
getSortByOrder = mkWsSort getWsCompareByOrder
-- | Swap the current workspace with another workspace in the stored
-- dynamic order.
swapWith :: Direction1D -> WSType -> X ()
swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent
-- | Swap the given workspace with the current one.
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent w = do
cur <- gets (W.currentTag . windowset)
swapOrder w cur
-- | Swap the two given workspaces in the dynamic order.
swapOrder :: WorkspaceId -> WorkspaceId -> X ()
swapOrder w1 w2 = do
io $ print (w1,w2)
WSO (Just m) <- XS.get
let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]
XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
windows id -- force a status bar update
-- | View the next workspace of the given type in the given direction,
-- where \"next\" is determined using the dynamic workspace order.
moveTo :: Direction1D -> WSType -> X ()
moveTo dir t = doTo dir t getSortByOrder (windows . W.view)
-- | Same as 'moveTo', but using 'greedyView' instead of 'view'.
moveToGreedy :: Direction1D -> WSType -> X ()
moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
-- | Shift the currently focused window to the next workspace of the
-- given type in the given direction, using the dynamic workspace order.
shiftTo :: Direction1D -> WSType -> X ()
shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
-- | Do something with the nth workspace in the dynamic order. The
-- callback is given the workspace's tag as well as the 'WindowSet'
-- of the workspace itself.
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = do
sort <- getSortByOrder
ws <- gets (map W.tag . sort . W.workspaces . windowset)
case drop wnum ws of
(w:_) -> windows $ job w
[] -> return ()
|
