{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME: fullscreenStartup temporarily silenced
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Fullscreen
-- Description :  Send messages about fullscreen windows to layouts.
-- 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 :: forall (l :: * -> *).
LayoutClass l Window =>
XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
fullscreenSupport XConfig l
c = XConfig l
c {
    layoutHook :: ModifiedLayout FullscreenFull l Window
layoutHook = forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> l Window
layoutHook XConfig l
c,
    handleEventHook :: Event -> X All
handleEventHook = forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook XConfig l
c forall a. Semigroup a => a -> a -> a
<> Event -> X All
fullscreenEventHook,
    manageHook :: Query (Endo WindowSet)
manageHook = forall (l :: * -> *). XConfig l -> Query (Endo WindowSet)
manageHook XConfig l
c forall a. Semigroup a => a -> a -> a
<> Query (Endo WindowSet)
fullscreenManageHook,
    startupHook :: X ()
startupHook = forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig l
c forall a. Semigroup a => a -> a -> a
<> X ()
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 :: forall (l :: * -> *).
LayoutClass l Window =>
XConfig l
-> XConfig
     (ModifiedLayout
        FullscreenFull
        (ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))
fullscreenSupportBorder XConfig l
c =
    forall (l :: * -> *).
LayoutClass l Window =>
XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
fullscreenSupport XConfig l
c { layoutHook :: ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l) Window
layoutHook = forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout SmartBorder l a
smartBorders
                                       forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull
                                       forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> l Window
layoutHook XConfig l
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 (ReadPrec [FullscreenFull a]
ReadPrec (FullscreenFull a)
ReadS [FullscreenFull a]
forall a. Read a => ReadPrec [FullscreenFull a]
forall a. Read a => ReadPrec (FullscreenFull a)
forall a. Read a => Int -> ReadS (FullscreenFull a)
forall a. Read a => ReadS [FullscreenFull a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FullscreenFull a]
$creadListPrec :: forall a. Read a => ReadPrec [FullscreenFull a]
readPrec :: ReadPrec (FullscreenFull a)
$creadPrec :: forall a. Read a => ReadPrec (FullscreenFull a)
readList :: ReadS [FullscreenFull a]
$creadList :: forall a. Read a => ReadS [FullscreenFull a]
readsPrec :: Int -> ReadS (FullscreenFull a)
$creadsPrec :: forall a. Read a => Int -> ReadS (FullscreenFull a)
Read, Int -> FullscreenFull a -> ShowS
forall a. Show a => Int -> FullscreenFull a -> ShowS
forall a. Show a => [FullscreenFull a] -> ShowS
forall a. Show a => FullscreenFull a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullscreenFull a] -> ShowS
$cshowList :: forall a. Show a => [FullscreenFull a] -> ShowS
show :: FullscreenFull a -> String
$cshow :: forall a. Show a => FullscreenFull a -> String
showsPrec :: Int -> FullscreenFull a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FullscreenFull a -> ShowS
Show)

data FullscreenFocus a = FullscreenFocus W.RationalRect [a]
     deriving (ReadPrec [FullscreenFocus a]
ReadPrec (FullscreenFocus a)
ReadS [FullscreenFocus a]
forall a. Read a => ReadPrec [FullscreenFocus a]
forall a. Read a => ReadPrec (FullscreenFocus a)
forall a. Read a => Int -> ReadS (FullscreenFocus a)
forall a. Read a => ReadS [FullscreenFocus a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FullscreenFocus a]
$creadListPrec :: forall a. Read a => ReadPrec [FullscreenFocus a]
readPrec :: ReadPrec (FullscreenFocus a)
$creadPrec :: forall a. Read a => ReadPrec (FullscreenFocus a)
readList :: ReadS [FullscreenFocus a]
$creadList :: forall a. Read a => ReadS [FullscreenFocus a]
readsPrec :: Int -> ReadS (FullscreenFocus a)
$creadsPrec :: forall a. Read a => Int -> ReadS (FullscreenFocus a)
Read, Int -> FullscreenFocus a -> ShowS
forall a. Show a => Int -> FullscreenFocus a -> ShowS
forall a. Show a => [FullscreenFocus a] -> ShowS
forall a. Show a => FullscreenFocus a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullscreenFocus a] -> ShowS
$cshowList :: forall a. Show a => [FullscreenFocus a] -> ShowS
show :: FullscreenFocus a -> String
$cshow :: forall a. Show a => FullscreenFocus a -> String
showsPrec :: Int -> FullscreenFocus a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FullscreenFocus a -> ShowS
Show)

