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
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.SwitchTrans
-- Copyright : (c) Lukas Mai
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <l.mai@web.de>
-- Stability : unstable
-- Portability : unportable
--
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fglasgow-exts #-}
-- | 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.
--
-- Here's how you might use this in Config.hs:
--
-- > defaultLayouts =
-- > map (
-- > mkSwitch (M.singleton "full" (const $ noBorders full)) .
-- > mkSwitch (M.singleton "mirror" mirror)
-- > ) [ 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 $ noBorders full), ("mirror", 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 Operations
import qualified Data.Map as M
import Data.Map (Map)
-- | 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 State a = State {
base :: Layout a,
currTag :: Maybe String,
currLayout :: Layout a,
currFilt :: Layout a -> Layout a,
filters :: Map String (Layout a -> Layout a)
}
-- | 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 = switched st
where
st = State{
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
switched :: State a -> Layout a
switched
state@State{
base = b,
currTag = ct,
currLayout = cl,
currFilt = cf,
filters = fs
} = Layout {doLayout = dl, modifyLayout = ml}
where
enable tag alt = do
modifyLayout cl (SomeMessage UnDoLayout)
return . Just . switched $ state{
currTag = Just tag,
currFilt = alt,
currLayout = alt b }
disable = do
modifyLayout cl (SomeMessage UnDoLayout)
return . Just . switched $ state{
currTag = Nothing,
currFilt = id,
currLayout = b }
dl r s = do
(x, _) <- doLayout cl r s
return (x, Nothing) -- sorry Dave, I can't let you do that
ml m
| Just (Disable tag) <- fromMessage m
, M.member tag fs
= provided (ct == Just tag) $ disable
| Just (Enable tag) <- fromMessage m
, Just alt <- M.lookup tag fs
= provided (ct /= Just tag) $ enable tag alt
| Just (Toggle tag) <- fromMessage m
, Just alt <- M.lookup tag fs
=
if (ct == Just tag) then
disable
else
enable tag alt
| Just UnDoLayout <- fromMessage m
= do
modifyLayout cl m
return Nothing
| otherwise = do
x <- modifyLayout b m
case x of
Nothing -> return Nothing
Just b' -> do
modifyLayout cl (SomeMessage UnDoLayout)
return . Just $ switched state{
base = b',
currLayout = cf b' }
|
