{-# 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 = 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 :: forall (l :: * -> *).
LayoutClass l Window =>
XConfig l
-> XConfig
     (ModifiedLayout
        FullscreenFull
        (ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))
fullscreenSupportBorder XConfig l
c =
    XConfig
  (ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l))
-> XConfig
     (ModifiedLayout
        FullscreenFull
        (ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))
forall (l :: * -> *).
LayoutClass l Window =>
XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
fullscreenSupport XConfig l
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 (ReadPrec [FullscreenFull a]
ReadPrec (FullscreenFull a)
Int -> ReadS (FullscreenFull a)
ReadS [FullscreenFull a]
(Int -> ReadS (FullscreenFull a))
-> ReadS [FullscreenFull a]
-> ReadPrec (FullscreenFull a)
-> ReadPrec [FullscreenFull a]
-> Read (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
$creadsPrec :: forall a. Read a => Int -> ReadS (FullscreenFull a)
readsPrec :: Int -> ReadS (FullscreenFull a)
$creadList :: forall a. Read a => ReadS [FullscreenFull a]
readList :: ReadS [FullscreenFull a]
$creadPrec :: forall a. Read a => ReadPrec (FullscreenFull a)
readPrec :: ReadPrec (FullscreenFull a)
$creadListPrec :: forall a. Read a => ReadPrec [FullscreenFull a]
readListPrec :: ReadPrec [FullscreenFull a]
Read, Int -> FullscreenFull a -> ShowS
[FullscreenFull a] -> ShowS
FullscreenFull a -> String
(Int -> FullscreenFull a -> ShowS)
-> (FullscreenFull a -> String)
-> ([FullscreenFull a] -> ShowS)
-> Show (FullscreenFull a)
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
$cshowsPrec :: forall a. Show a => Int -> FullscreenFull a -> ShowS
showsPrec :: Int -> FullscreenFull a -> ShowS
$cshow :: forall a. Show a => FullscreenFull a -> String
show :: FullscreenFull a -> String
$cshowList :: forall a. Show a => [FullscreenFull a] -> ShowS
showList :: [FullscreenFull a] -> ShowS
Show)

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

data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool))
     deriving (ReadPrec [FullscreenFloat a]
ReadPrec (FullscreenFloat a)
Int -> ReadS (FullscreenFloat a)
ReadS [FullscreenFloat a]
(Int -> ReadS (FullscreenFloat a))
-> ReadS [FullscreenFloat a]
-> ReadPrec (FullscreenFloat a)
-> ReadPrec [FullscreenFloat a]
-> Read (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
$creadsPrec :: forall a. (Ord a, Read a) => Int -> ReadS (FullscreenFloat a)
readsPrec :: Int -> ReadS (FullscreenFloat a)
$creadList :: forall a. (Ord a, Read a) => ReadS [FullscreenFloat a]
readList :: ReadS [FullscreenFloat a]
$creadPrec :: forall a. (Ord a, Read a) => ReadPrec (FullscreenFloat a)
readPrec :: ReadPrec (FullscreenFloat a)
$creadListPrec :: forall a. (Ord a, Read a) => ReadPrec [FullscreenFloat a]
readListPrec :: ReadPrec [FullscreenFloat a]
Read, Int -> FullscreenFloat a -> ShowS
[FullscreenFloat a] -> ShowS
FullscreenFloat a -> String
(Int -> FullscreenFloat a -> ShowS)
-> (FullscreenFloat a -> String)
-> ([FullscreenFloat a] -> ShowS)
-> Show (FullscreenFloat a)
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
$cshowsPrec :: forall a. Show a => Int -> FullscreenFloat a -> ShowS
showsPrec :: Int -> FullscreenFloat a -> ShowS
$cshow :: forall a. Show a => FullscreenFloat a -> String
show :: FullscreenFloat a -> String
$cshowList :: forall a. Show a => [FullscreenFloat a] -> ShowS
showList :: [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 SomeMessage -> Maybe FullscreenMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
    Just (AddFullscreen Window
win) -> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a. a -> Maybe a
Just (FullscreenFull Window -> Maybe (FullscreenFull Window))
-> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFull Window
forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
frect ([Window] -> FullscreenFull Window)
-> [Window] -> FullscreenFull Window
forall a b. (a -> b) -> a -> b
$ [Window] -> [Window]
forall a. Eq a => [a] -> [a]
nub ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Window
winWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
fulls
    Just (RemoveFullscreen Window
win) -> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a. a -> Maybe a
Just (FullscreenFull Window -> Maybe (FullscreenFull Window))
-> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFull Window
forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
frect ([Window] -> FullscreenFull Window)
-> [Window] -> FullscreenFull Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete Window
win [Window]
fulls
    Just FullscreenMessage
FullscreenChanged -> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a. a -> Maybe a
Just FullscreenFull Window
ff
    Maybe FullscreenMessage
_ -> Maybe (FullscreenFull Window)
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' [(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [(Window, Rectangle)]
rest', Maybe (FullscreenFull Window)
forall a. Maybe a
Nothing)
    where ([(Window, Rectangle)]
visfulls,[(Window, Rectangle)]
rest) = ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], [(Window, Rectangle)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Window -> [Window] -> Bool) -> [Window] -> Window -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Window]
fulls (Window -> Bool)
-> ((Window, Rectangle) -> Window) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
list
          visfulls' :: [(Window, Rectangle)]
