mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
f732082fdc
Typeable has been automatically derived for every type since GHC 7.10, so remove these obsolete derivations. This also allows us to get rid of the `DeriveDataTypeable` pragma quite naturally. Related: https://github.com/xmonad/xmonad/pull/299 (xmonad/xmonad@9e5b16ed8a) Related: bd5b969d9ba24236c0d5ef521c0397390dbc4b37 Fixes: https://github.com/xmonad/xmonad-contrib/issues/548
263 lines
10 KiB
Haskell
263 lines
10 KiB
Haskell
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.Fullscreen
|
|
-- 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
|
|
fullscreenSupport
|
|
,fullscreenSupportBorder
|
|
,fullscreenFull
|
|
,fullscreenFocus
|
|
,fullscreenFullRect
|
|
,fullscreenFocusRect
|
|
,fullscreenFloat
|
|
,fullscreenFloatRect
|
|
,fullscreenEventHook
|
|
,fullscreenManageHook
|
|
,fullscreenManageHookWith
|
|
,FullscreenMessage(..)
|
|
-- * Types for reference
|
|
,FullscreenFloat, FullscreenFocus, FullscreenFull
|
|
) where
|
|
|
|
import XMonad
|
|
import XMonad.Prelude
|
|
import XMonad.Layout.LayoutModifier
|
|
import XMonad.Layout.NoBorders (SmartBorder, smartBorders)
|
|
import XMonad.Hooks.EwmhDesktops (fullscreenStartup)
|
|
import XMonad.Hooks.ManageHelpers (isFullscreen)
|
|
import XMonad.Util.WindowProperties
|
|
import qualified XMonad.Util.Rectangle as R
|
|
import qualified XMonad.StackSet as W
|
|
|
|
import qualified Data.Map as M
|
|
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 def { handleEventHook = fullscreenEventHook,
|
|
-- > manageHook = fullscreenManageHook,
|
|
-- > layoutHook = myLayouts }
|
|
--
|
|
-- Now you can use layouts that respect fullscreen, for example the
|
|
-- provided 'fullscreenFull':
|
|
--
|
|
-- > myLayouts = fullscreenFull someLayout
|
|
--
|
|
|
|
-- | Modifies your config to apply basic fullscreen support -- fullscreen
|
|
-- windows when they request it. Example usage:
|
|
--
|
|
-- > main = xmonad
|
|
-- > $ fullscreenSupport
|
|
-- > $ def { ... }
|
|
fullscreenSupport :: LayoutClass l Window =>
|
|
XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
|
|
fullscreenSupport c = c {
|
|
layoutHook = fullscreenFull $ layoutHook c,
|
|
handleEventHook = handleEventHook c <+> fullscreenEventHook,
|
|
manageHook = manageHook c <+> fullscreenManageHook,
|
|
startupHook = startupHook c <+> fullscreenStartup
|
|
}
|
|
|
|
-- | fullscreenSupport with smartBorders support so the border doesn't
|
|
-- show when the window is fullscreen
|
|
--
|
|
-- > main = xmonad
|
|
-- > $ fullscreenSupportBorder
|
|
-- > $ def { ... }
|
|
fullscreenSupportBorder :: LayoutClass l Window =>
|
|
XConfig l -> XConfig (ModifiedLayout FullscreenFull
|
|
(ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))
|
|
fullscreenSupportBorder c =
|
|
fullscreenSupport c { layoutHook = smartBorders
|
|
$ fullscreenFull
|
|
$ layoutHook c
|
|
}
|
|
|
|
-- | 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
|
|
|
|
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 =
|
|
(visfulls' ++ rest', Nothing)
|
|
where (visfulls,rest) = partition (flip elem fulls . fst) list
|
|
visfulls' = map (second $ const rect') visfulls
|
|
rest' = if null visfulls'
|
|
then rest
|
|
else filter (not . R.supersetOf rect' . snd) rest
|
|
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 (not . orP (== f) (R.supersetOf rect')) 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 <$> 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
|
|
st <- get
|
|
let ws = windowset st
|
|
flt = W.floating ws
|
|
flt' = M.intersectionWith doFull fulls flt
|
|
put st {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
|
|
wmstate <- getAtom "_NET_WM_STATE"
|
|
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
|
|
wstate <- fromMaybe [] <$> getProp32 wmstate win
|
|
let isFull = fi fullsc `elem` wstate
|
|
remove = 0
|
|
add = 1
|
|
toggle = 2
|
|
chWState f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate)
|
|
when (typ == wmstate && 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 <$> 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 <$> gets windowset
|
|
sendMessageWithNoRefresh FullscreenChanged cw
|
|
idHook
|
|
|
|
-- | Applies a pair of predicates to a pair of operands, combining them with ||.
|
|
orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
|
|
orP f g (x, y) = f x || g y
|