data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool))
     deriving (ReadPrec [FullscreenFloat a]
ReadPrec (FullscreenFloat a)
ReadS [FullscreenFloat a]
forall a. (Ord a, Read a) => ReadPrec [FullscreenFloat a]
forall a. (Ord a, Read a) => ReadPrec (FullscreenFloat a)
forall a. (Ord a, Read a) => Int -> ReadS (FullscreenFloat a)
forall a. (Ord a, Read a) => ReadS [FullscreenFloat a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FullscreenFloat a]
$creadListPrec :: forall a. (Ord a, Read a) => ReadPrec [FullscreenFloat a]
readPrec :: ReadPrec (FullscreenFloat a)
$creadPrec :: forall a. (Ord a, Read a) => ReadPrec (FullscreenFloat a)
readList :: ReadS [FullscreenFloat a]
$creadList :: forall a. (Ord a, Read a) => ReadS [FullscreenFloat a]
readsPrec :: Int -> ReadS (FullscreenFloat a)
$creadsPrec :: forall a. (Ord a, Read a) => Int -> ReadS (FullscreenFloat a)
Read, Int -> FullscreenFloat a -> ShowS
forall a. Show a => Int -> FullscreenFloat a -> ShowS
forall a. Show a => [FullscreenFloat a] -> ShowS
forall a. Show a => FullscreenFloat a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullscreenFloat a] -> ShowS
$cshowList :: forall a. Show a => [FullscreenFloat a] -> ShowS
show :: FullscreenFloat a -> String
$cshow :: forall a. Show a => FullscreenFloat a -> String
showsPrec :: Int -> FullscreenFloat a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FullscreenFloat a -> ShowS
Show)

instance LayoutModifier FullscreenFull Window where
  pureMess :: FullscreenFull Window
-> SomeMessage -> Maybe (FullscreenFull Window)
pureMess ff :: FullscreenFull Window
ff@(FullscreenFull RationalRect
frect [Window]
fulls) SomeMessage
m = case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
    Just (AddFullscreen Window
win) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
frect forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ Window
winforall a. a -> [a] -> [a]
:[Window]
fulls
    Just (RemoveFullscreen Window
win) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
frect forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete Window
win [Window]
fulls
    Just FullscreenMessage
FullscreenChanged -> forall a. a -> Maybe a
Just FullscreenFull Window
ff
    Maybe FullscreenMessage
_ -> forall a. Maybe a
Nothing

  pureModifier :: FullscreenFull Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (FullscreenFull Window))
pureModifier (FullscreenFull RationalRect
frect [Window]
fulls) Rectangle
rect Maybe (Stack Window)
_ [(Window, Rectangle)]
list =
    ([(Window, Rectangle)]
visfulls' forall a. [a] -> [a] -> [a]
++ [(Window, Rectangle)]
rest', forall a. Maybe a
Nothing)
    where ([(Window, Rectangle)]
visfulls,[(Window, Rectangle)]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Window]
fulls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
list
          visfulls' :: [(Window, Rectangle)]
visfulls' = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Rectangle
rect') [(Window, Rectangle)]
visfulls
          rest' :: [(Window, Rectangle)]
rest' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Window, Rectangle)]
visfulls'
                  then [(Window, Rectangle)]
rest
                  else forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle -> Bool
R.supersetOf Rectangle
rect' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Window, Rectangle)]
rest
          rect' :: Rectangle
rect' = Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
rect RationalRect
frect

instance LayoutModifier FullscreenFocus Window where
  pureMess :: FullscreenFocus Window