visfulls' = ((Window, Rectangle) -> (Window, Rectangle))
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rectangle -> Rectangle)
-> (Window, Rectangle) -> (Window, Rectangle)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Rectangle -> Rectangle)
 -> (Window, Rectangle) -> (Window, Rectangle))
-> (Rectangle -> Rectangle)
-> (Window, Rectangle)
-> (Window, Rectangle)
forall a b. (a -> b) -> a -> b
$ Rectangle -> Rectangle -> Rectangle
forall a b. a -> b -> a
const Rectangle
rect') [(Window, Rectangle)]
visfulls
          rest' :: [(Window, Rectangle)]
rest' = if [(Window, Rectangle)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Window, Rectangle)]
visfulls'
                  then [(Window, Rectangle)]
rest
                  else ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Window, Rectangle) -> Bool) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle -> Bool
R.supersetOf Rectangle
rect' (Rectangle -> Bool)
-> ((Window, Rectangle) -> Rectangle)
-> (Window, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Rectangle
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 SomeMessage -> Maybe FullscreenMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
    Just (AddFullscreen Window
win) -> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a. a -> Maybe a
Just (FullscreenFocus Window -> Maybe (FullscreenFocus Window))
-> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFocus Window
forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
frect ([Window] -> FullscreenFocus Window)
-> [Window] -> FullscreenFocus Window
forall a b. (a -> b) -> a -> b
$ [Window] -> [Window]
forall a. Eq a => [a] -> [a]
nub ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Window
winWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
fulls
    Just (RemoveFullscreen Window
win) -> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a. a -> Maybe a
Just (FullscreenFocus Window -> Maybe (FullscreenFocus Window))
-> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFocus Window
forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
frect ([Window] -> FullscreenFocus Window)
-> [Window] -> FullscreenFocus Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete Window
win [Window]
fulls
    Just FullscreenMessage
FullscreenChanged -> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a. a -> Maybe a
Just FullscreenFocus Window
ff
    Maybe FullscreenMessage
_ -> Maybe (FullscreenFocus Window)
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 Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
fulls = ((Window
f, Rectangle
rect') (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
rest, Maybe (FullscreenFocus Window)
forall a. Maybe a
Nothing)
     | Bool
otherwise = ([(Window, Rectangle)]
list, Maybe (FullscreenFocus Window)
forall a. Maybe a
Nothing)
     where rest :: [(Window, Rectangle)]
rest = ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Window, Rectangle) -> Bool) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Bool)
-> (Rectangle -> Bool) -> (Window, Rectangle) -> Bool
forall a b. (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP (Window -> Window -> Bool
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, Maybe (FullscreenFocus Window)
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 SomeMessage -> Maybe FullscreenMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
    Just (AddFullscreen Window
win) -> do
      Maybe RationalRect
mrect <- Window -> Map Window RationalRect -> Maybe RationalRect
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win (Map Window RationalRect -> Maybe RationalRect)
-> (WindowSet -> Map Window RationalRect)
-> WindowSet
-> Maybe RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> Maybe RationalRect)
-> X WindowSet -> X (Maybe RationalRect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
      Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FullscreenFloat Window)
 -> X (Maybe (FullscreenFloat Window)))
-> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a b. (a -> b) -> a -> b
$ case Maybe RationalRect
mrect of
        Just RationalRect
rect -> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a. a -> Maybe a
Just (FullscreenFloat Window -> Maybe (FullscreenFloat Window))
-> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a b. (a -> b) -> a -> b
$ RationalRect
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect (Map Window (RationalRect, Bool) -> FullscreenFloat Window)
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a b. (a -> b) -> a -> b
$ Window
-> (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
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 -> Maybe (FullscreenFloat Window)
forall a. Maybe a
Nothing

    Just (RemoveFullscreen Window
win) ->
      Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FullscreenFloat Window)
 -> X (Maybe (FullscreenFloat Window)))
-> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a b. (a -> b) -> a -> b
$ FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a. a -> Maybe a
Just (FullscreenFloat Window -> Maybe (FullscreenFloat Window))
-> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a b. (a -> b) -> a -> b
$ RationalRect
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect (Map Window (RationalRect, Bool) -> FullscreenFloat Window)
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a b. (a -> b) -> a -> b
$ ((RationalRect, Bool) -> (RationalRect, Bool))
-> Window
-> Map Window (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Bool -> Bool) -> (RationalRect, Bool) -> (RationalRect, Bool)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Bool -> Bool) -> (RationalRect, Bool) -> (RationalRect, Bool))
-> (Bool -> Bool) -> (RationalRect, Bool) -> (RationalRect, Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
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 <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
      let ws :: WindowSet
ws = XState -> WindowSet
windowset XState
st
          flt :: Map Window RationalRect
flt = WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws
          flt' :: Map Window RationalRect
flt' = ((RationalRect, Bool) -> RationalRect -> RationalRect)
-> Map Window (RationalRect, Bool)
-> Map Window RationalRect
-> Map Window RationalRect
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith (RationalRect, Bool) -> RationalRect -> RationalRect
forall {p}. (RationalRect, Bool) -> p -> RationalRect
doFull Map Window (RationalRect, Bool)
fulls Map Window RationalRect
flt
      XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st {windowset = ws {W.floating = M.union flt' flt}}
      Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FullscreenFloat Window)
 -> X (Maybe (FullscreenFloat Window)))
-> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a b. (a -> b) -> a -> b
$ FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a. a -> Maybe a
Just (FullscreenFloat Window -> Maybe (FullscreenFloat Window))
-> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a b. (a -> b) -> a -> b
$ RationalRect
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect (Map Window (RationalRect, Bool) -> FullscreenFloat Window)
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a b. (a -> b) -> a -> b
$ ((RationalRect, Bool) -> Bool)
-> Map Window (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (RationalRect, Bool) -> Bool
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 -> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FullscreenFloat Window)
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 = RationalRect -> l a -> ModifiedLayout FullscreenFull l a
forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFull l a
fullscreenFullRect (RationalRect -> l a -> ModifiedLayout FullscreenFull l a)
-> RationalRect -> l a -> ModifiedLayout FullscreenFull l a
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 = FullscreenFull a -> l a -> ModifiedLayout FullscreenFull l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FullscreenFull a -> l a -> ModifiedLayout FullscreenFull l a)
-> FullscreenFull a -> l a -> ModifiedLayout FullscreenFull l a
forall a b. (a -> b) -> a -> b
$ RationalRect -> [a] -> FullscreenFull a
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 = RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocusRect (RationalRect -> l a -> ModifiedLayout FullscreenFocus l a)
-> RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
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 = FullscreenFocus a -> l a -> ModifiedLayout FullscreenFocus l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FullscreenFocus a -> l a -> ModifiedLayout FullscreenFocus l a)
-> FullscreenFocus a -> l a -> ModifiedLayout FullscreenFocus l a
forall a b. (a -> b) -> a -> b
$ RationalRect -> [a] -> FullscreenFocus a
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 = RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloatRect (RationalRect -> l a -> ModifiedLayout FullscreenFloat l a)
-> RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
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 = FullscreenFloat a -> l a -> ModifiedLayout FullscreenFloat l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FullscreenFloat a -> l a -> ModifiedLayout FullscreenFloat l a)
-> FullscreenFloat a -> l a -> ModifiedLayout FullscreenFloat l a
forall a b. (a -> b) -> a -> b
$ RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
r Map a (RationalRect, Bool)
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 <- [CLong] -> Maybe [CLong] -> [CLong]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [CLong] -> [CLong]) -> X (Maybe [CLong]) -> X [CLong]
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 = Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc CLong -> [CLong] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
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)
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
typ Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
wmstate Bool -> Bool -> Bool
&& Window -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc CInt -> [CInt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt]
dats) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
add Bool -> Bool -> Bool
|| (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isFull)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      ([CLong] -> [CLong]) -> X ()
forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWState (Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
fullscCLong -> [CLong] -> [CLong]
forall a. a -> [a] -> [a]
:)
      FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
