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
|
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards, DeriveDataTypeable #-}
module FullscreenManager (
manageFullscreen,
handleFullscreen,
doFullscreen,
doFloatMaybeFullscreen,
setFullscreen,
unsetFullscreen,
setFullscreenFloat,
unsetFullscreenFloat
) where
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageHelpers (isFullscreen)
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Graphics.X11.Types (Window)
import Control.Monad
import Control.Monad.Trans
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Set as S
import qualified Data.Map as M
data SetFullscreen = SetFullscreen Window Bool Bool deriving Typeable
instance Message SetFullscreen
data FullscreenManager a = FullscreenManager (M.Map a W.RationalRect)
deriving (Show, Read)
manageFullscreen :: (LayoutClass l a) =>
l a
-> ModifiedLayout FullscreenManager l a
manageFullscreen = ModifiedLayout $ FullscreenManager M.empty
instance LayoutModifier FullscreenManager Window where
modifierDescription _ = "FullscreenManager"
handleMess (FullscreenManager wm) m
| Just (SetFullscreen win fs ff) <- fromMessage m = do
let ptype = 4
state <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
winstate <- withDisplay $ \dpy -> io $ getWindowProperty32 dpy state win
let stateset = S.fromList $ fromMaybe [] winstate
if fs then do
floats <- isFloating win
let float = if ff then True else floats
(_,loc) <- floatLocation win
let wmnew = if float then
M.union wm $ M.singleton win loc
else
wm
withDisplay $ \dpy -> io $ changeProperty32 dpy win state ptype propModeReplace $ S.toList $ S.insert (fromIntegral fullsc) stateset
fullscreenWin win
return $ Just $ FullscreenManager wmnew
else do
let float = if ff then True else M.member win wm
withDisplay $ \dpy -> io $ changeProperty32 dpy win state ptype propModeReplace $ S.toList $ S.delete (fromIntegral fullsc) stateset
if float then do
(_,defloc) <- floatLocation win
let loc = M.findWithDefault defloc win wm
floatWin win loc
else
tileWin win
return $ Just $ FullscreenManager $ M.delete win wm
handleMess _ _ = return Nothing
redoLayout (FullscreenManager wm) _ _ wrs = do
ws <- gets windowset
let wmnew = M.filterWithKey (\w _ -> M.member w $ W.floating ws) wm
return (wrs, Just $ FullscreenManager $ wmnew)
isFloating :: Window -> X Bool
isFloating w = gets windowset >>= \ws -> return $ M.member w (W.floating ws)
doFullscreen :: ManageHook
doFullscreen = Query $ do
w <- ask
lift $ setFullscreen w
return $ Endo id
doFloatMaybeFullscreen :: ManageHook
doFloatMaybeFullscreen = Query $ do
w <- ask
isFull <- lift $ runQuery isFullscreen w
lift $ if isFull then setFullscreenFloat w else unsetFullscreenFloat w
return $ Endo id
setFullscreen, unsetFullscreen, setFullscreenFloat, unsetFullscreenFloat :: Window -> X ()
setFullscreen w = sendMessage $ SetFullscreen w True False
unsetFullscreen w = sendMessage $ SetFullscreen w False False
setFullscreenFloat w = sendMessage $ SetFullscreen w True True
unsetFullscreenFloat w = sendMessage $ SetFullscreen w False True
fullscreenWin, tileWin :: Window -> X ()
fullscreenWin w = windows $ W.float w $ W.RationalRect 0 0 1 1
tileWin w = windows $ W.sink w
floatWin :: Window -> W.RationalRect -> X ()
floatWin w loc = windows $ W.float w loc
handleFullscreen :: Event -> X All
handleFullscreen (ClientMessageEvent _ _ _ _ win typ dat) = do
state <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
isFull <- runQuery isFullscreen win
-- Constants for the _NET_WM_STATE protocol
let remove = 0
add = 1
toggle = 2
action = head dat
when (typ == state && (fromIntegral fullsc) `elem` tail dat) $ do
when (action == add || (action == toggle && not isFull)) $ setFullscreen win
when (head dat == remove || (action == toggle && isFull)) $ unsetFullscreen win
return $ All True
handleFullscreen _ = return $ All True
|