-> SomeMessage -> Maybe (FullscreenFocus Window)
pureMess ff :: FullscreenFocus Window
ff@(FullscreenFocus RationalRect
frect [Window]
fulls) SomeMessage
m = case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
    Just (AddFullscreen Window
win) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
frect forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ Window
winforall a. a -> [a] -> [a]
:[Window]
fulls
    Just (RemoveFullscreen Window
win) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
frect forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete Window
win [Window]
fulls
    Just FullscreenMessage
FullscreenChanged -> forall a. a -> Maybe a
Just FullscreenFocus Window
ff
    Maybe FullscreenMessage
_ -> forall a. Maybe a
Nothing

  pureModifier :: FullscreenFocus Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (FullscreenFocus Window))
pureModifier (FullscreenFocus RationalRect
frect [Window]
fulls) Rectangle
rect (Just W.Stack {focus :: forall a. Stack a -> a
W.focus = Window
f}) [(Window, Rectangle)]
list
     | Window
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
fulls = ((Window
f, Rectangle
rect') forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
rest, forall a. Maybe a
Nothing)
     | Bool
otherwise = ([(Window, Rectangle)]
list, forall a. Maybe a
Nothing)
     where rest :: [(Window, Rectangle)]
rest = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP (forall a. Eq a => a -> a -> Bool
== Window
f) (Rectangle -> Rectangle -> Bool
R.supersetOf Rectangle
rect')) [(Window, Rectangle)]
list
           rect' :: Rectangle
rect' = Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
rect RationalRect
frect
  pureModifier FullscreenFocus Window
_ Rectangle
_ Maybe (Stack Window)
Nothing [(Window, Rectangle)]
list = ([(Window, Rectangle)]
list, forall a. Maybe a
Nothing)

instance LayoutModifier FullscreenFloat Window where
  handleMess :: FullscreenFloat Window
-> SomeMessage -> X (Maybe (FullscreenFloat Window))
handleMess (FullscreenFloat RationalRect
frect Map Window (RationalRect, Bool)
fulls) SomeMessage
m = case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
    Just (AddFullscreen Window
win) -> do
      Maybe RationalRect
mrect <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe RationalRect
mrect of
        Just RationalRect
rect -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
win (RationalRect
rect,Bool
True) Map Window (RationalRect, Bool)
fulls
        Maybe RationalRect
Nothing -> forall a. Maybe a
Nothing

    Just (RemoveFullscreen Window
win) ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
False) Window
win Map Window (RationalRect, Bool)
fulls

    -- Modify the floating member of the stack set directly; this is the hackish part.
    Just FullscreenMessage
FullscreenChanged -> do
      XState
st <- forall s (m :: * -> *). MonadState s m => m s
get
      let ws :: WindowSet
ws = XState -> WindowSet
windowset XState
st
          flt :: Map Window RationalRect
flt = forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws
          flt' :: Map Window RationalRect
flt' = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith forall {p}. (RationalRect, Bool) -> p -> RationalRect
doFull Map Window (RationalRect, Bool)
fulls Map Window RationalRect
flt
      forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st {windowset :: WindowSet
windowset = WindowSet
ws {floating :: Map Window RationalRect
W.floating = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Window RationalRect
flt' Map Window RationalRect
flt}}
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter forall a b. (a, b) -> b
snd Map Window (RationalRect, Bool)
fulls
      where doFull :: (RationalRect, Bool) -> p -> RationalRect
doFull (RationalRect
_, Bool
True) p
_ = RationalRect
frect
            doFull (RationalRect
rect, Bool
False) p
_ = RationalRect
rect

    Maybe FullscreenMessage
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Layout modifier that makes fullscreened window fill the
-- entire screen.
fullscreenFull :: LayoutClass l a =>
  l a -> ModifiedLayout FullscreenFull l a
fullscreenFull :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull = forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFull l a
fullscreenFullRect forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
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 :: forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFull l a
fullscreenFullRect RationalRect
r = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a b. (a -> b) -> a -> b
$ forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
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 :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocus = forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocusRect forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
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 :: forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocusRect RationalRect
r = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a b. (a -> b) -> a -> b
$ forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
r []

-- | Hackish layout modifier that makes floating fullscreened
-- windows fill the entire screen.
fullscreenFloat :: LayoutClass l a =>
  l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloat :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloat = forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloatRect forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
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 :: forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloatRect RationalRect
r = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a b. (a -> b) -> a -> b
$ forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
r forall k a. Map k a
M.empty

-- | The event hook required for the layout modifiers to work
fullscreenEventHook :: Event -> X All
fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent EventType
_ CULong
_ Bool
_ Display
dpy Window
win Window
typ (CInt
action:[CInt]
dats)) = do
  Window