AddFullscreen Window
win
      FullscreenMessage -> X ()
forall a. Message a => a -> X ()
sendMessage FullscreenMessage
FullscreenChanged
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
remove Bool -> Bool -> Bool
|| (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool
isFull)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      ([CLong] -> [CLong]) -> X ()
forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWState (([CLong] -> [CLong]) -> X ()) -> ([CLong] -> [CLong]) -> X ()
forall a b. (a -> b) -> a -> b
$ CLong -> [CLong] -> [CLong]
forall a. Eq a => a -> [a] -> [a]
delete (Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc)
      FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
RemoveFullscreen Window
win
      FullscreenMessage -> X ()
forall a. Message a => a -> X ()
sendMessage FullscreenMessage
FullscreenChanged
  All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
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.
  FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
RemoveFullscreen Window
w
  Workspace String (Layout Window) Window
cw <- Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet -> Workspace String (Layout Window) Window)
-> X WindowSet -> X (Workspace String (Layout Window) Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  FullscreenMessage
-> Workspace String (Layout Window) Window -> X ()
forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh FullscreenMessage
FullscreenChanged Workspace String (Layout Window) Window
cw
  All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

fullscreenEventHook Event
_ = All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
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' (Query Bool -> Query (Endo WindowSet))
-> Query Bool -> Query (Endo WindowSet)
forall a b. (a -> b) -> a -> b
$ Query Bool
isFullscreen Query Bool -> Query Bool -> Query Bool
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 Query Bool -> Query (Endo WindowSet) -> Query (Endo WindowSet)
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> do
  Window
w <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  X () -> Query ()
forall a. X a -> Query a
liftX (X () -> Query ()) -> X () -> Query ()
forall a b. (a -> b) -> a -> b
$ do
    FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
AddFullscreen Window
w
    Workspace String (Layout Window) Window
cw <- Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet -> Workspace String (Layout Window) Window)
-> X WindowSet -> X (Workspace String (Layout Window) Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    FullscreenMessage
-> Workspace String (Layout Window) Window -> X ()
forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh FullscreenMessage
FullscreenChanged Workspace String (Layout Window) Window
cw
  Query (Endo WindowSet)
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