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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
{-# OPTIONS_GHC -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.SwitchTrans
-- Copyright : (c) Lukas Mai
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <l.mai@web.de>
-- Stability : unstable
-- Portability : unportable
--
--
-- Ordinary layout transformers are simple and easy to use but inflexible.
-- This module provides a more structured interface to them.
--
-- The basic idea is to have a base layout and a set of layout transformers,
-- of which at most one is active at any time. Enabling another transformer
-- first disables any currently active transformer; i.e. it works like
-- a group of radio buttons.
--
-- A side effect of this meta-layout is that layout transformers no longer
-- receive any messages; any message not handled by @SwitchTrans@ itself will
-- undo the current layout transformer, pass the message on to the base layout,
-- then reapply the transformer.
--
-- Another potential problem is that functions can't be (de-)serialized so this
-- layout will not preserve state across xmonad restarts.
--
-- Here's how you might use this in Config.hs:
--
-- > layouts =
-- > map (
-- > mkSwitch (M.fromList [
-- > ("full", const $ Layout $ noBorders Full)
-- > ]) .
-- > mkSwitch (M.fromList [
-- > ("mirror", Layout . Mirror)
-- > ])
-- > ) [ Layout tiled ]
--
-- (The @noBorders@ transformer is from "XMonadContrib.NoBorders".)
--
-- This example is probably overkill but it's very close to what I actually use.
-- Anyway, this layout behaves like the default @tiled@ layout, until you send it
-- @Enable@\/@Disable@\/@Toggle@ messages. From the definition of @keys@:
--
-- > ...
-- > , ((modMask, xK_f ), sendMessage $ Toggle "full")
-- > , ((modMask, xK_r ), sendMessage $ Toggle "mirror")
--
-- (You may want to use other keys. I don't use Xinerama so the default mod-r
-- binding is useless to me.)
--
-- After this, pressing @mod-f@ switches the current window to fullscreen mode.
-- Pressing @mod-f@ again switches it back. Similarly, @mod-r@ rotates the layout
-- by 90 degrees (and back). The nice thing is that your changes are kept:
-- Rotating first then changing the size of the master area then rotating back
-- does not undo the master area changes.
--
-- The reason I use two stacked @SwitchTrans@ transformers instead of @mkSwitch
-- (M.fromList [(\"full\", const $ Layout $ noBorders Full), (\"mirror\",
-- Layout . Mirror)])@ is that I use @mod-f@ to \"zoom in\" on interesting
-- windows, no matter what other layout transformers may be active. Having an
-- extra fullscreen mode on top of everything else means I can zoom in and out
-- without implicitly undoing \"normal\" layout transformers, like @Mirror@.
-- Remember, inside a @SwitchTrans@ there can be at most one active layout
-- transformer.
-----------------------------------------------------------------------------
module XMonadContrib.SwitchTrans (
Toggle(..),
Enable(..),
Disable(..),
mkSwitch
) where
import XMonad
import XMonad.Operations
import qualified Data.Map as M
import Data.Map (Map)
--import System.IO
-- | Toggle the specified layout transformer.
data Toggle = Toggle String deriving (Eq, Typeable)
instance Message Toggle
-- | Enable the specified transformer.
data Enable = Enable String deriving (Eq, Typeable)
instance Message Enable
-- | Disable the specified transformer.
data Disable = Disable String deriving (Eq, Typeable)
instance Message Disable
data SwitchTrans a = SwitchTrans {
base :: Layout a,
currTag :: Maybe String,
currLayout :: Layout a,
currFilt :: Layout a -> Layout a,
filters :: Map String (Layout a -> Layout a)
}
instance Show (SwitchTrans a) where
show st = "SwitchTrans #<base: " ++ show (base st) ++ ", tag: " ++ show (currTag st) ++ ", layout: " ++ show (currLayout st) ++ ", ...>"
instance Read (SwitchTrans a) where
readsPrec _ _ = []
unLayout :: Layout a -> (forall l. (LayoutClass l a) => l a -> r) -> r
unLayout (Layout l) k = k l
acceptChange :: (LayoutClass l a) => SwitchTrans a -> ((l a -> SwitchTrans a) -> b -> c) -> X b -> X c
acceptChange st f action =
-- seriously, Dave, you need to stop this
fmap (f (\l -> st{ currLayout = Layout l})) action
instance LayoutClass SwitchTrans a where
description _ = "SwitchTrans"
doLayout st r s = currLayout st `unLayout` \l -> do
--io $ hPutStrLn stderr $ "[ST]{ " ++ show st
x{- @(_, w) -} <- acceptChange st (fmap . fmap) (doLayout l r s)
--io $ hPutStrLn stderr $ "[ST]} " ++ show w
return x
pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s
handleMessage st m
| Just (Disable tag) <- fromMessage m
, M.member tag (filters st)
= provided (currTag st == Just tag) $ disable
| Just (Enable tag) <- fromMessage m
, Just alt <- M.lookup tag (filters st)
= provided (currTag st /= Just tag) $ enable tag alt
| Just (Toggle tag) <- fromMessage m
, Just alt <- M.lookup tag (filters st)
=
if (currTag st == Just tag) then
disable
else
enable tag alt
| Just ReleaseResources <- fromMessage m
= currLayout st `unLayout` \cl -> do
--io $ hPutStrLn stderr $ "[ST]~ " ++ show st
acceptChange st fmap (handleMessage cl m)
| Just Hide <- fromMessage m
= currLayout st `unLayout` \cl -> do
--io $ hPutStrLn stderr $ "[ST]< " ++ show st
x <- acceptChange st fmap (handleMessage cl m)
--io $ hPutStrLn stderr $ "[ST]> " ++ show x
return x
| otherwise = base st `unLayout` \b -> do
x <- handleMessage b m
case x of
Nothing -> return Nothing
Just b' -> currLayout st `unLayout` \cl -> do
handleMessage cl (SomeMessage ReleaseResources)
let b'' = Layout b'
return . Just $ st{ base = b'', currLayout = currFilt st b'' }
where
enable tag alt = currLayout st `unLayout` \cl -> do
--io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st))
handleMessage cl (SomeMessage ReleaseResources)
return . Just $ st{
currTag = Just tag,
currFilt = alt,
currLayout = alt (base st) }
disable = currLayout st `unLayout` \cl -> do
--io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st)
handleMessage cl (SomeMessage ReleaseResources)
return . Just $ st{
currTag = Nothing,
currFilt = id,
currLayout = base st }
-- | Take a transformer table and a base layout, and return a
-- SwitchTrans layout.
mkSwitch :: Map String (Layout a -> Layout a) -> Layout a -> Layout a
mkSwitch fs b = Layout st
where
st = SwitchTrans{
base = b,
currTag = Nothing,
currLayout = b,
currFilt = id,
filters = fs }
provided :: Bool -> X (Maybe a) -> X (Maybe a)
provided c x
| c = x
| otherwise = return Nothing
|