wmstate <- String -> X Window
getAtom String
"_NET_WM_STATE"
  Window
fullsc <- String -> X Window
getAtom String
"_NET_WM_STATE_FULLSCREEN"
  [CLong]
wstate <- forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> Window -> X (Maybe [CLong])
getProp32 Window
wmstate Window
win
  let isFull :: Bool
isFull = forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
wstate
      remove :: CInt
remove = CInt
0
      add :: CInt
add = CInt
1
      toggle :: CInt
toggle = CInt
2
      chWState :: ([CLong] -> [CLong]) -> m ()
chWState [CLong] -> [CLong]
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
win Window
wmstate Window
aTOM CInt
propModeReplace ([CLong] -> [CLong]
f [CLong]
wstate)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
typ forall a. Eq a => a -> a -> Bool
== Window
wmstate Bool -> Bool -> Bool
&& forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt]
dats) forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
add Bool -> Bool -> Bool
|| (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isFull)) forall a b. (a -> b) -> a -> b
$ do
      forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWState (forall a b. (Integral a, Num b) => a -> b
fi Window
fullscforall a. a -> [a] -> [a]
:)
      forall a. Message a => a -> X ()
broadcastMessage forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
AddFullscreen Window
win
      forall a. Message a => a -> X ()
sendMessage FullscreenMessage
FullscreenChanged
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
remove Bool -> Bool -> Bool
|| (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool
isFull)) forall a b. (a -> b) -> a -> b
$ do
      forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWState forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete (forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc)
      forall a. Message a => a -> X ()
broadcastMessage forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
RemoveFullscreen Window
win
      forall a. Message a => a -> X ()
sendMessage FullscreenMessage
FullscreenChanged
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

fullscreenEventHook DestroyWindowEvent{ev_window :: Event -> Window
ev_window = Window
w} = do
  -- When a window is destroyed, the layouts should remove that window
  -- from their states.
  forall a. Message a => a -> X ()
broadcastMessage forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
RemoveFullscreen Window
w
  Workspace String (Layout Window) Window
cw <- forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh FullscreenMessage
FullscreenChanged Workspace String (Layout Window) Window
cw
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

fullscreenEventHook Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

-- | Manage hook that sets the fullscreen property for
-- windows that are initially fullscreen
fullscreenManageHook :: ManageHook
fullscreenManageHook :: Query (Endo WindowSet)
fullscreenManageHook = Query Bool -> Query (Endo WindowSet)
fullscreenManageHook' Query Bool
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 :: Query Bool -> Query (Endo WindowSet)
fullscreenManageHookWith Query Bool
h = Query Bool -> Query (Endo WindowSet)
fullscreenManageHook' forall a b. (a -> b) -> a -> b
$ Query Bool
isFullscreen forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Query Bool
h

fullscreenManageHook' :: Query Bool -> ManageHook
fullscreenManageHook' :: Query Bool -> Query (Endo WindowSet)
fullscreenManageHook' Query Bool
isFull = Query Bool
isFull forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> do
  Window
w <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ do
    forall a. Message a => a -> X ()
broadcastMessage forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
AddFullscreen Window
w
    Workspace String (Layout Window) Window
cw <- forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh FullscreenMessage
FullscreenChanged Workspace String (Layout Window) Window
cw
  forall m. Monoid m => m
idHook

-- | Applies a pair of predicates to a pair of operands, combining them with ||.
orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP :: forall a b. (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP a -> Bool
f b -> Bool
g (a
x, b
y) = a -> Bool
f a
x Bool -> Bool -> Bool
|| b -> Bool
g b
y