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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.Decoration
-- Copyright : (c) 2010 Audun Skaugen
-- License : BSD-style (see xmonad/LICENSE)
--
-- Maintainer : audunskaugen@gmail.com
-- Stability : unstable
-- Portability : unportable
--
-- Hooks for sending messages about fullscreen windows to layouts, and
-- a few example layout modifier that implement fullscreen windows.
-----------------------------------------------------------------------------
module XMonad.Layout.Fullscreen
( -- * Usage:
-- $usage
fullscreenFull
,fullscreenFocus
,fullscreenFullRect
,fullscreenFocusRect
,fullscreenFloat
,fullscreenFloatRect
,fullscreenEventHook
,fullscreenManageHook
,fullscreenManageHookWith
,FullscreenMessage(..)
-- * Types for reference
,FullscreenFloat, FullscreenFocus, FullscreenFull
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.Hooks.ManageHelpers (isFullscreen)
import qualified XMonad.StackSet as W
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M
import Control.Monad
import Control.Arrow (second)
-- $usage
-- Provides a ManageHook and an EventHook that sends layout messages
-- with information about fullscreening windows. This allows layouts
-- to make their own decisions about what they should to with a
-- window that requests fullscreen.
--
-- The module also includes a few layout modifiers as an illustration
-- of how such layouts should behave.
--
-- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook'
-- to your config, i.e.
--
-- > xmonad defaultconfig { eventHook = fullscreenEventHook,
-- > manageHook = fullscreenManageHook,
-- > layoutHook = myLayouts }
--
-- Now you can use layouts that respect fullscreen, for example the
-- provided 'fullscreenFull':
--
-- > myLayouts = fullscreenFull someLayout
--
-- | Messages that control the fullscreen state of the window.
-- AddFullscreen and RemoveFullscreen are sent to all layouts
-- when a window wants or no longer wants to be fullscreen.
-- FullscreenChanged is sent to the current layout after one
-- of the above have been sent.
data FullscreenMessage = AddFullscreen Window
| RemoveFullscreen Window
| FullscreenChanged
deriving (Typeable)
instance Message FullscreenMessage
data FullscreenFull a = FullscreenFull W.RationalRect [a]
deriving (Read, Show)
data FullscreenFocus a = FullscreenFocus W.RationalRect [a]
deriving (Read, Show)
data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool))
deriving (Read, Show)
instance LayoutModifier FullscreenFull Window where
pureMess ff@(FullscreenFull frect fulls) m = case fromMessage m of
Just (AddFullscreen win) -> Just $ FullscreenFull frect $ nub $ win:fulls
Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win $ fulls
Just FullscreenChanged -> Just ff
_ -> Nothing
pureModifier (FullscreenFull frect fulls) rect _ list =
(map (flip (,) rect') visfulls ++ rest, Nothing)
where visfulls = intersect fulls $ map fst list
rest = filter (flip notElem visfulls . fst) list
rect' = scaleRationalRect rect frect
instance LayoutModifier FullscreenFocus Window where
pureMess ff@(FullscreenFocus frect fulls) m = case fromMessage m of
Just (AddFullscreen win) -> Just $ FullscreenFocus frect $ nub $ win:fulls
Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win $ fulls
Just FullscreenChanged -> Just ff
_ -> Nothing
pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list
| f `elem` fulls = ((f, rect') : rest, Nothing)
| otherwise = (list, Nothing)
where rest = filter ((/= f) . fst) list
rect' = scaleRationalRect rect frect
pureModifier _ _ Nothing list = (list, Nothing)
instance LayoutModifier FullscreenFloat Window where
handleMess (FullscreenFloat frect fulls) m = case fromMessage m of
Just (AddFullscreen win) -> do
mrect <- (M.lookup win . W.floating) `fmap` gets windowset
return $ case mrect of
Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls
Nothing -> Nothing
Just (RemoveFullscreen win) ->
return $ Just $ FullscreenFloat frect $ M.adjust (second $ const False) win fulls
-- Modify the floating member of the stack set directly; this is the hackish part.
Just FullscreenChanged -> do
state <- get
let ws = windowset state
flt = W.floating ws
flt' = M.intersectionWith doFull fulls flt
put state {windowset = ws {W.floating = M.union flt' flt}}
return $ Just $ FullscreenFloat frect $ M.filter snd fulls
where doFull (_, True) _ = frect
doFull (rect, False) _ = rect
Nothing -> return Nothing
-- | Layout modifier that makes fullscreened window fill the
-- entire screen.
fullscreenFull :: LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull = fullscreenFullRect $ W.RationalRect 0 0 1 1
-- | As above, but the fullscreened window will fill the
-- specified rectangle instead of the entire screen.
fullscreenFullRect :: LayoutClass l a =>
W.RationalRect -> l a -> ModifiedLayout FullscreenFull l a
fullscreenFullRect r = ModifiedLayout $ FullscreenFull r []
-- | Layout modifier that makes the fullscreened window fill
-- the entire screen only if it is currently focused.
fullscreenFocus :: LayoutClass l a =>
l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocus = fullscreenFocusRect $ W.RationalRect 0 0 1 1
-- | As above, but the fullscreened window will fill the
-- specified rectangle instead of the entire screen.
fullscreenFocusRect :: LayoutClass l a =>
W.RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocusRect r = ModifiedLayout $ FullscreenFocus r []
-- | Hackish layout modifier that makes floating fullscreened
-- windows fill the entire screen.
fullscreenFloat :: LayoutClass l a =>
l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloat = fullscreenFloatRect $ W.RationalRect 0 0 1 1
-- | As above, but the fullscreened window will fill the
-- specified rectangle instead of the entire screen.
fullscreenFloatRect :: LayoutClass l a =>
W.RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloatRect r = ModifiedLayout $ FullscreenFloat r M.empty
-- | The event hook required for the layout modifiers to work
fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
state <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
wstate <- fromMaybe [] `fmap` getProp32 state win
let fi :: (Integral i, Num n) => i -> n
fi = fromIntegral
isFull = fi fullsc `elem` wstate
remove = 0
add = 1
toggle = 2
ptype = 4
chWState f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)
when (typ == state && fi fullsc `elem` dats) $ do
when (action == add || (action == toggle && not isFull)) $ do
chWState (fi fullsc:)
broadcastMessage $ AddFullscreen win
sendMessage FullscreenChanged
when (action == remove || (action == toggle && isFull)) $ do
chWState $ delete (fi fullsc)
broadcastMessage $ RemoveFullscreen win
sendMessage FullscreenChanged
return $ All True
fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do
-- When a window is destroyed, the layouts should remove that window
-- from their states.
broadcastMessage $ RemoveFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset
sendMessageWithNoRefresh FullscreenChanged cw
return $ All True
fullscreenEventHook _ = return $ All True
-- | Manage hook that sets the fullscreen property for
-- windows that are initially fullscreen
fullscreenManageHook :: ManageHook
fullscreenManageHook = fullscreenManageHook' isFullscreen
-- | A version of fullscreenManageHook that lets you specify
-- your own query to decide whether a window should be fullscreen.
fullscreenManageHookWith :: Query Bool -> ManageHook
fullscreenManageHookWith h = fullscreenManageHook' $ isFullscreen <||> h
fullscreenManageHook' :: Query Bool -> ManageHook
fullscreenManageHook' isFull = isFull --> do
w <- ask
liftX $ do
broadcastMessage $ AddFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset
sendMessageWithNoRefresh FullscreenChanged cw
idHook
|
