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
|
module Rahm.Desktop.Theater
( getCurrentTheaterName,
getTheaters,
saveTheater,
saveCurrentTheater,
restoreTheater,
isStackSetEmpty,
updateStateWithWindows,
)
where
-- A "Theater" is the state of a stackset. One can save the current stackset as
-- a "theater" and then restore it later. If new windows were added, those new
-- windows are put into the hidden workspace.
import Data.Default (Default (..))
import Data.List (sortOn, (\\))
import Data.Map (Map)
import qualified Data.Map as Map (delete, insert, lookup, toList)
import Data.Maybe (isNothing)
import XMonad (X)
import qualified XMonad as X
( ExtensionClass (..),
MonadState (..),
ScreenDetail,
ScreenId,
StateExtension (..),
Window,
WindowSet,
WorkspaceId,
XState (windowset),
readsLayout,
windows,
withWindowSet,
rescreen
)
import qualified XMonad.StackSet as W
( Screen (..),
StackSet (..),
Workspace (..),
allWindows,
differentiate,
filter,
integrate',
mapLayout,
mapWorkspace,
tagMember,
workspaces,
)
import qualified XMonad.Util.ExtensibleState as XS (get, modify)
type WinSet = W.StackSet X.WorkspaceId String X.Window X.ScreenId X.ScreenDetail
newtype Theater = Theater WinSet
deriving (Read, Show)
type TheaterName = Maybe String
data Theaters = Theaters
{ currentTheater :: TheaterName,
theaters :: Map TheaterName Theater
}
deriving (Read, Show)
instance Default Theaters where
def = Theaters Nothing mempty
instance X.ExtensionClass Theaters where
initialValue = def
extensionType = X.PersistentExtension
getCurrentTheaterName :: X TheaterName
getCurrentTheaterName = currentTheater <$> XS.get
getTheaters :: X [(TheaterName, Theater, Bool)]
getTheaters = do
(Theaters cur theaters) <- XS.get
return $
sortOn (\(s, _, _) -> s) $
map (\(name, theater) -> (name, theater, name == cur)) $
filter (\(name, Theater ws) -> not (isStackSetEmpty "*" ws) || name == cur) $
Map.toList theaters
saveTheater :: TheaterName -> X.WindowSet -> X ()
saveTheater name ws = do
XS.modify $ \(Theaters cur map) ->
Theaters cur $ do
if isStackSetEmpty "*" ws && name /= cur
then Map.delete name map
else Map.insert name (Theater $ unboxLayout ws) map
where
unboxLayout = W.mapLayout show
saveCurrentTheater :: TheaterName -> X ()
saveCurrentTheater = X.withWindowSet . saveTheater
restoreTheater :: TheaterName -> X ()
restoreTheater name = do
currentWindowset <- X.windowset <$> X.get
currentTheaterName <- currentTheater <$> XS.get
currentLayout <- W.layout . W.workspace . W.current . X.windowset <$> X.get
saveTheater currentTheaterName currentWindowset
newStackSet' <- do
(Theaters cur mp) <- XS.get
case Map.lookup name mp of
Nothing -> do
ws <- X.windowset <$> X.get
return $
W.mapWorkspace
( \(W.Workspace i l _) -> W.Workspace i l Nothing
)
ws
Just (Theater ws) ->
return $
W.mapLayout
( \serialized -> case [x | (x, "") <- X.readsLayout currentLayout serialized] of
[x] -> x
[] -> currentLayout
(_ : _) -> currentLayout
)
ws
let newStackSet = updateStateWithWindows (W.allWindows currentWindowset) "*" newStackSet'
saveTheater Nothing currentWindowset
XS.modify $ \(Theaters _ m) -> Theaters name m
saveTheater name newStackSet
X.windows $ const newStackSet
X.rescreen
isStackSetEmpty ::
(Eq i, Eq a) => i -> W.StackSet i l a si sd -> Bool
isStackSetEmpty hiddenWorkspace =
all
( \(W.Workspace t l s) -> isNothing s || t == hiddenWorkspace
)
. W.workspaces
updateStateWithWindows ::
(Eq i, Eq a) => [a] -> i -> W.StackSet i l a si sd -> W.StackSet i l a si sd
updateStateWithWindows allWindows hiddenWorkspace ss =
let missingWindows = allWindows \\ W.allWindows ss
layout = W.layout $ W.workspace $ W.current ss
in if null missingWindows
then ss
else
if not (W.tagMember hiddenWorkspace ss)
then
ss
{ W.hidden =
W.Workspace hiddenWorkspace layout (W.differentiate missingWindows) :
W.hidden ss
}
else
W.mapWorkspace
( \(W.Workspace t l s') ->
let s = W.filter (`elem` allWindows) =<< s'
in if t == hiddenWorkspace
then W.Workspace t l (W.differentiate $ W.integrate' s ++ missingWindows)
else W.Workspace t l s
)
ss
|
