{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
-- --------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Operations
-- Copyright   :  (c) Spencer Janssen 2007
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  dons@cse.unsw.edu.au
-- Stability   :  unstable
-- Portability :  not portable, mtl, posix
--
-- Operations. A module for functions that don't cleanly fit anywhere else.
--
-----------------------------------------------------------------------------

module XMonad.Operations (
    -- * Manage One Window
    manage, unmanage, killWindow, kill, isClient,
    setInitialProperties, setWMState, setWindowBorderWithFallback,
    hide, reveal, tileWindow,
    setTopFocus, focus,

    -- * Manage Windows
    windows, refresh, rescreen, modifyWindowSet, windowBracket, windowBracket_, clearEvents, getCleanedScreenInfo,
    withFocused, withUnfocused,

    -- * Keyboard and Mouse
    cleanMask, extraModifiers,
    mouseDrag, mouseMoveWindow, mouseResizeWindow,
    setButtonGrab, setFocusX,

    -- * Messages
    sendMessage, broadcastMessage, sendMessageWithNoRefresh,

    -- * Save and Restore State
    StateFile (..), writeStateToFile, readStateFile, restart,

    -- * Floating Layer
    float, floatLocation,

    -- * Window Size Hints
    D, mkAdjust, applySizeHints, applySizeHints', applySizeHintsContents,
    applyAspectHint, applyResizeIncHint, applyMaxSizeHint,

    -- * Rectangles
    containedIn, nubScreens, pointWithin, scaleRationalRect,

    -- * Other Utilities
    initColor, pointScreen, screenWorkspace,
    setLayout, updateLayout,
    ) where

import XMonad.Core
import XMonad.Layout (Full(..))
import qualified XMonad.StackSet as W

import Data.Maybe
import Data.Monoid          (Endo(..),Any(..))
import Data.List            (nub, (\\), find)
import Data.Bits            ((.|.), (.&.), complement, testBit)
import Data.Function        (on)
import Data.Ratio
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Arrow (second)
import Control.Monad.Reader
import Control.Monad.State
import qualified Control.Exception as C

import System.IO
import System.Directory
import System.Posix.Process (executeFile)
import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo)
import Graphics.X11.Xlib.Extras

-- ---------------------------------------------------------------------
-- Window manager operations

-- |
-- Add a new window to be managed in the current workspace.
-- Bring it into focus.
--
-- Whether the window is already managed, or not, it is mapped, has its
-- border set, and its event mask set.
--
manage :: Window -> X ()
manage :: Window -> X ()
manage Window
w = X Bool -> X () -> X ()
whenX (Bool -> Bool
not (Bool -> Bool) -> X Bool -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X Bool
isClient Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    SizeHints
sh <- IO SizeHints -> X SizeHints
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO SizeHints -> X SizeHints) -> IO SizeHints -> X SizeHints
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO SizeHints
getWMNormalHints Display
d Window
w

    let isFixedSize :: Bool
isFixedSize = SizeHints -> Maybe (Dimension, Dimension)
sh_min_size SizeHints
sh Maybe (Dimension, Dimension)
-> Maybe (Dimension, Dimension) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Dimension, Dimension)
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& SizeHints -> Maybe (Dimension, Dimension)
sh_min_size SizeHints
sh Maybe (Dimension, Dimension)
-> Maybe (Dimension, Dimension) -> Bool
forall a. Eq a => a -> a -> Bool
== SizeHints -> Maybe (Dimension, Dimension)
sh_max_size SizeHints
sh
    Bool
isTransient <- Maybe Window -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Window -> Bool) -> X (Maybe Window) -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Window) -> X (Maybe Window)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> Window -> IO (Maybe Window)
getTransientForHint Display
d Window
w)

    RationalRect
rr <- (ScreenId, RationalRect) -> RationalRect
forall a b. (a, b) -> b
snd ((ScreenId, RationalRect) -> RationalRect)
-> X (ScreenId, RationalRect) -> X RationalRect
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Window -> X (ScreenId, RationalRect)
floatLocation Window
w
    -- ensure that float windows don't go over the edge of the screen
    let adjust :: RationalRect -> RationalRect
adjust (W.RationalRect Rational
x Rational
y Rational
wid Rational
h) | Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
wid Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
1 Bool -> Bool -> Bool
|| Rational
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
h Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
1 Bool -> Bool -> Bool
|| Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 Bool -> Bool -> Bool
|| Rational
y Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0
                                              = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
widRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
hRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) Rational
wid Rational
h
        adjust RationalRect
r = RationalRect
r

        f :: StackSet i l Window sid sd -> StackSet i l Window sid sd
f StackSet i l Window sid sd
ws | Bool
isFixedSize Bool -> Bool -> Bool
|| Bool
isTransient = Window
-> RationalRect
-> StackSet i l Window sid sd
-> StackSet i l Window sid sd
forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w (RationalRect -> RationalRect
adjust RationalRect
rr) (StackSet i l Window sid sd -> StackSet i l Window sid sd)
-> (StackSet i l Window sid sd -> StackSet i l Window sid sd)
-> StackSet i l Window sid sd
-> StackSet i l Window sid sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> StackSet i l Window sid sd -> StackSet i l Window sid sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp Window
w (StackSet i l Window sid sd -> StackSet i l Window sid sd)
-> (StackSet i l Window sid sd -> StackSet i l Window sid sd)
-> StackSet i l Window sid sd
-> StackSet i l Window sid sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l Window sid sd -> StackSet i l Window sid sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view i
i (StackSet i l Window sid sd -> StackSet i l Window sid sd)
-> StackSet i l Window sid sd -> StackSet i l Window sid sd
forall a b. (a -> b) -> a -> b
$ StackSet i l Window sid sd
ws
             | Bool
otherwise                  = Window -> StackSet i l Window sid sd -> StackSet i l Window sid sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp Window
w StackSet i l Window sid sd
ws
            where i :: i
i = Workspace i l Window -> i
forall i l a. Workspace i l a -> i
W.tag (Workspace i l Window -> i) -> Workspace i l Window -> i
forall a b. (a -> b) -> a -> b
$ Screen i l Window sid sd -> Workspace i l Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen i l Window sid sd -> Workspace i l Window)
-> Screen i l Window sid sd -> Workspace i l Window
forall a b. (a -> b) -> a -> b
$ StackSet i l Window sid sd -> Screen i l Window sid sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current StackSet i l Window sid sd
ws

    ManageHook
mh <- (XConf -> ManageHook) -> X ManageHook
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> ManageHook
forall (l :: * -> *). XConfig l -> ManageHook
manageHook (XConfig Layout -> ManageHook)
-> (XConf -> XConfig Layout) -> XConf -> ManageHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    WindowSet -> WindowSet
g <- Endo WindowSet -> WindowSet -> WindowSet
forall a. Endo a -> a -> a
appEndo (Endo WindowSet -> WindowSet -> WindowSet)
-> X (Endo WindowSet) -> X (WindowSet -> WindowSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endo WindowSet -> X (Endo WindowSet) -> X (Endo WindowSet)
forall a. a -> X a -> X a
userCodeDef ((WindowSet -> WindowSet) -> Endo WindowSet
forall a. (a -> a) -> Endo a
Endo WindowSet -> WindowSet
forall a. a -> a
id) (ManageHook -> Window -> X (Endo WindowSet)
forall a. Query a -> Window -> X a
runQuery ManageHook
mh Window
w)
    (WindowSet -> WindowSet) -> X ()
windows (WindowSet -> WindowSet
g (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
forall sid i l sd.
(Eq sid, Eq i) =>
StackSet i l Window sid sd -> StackSet i l Window sid sd
f)

-- | A window no longer exists; remove it from the window
-- list, on whatever workspace it is.
--
unmanage :: Window -> X ()
unmanage :: Window -> X ()
unmanage = (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.delete

-- | Kill the specified window. If we do kill it, we'll get a
-- delete notify back from X.
--
-- There are two ways to delete a window. Either just kill it, or if it
-- supports the delete protocol, send a delete event (e.g. firefox)
--
killWindow :: Window -> X ()
killWindow :: Window -> X ()
killWindow Window
w = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    Window
wmdelt <- X Window
atom_WM_DELETE_WINDOW  ;  Window
wmprot <- X Window
atom_WM_PROTOCOLS

    [Window]
protocols <- IO [Window] -> X [Window]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [Window] -> X [Window]) -> IO [Window] -> X [Window]
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO [Window]
getWMProtocols Display
d Window
w
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ if Window
wmdelt Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
protocols
        then (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
ev -> do
                XEventPtr -> Dimension -> IO ()
setEventType XEventPtr
ev Dimension
clientMessage
                XEventPtr -> Window -> Window -> CInt -> Window -> Window -> IO ()
setClientMessageEvent XEventPtr
ev Window
w Window
wmprot CInt
32 Window
wmdelt Window
currentTime
                Display -> Window -> Bool -> Window -> XEventPtr -> IO ()
sendEvent Display
d Window
w Bool
False Window
noEventMask XEventPtr
ev
        else Display -> Window -> IO CInt
killClient Display
d Window
w IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Kill the currently focused client.
kill :: X ()
kill :: X ()
kill = (Window -> X ()) -> X ()
withFocused Window -> X ()
killWindow

-- ---------------------------------------------------------------------
-- Managing windows

-- | Modify the current window list with a pure function, and refresh
windows :: (WindowSet -> WindowSet) -> X ()
windows :: (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
f = do
    XState { windowset :: XState -> WindowSet
windowset = WindowSet
old } <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
    let oldvisible :: [Window]
oldvisible = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Window])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window))
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout Window) Window
 -> Maybe (Stack Window))
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [Window])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (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
old Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
old
        newwindows :: [Window]
newwindows = WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
ws [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
old
        ws :: WindowSet
ws = WindowSet -> WindowSet
f WindowSet
old
    XConf { display :: XConf -> Display
display = Display
d , normalBorder :: XConf -> Window
normalBorder = Window
nbc, focusedBorder :: XConf -> Window
focusedBorder = Window
fbc } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask

    (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
setInitialProperties [Window]
newwindows

    Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
old) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
otherw -> do
      WorkspaceId
nbs <- (XConf -> WorkspaceId) -> X WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> WorkspaceId
forall (l :: * -> *). XConfig l -> WorkspaceId
normalBorderColor (XConfig Layout -> WorkspaceId)
-> (XConf -> XConfig Layout) -> XConf -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
      Display -> Window -> WorkspaceId -> Window -> X ()
setWindowBorderWithFallback Display
d Window
otherw WorkspaceId
nbs Window
nbc

    (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { windowset :: WindowSet
windowset = WindowSet
ws })

    -- notify non visibility
    let tags_oldvisible :: [WorkspaceId]
tags_oldvisible = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [WorkspaceId])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (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
old Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
old
        gottenhidden :: [Workspace WorkspaceId (Layout Window) Window]
gottenhidden    = (Workspace WorkspaceId (Layout Window) Window -> Bool)
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a. (a -> Bool) -> [a] -> [a]
filter ((WorkspaceId -> [WorkspaceId] -> Bool)
-> [WorkspaceId] -> WorkspaceId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [WorkspaceId]
tags_oldvisible (WorkspaceId -> Bool)
-> (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> Workspace WorkspaceId (Layout Window) Window
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag) ([Workspace WorkspaceId (Layout Window) Window]
 -> [Workspace WorkspaceId (Layout Window) Window])
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Workspace WorkspaceId (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden WindowSet
ws
    (Workspace WorkspaceId (Layout Window) Window -> X ())
-> [Workspace WorkspaceId (Layout Window) Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LayoutMessages
-> Workspace WorkspaceId (Layout Window) Window -> X ()
forall a.
Message a =>
a -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendMessageWithNoRefresh LayoutMessages
Hide) [Workspace WorkspaceId (Layout Window) Window]
gottenhidden

    -- for each workspace, layout the currently visible workspaces
    let allscreens :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
allscreens     = WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.screens WindowSet
ws
        summed_visible :: [[Window]]
summed_visible = ([Window] -> [Window] -> [Window])
-> [Window] -> [[Window]] -> [[Window]]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
(++) [] ([[Window]] -> [[Window]]) -> [[Window]] -> [[Window]]
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Window])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [[Window]]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window))
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout Window) Window
 -> Maybe (Stack Window))
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
allscreens
    [(Window, Rectangle)]
rects <- ([[(Window, Rectangle)]] -> [(Window, Rectangle)])
-> X [[(Window, Rectangle)]] -> X [(Window, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(Window, Rectangle)]] -> [(Window, Rectangle)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (X [[(Window, Rectangle)]] -> X [(Window, Rectangle)])
-> X [[(Window, Rectangle)]] -> X [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ [(Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail,
  [Window])]
-> ((Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail,
     [Window])
    -> X [(Window, Rectangle)])
-> X [[(Window, Rectangle)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [[Window]]
-> [(Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail,
     [Window])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
allscreens [[Window]]
summed_visible) (((Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail,
   [Window])
  -> X [(Window, Rectangle)])
 -> X [[(Window, Rectangle)]])
-> ((Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail,
     [Window])
    -> X [(Window, Rectangle)])
-> X [[(Window, Rectangle)]]
forall a b. (a -> b) -> a -> b
$ \ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
w, [Window]
vis) -> do
        let wsp :: Workspace WorkspaceId (Layout Window) Window
wsp   = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
w
            this :: WindowSet
this  = WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
n WindowSet
ws
            n :: WorkspaceId
n     = Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag Workspace WorkspaceId (Layout Window) Window
wsp
            tiled :: Maybe (Stack Window)
tiled = (Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout Window) Window
 -> Maybe (Stack Window))
-> (WindowSet -> Workspace WorkspaceId (Layout Window) Window)
-> WindowSet
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> (WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen WorkspaceId (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 -> Maybe (Stack Window))
-> WindowSet -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ WindowSet
this)
                    Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window -> Map Window RationalRect -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws)
                    Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
vis)
            viewrect :: Rectangle
viewrect = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle) -> ScreenDetail -> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
w

        -- just the tiled windows:
        -- now tile the windows on this workspace, modified by the gap
        ([(Window, Rectangle)]
rs, Maybe (Layout Window)
ml') <- Workspace WorkspaceId (Layout Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace WorkspaceId (Layout Window) Window
wsp { stack :: Maybe (Stack Window)
W.stack = Maybe (Stack Window)
tiled } Rectangle
viewrect X ([(Window, Rectangle)], Maybe (Layout Window))
-> X ([(Window, Rectangle)], Maybe (Layout Window))
-> X ([(Window, Rectangle)], Maybe (Layout Window))
forall a. X a -> X a -> X a
`catchX`
                     Workspace WorkspaceId (Layout Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace WorkspaceId (Layout Window) Window
wsp { stack :: Maybe (Stack Window)
W.stack = Maybe (Stack Window)
tiled, layout :: Layout Window
W.layout = Full Window -> Layout Window
forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout Full Window
forall a. Full a
Full } Rectangle
viewrect
        WorkspaceId -> Maybe (Layout Window) -> X ()
updateLayout WorkspaceId
n Maybe (Layout Window)
ml'

        let m :: Map Window RationalRect
m   = WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws
            flt :: [(Window, Rectangle)]
flt = [(Window
fw, Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
viewrect RationalRect
r)
                    | Window
fw <- (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> Map Window RationalRect -> Bool)
-> Map Window RationalRect -> Window -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> Map Window RationalRect -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Map Window RationalRect
m) (WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
this)
                    , Just RationalRect
r <- [Window -> Map Window RationalRect -> Maybe RationalRect
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
fw Map Window RationalRect
m]]
            vs :: [(Window, Rectangle)]
vs = [(Window, Rectangle)]
flt [(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [(Window, Rectangle)]
rs

        IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> [Window] -> IO ()
restackWindows Display
d (((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst [(Window, Rectangle)]
vs)
        -- return the visible windows for this workspace:
        [(Window, Rectangle)] -> X [(Window, Rectangle)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Window, Rectangle)]
vs

    let visible :: [Window]
visible = ((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst [(Window, Rectangle)]
rects

    ((Window, Rectangle) -> X ()) -> [(Window, Rectangle)] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Window -> Rectangle -> X ()) -> (Window, Rectangle) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Window -> Rectangle -> X ()
tileWindow) [(Window, Rectangle)]
rects

    Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w -> do
      WorkspaceId
fbs <- (XConf -> WorkspaceId) -> X WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> WorkspaceId
forall (l :: * -> *). XConfig l -> WorkspaceId
focusedBorderColor (XConfig Layout -> WorkspaceId)
-> (XConf -> XConfig Layout) -> XConf -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
      Display -> Window -> WorkspaceId -> Window -> X ()
setWindowBorderWithFallback Display
d Window
w WorkspaceId
fbs Window
fbc

    (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
reveal [Window]
visible
    X ()
setTopFocus

    -- hide every window that was potentially visible before, but is not
    -- given a position by a layout now.
    (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
hide ([Window] -> [Window]
forall a. Eq a => [a] -> [a]
nub ([Window]
oldvisible [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
newwindows) [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
visible)

    -- all windows that are no longer in the windowset are marked as
    -- withdrawn, it is important to do this after the above, otherwise 'hide'
    -- will overwrite withdrawnState with iconicState
    (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Window -> Int -> X ()) -> Int -> Window -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> Int -> X ()
setWMState Int
withdrawnState) (WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
old [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
ws)

    Bool
isMouseFocused <- (XConf -> Bool) -> X Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Bool
mouseFocused
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isMouseFocused (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> X ()
clearEvents Window
enterWindowMask
    (XConf -> X ()) -> X (X ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook (XConfig Layout -> X ())
-> (XConf -> XConfig Layout) -> XConf -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X (X ()) -> (X () -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= () -> X () -> X ()
forall a. a -> X a -> X a
userCodeDef ()

-- | Modify the @WindowSet@ in state with no special handling.
modifyWindowSet :: (WindowSet -> WindowSet) -> X ()
modifyWindowSet :: (WindowSet -> WindowSet) -> X ()
modifyWindowSet WindowSet -> WindowSet
f = (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
forall a b. (a -> b) -> a -> b
$ \XState
xst -> XState
xst { windowset :: WindowSet
windowset = WindowSet -> WindowSet
f (XState -> WindowSet
windowset XState
xst) }

-- | Perform an @X@ action and check its return value against a predicate p.
-- If p holds, unwind changes to the @WindowSet@ and replay them using @windows@.
windowBracket :: (a -> Bool) -> X a -> X a
windowBracket :: (a -> Bool) -> X a -> X a
windowBracket a -> Bool
p X a
action = (WindowSet -> X a) -> X a
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X a) -> X a) -> (WindowSet -> X a) -> X a
forall a b. (a -> b) -> a -> b
$ \WindowSet
old -> do
  a
a <- X a
action
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
a) (X () -> X ())
-> ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
new -> do
    (WindowSet -> WindowSet) -> X ()
modifyWindowSet ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
_ -> WindowSet
old
    (WindowSet -> WindowSet) -> X ()
windows         ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
_ -> WindowSet
new
  a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Perform an @X@ action. If it returns @Any True@, unwind the
-- changes to the @WindowSet@ and replay them using @windows@. This is
-- a version of @windowBracket@ that discards the return value and
-- handles an @X@ action that reports its need for refresh via @Any@.
windowBracket_ :: X Any -> X ()
windowBracket_ :: X Any -> X ()
windowBracket_ = X Any -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Any -> X ()) -> (X Any -> X Any) -> X Any -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Any -> Bool) -> X Any -> X Any
forall a. (a -> Bool) -> X a -> X a
windowBracket Any -> Bool
getAny

-- | Produce the actual rectangle from a screen and a ratio on that screen.
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
scaleRationalRect :: Rectangle -> RationalRect -> Rectangle
scaleRationalRect (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) (W.RationalRect Rational
rx Rational
ry Rational
rw Rational
rh)
 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Rational -> Position
forall b a. (Integral b, Real a) => a -> Rational -> b
scale Dimension
sw Rational
rx) (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Rational -> Position
forall b a. (Integral b, Real a) => a -> Rational -> b
scale Dimension
sh Rational
ry) (Dimension -> Rational -> Dimension
forall b a. (Integral b, Real a) => a -> Rational -> b
scale Dimension
sw Rational
rw) (Dimension -> Rational -> Dimension
forall b a. (Integral b, Real a) => a -> Rational -> b
scale Dimension
sh Rational
rh)
 where scale :: a -> Rational -> b
scale a
s Rational
r = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (a -> Rational
forall a. Real a => a -> Rational
toRational a
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)

-- | Set a window's WM_STATE property.
setWMState :: Window -> Int -> X ()
setWMState :: Window -> Int -> X ()
setWMState Window
w Int
v = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Window
a <- X Window
atom_WM_STATE
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
w Window
a Window
a CInt
propModeReplace [Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v, Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
none]

-- | Set the border color using the window's color map, if possible;
-- otherwise fall back to the color in @Pixel@.
setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X ()
setWindowBorderWithFallback :: Display -> Window -> WorkspaceId -> Window -> X ()
setWindowBorderWithFallback Display
dpy Window
w WorkspaceId
color Window
basic = IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$
    (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle SomeException -> IO ()
fallback (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      WindowAttributes
wa <- Display -> Window -> IO WindowAttributes
getWindowAttributes Display
dpy Window
w
      Window
pixel <- Color -> Window
color_pixel (Color -> Window)
-> ((Color, Color) -> Color) -> (Color, Color) -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color, Color) -> Color
forall a b. (a, b) -> a
fst ((Color, Color) -> Window) -> IO (Color, Color) -> IO Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> WorkspaceId -> IO (Color, Color)
allocNamedColor Display
dpy (WindowAttributes -> Window
wa_colormap WindowAttributes
wa) WorkspaceId
color
      Display -> Window -> Window -> IO ()
setWindowBorder Display
dpy Window
w Window
pixel
  where
    fallback :: C.SomeException -> IO ()
    fallback :: SomeException -> IO ()
fallback SomeException
e = do Handle -> SomeException -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr SomeException
e IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stderr
                    Display -> Window -> Window -> IO ()
setWindowBorder Display
dpy Window
w Window
basic

-- | Hide a window by unmapping it and setting Iconified.
hide :: Window -> X ()
hide :: Window -> X ()
hide Window
w = X Bool -> X () -> X ()
whenX ((XState -> Bool) -> X Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Window -> Set Window -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Window
w (Set Window -> Bool) -> (XState -> Set Window) -> XState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Set Window
mapped)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    Window
cMask <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((XConf -> Window) -> X Window) -> (XConf -> Window) -> X Window
forall a b. (a -> b) -> a -> b
$ XConfig Layout -> Window
forall (l :: * -> *). XConfig l -> Window
clientMask (XConfig Layout -> Window)
-> (XConf -> XConfig Layout) -> XConf -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do Display -> Window -> Window -> IO ()
selectInput Display
d Window
w (Window
cMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.&. Window -> Window
forall a. Bits a => a -> a
complement Window
structureNotifyMask)
            Display -> Window -> IO ()
unmapWindow Display
d Window
w
            Display -> Window -> Window -> IO ()
selectInput Display
d Window
w Window
cMask
    Window -> Int -> X ()
setWMState Window
w Int
iconicState
    -- this part is key: we increment the waitingUnmap counter to distinguish
    -- between client and xmonad initiated unmaps.
    (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { waitingUnmap :: Map Window Int
waitingUnmap = (Int -> Int -> Int)
-> Window -> Int -> Map Window Int -> Map Window Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Window
w Int
1 (XState -> Map Window Int
waitingUnmap XState
s)
                    , mapped :: Set Window
mapped       = Window -> Set Window -> Set Window
forall a. Ord a => a -> Set a -> Set a
S.delete Window
w (XState -> Set Window
mapped XState
s) })

-- | Show a window by mapping it and setting Normal.
-- This is harmless if the window was already visible.
reveal :: Window -> X ()
reveal :: Window -> X ()
reveal Window
w = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    Window -> Int -> X ()
setWMState Window
w Int
normalState
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
mapWindow Display
d Window
w
    X Bool -> X () -> X ()
whenX (Window -> X Bool
isClient Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { mapped :: Set Window
mapped = Window -> Set Window -> Set Window
forall a. Ord a => a -> Set a -> Set a
S.insert Window
w (XState -> Set Window
mapped XState
s) })

-- | Set some properties when we initially gain control of a window.
setInitialProperties :: Window -> X ()
setInitialProperties :: Window -> X ()
setInitialProperties Window
w = (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
normalBorder X Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
nb -> (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    Window -> Int -> X ()
setWMState Window
w Int
iconicState
    (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> Window
forall (l :: * -> *). XConfig l -> Window
clientMask (XConfig Layout -> Window)
-> (XConf -> XConfig Layout) -> XConf -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (Window -> IO ()) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Display -> Window -> Window -> IO ()
selectInput Display
d Window
w
    Dimension
bw <- (XConf -> Dimension) -> X Dimension
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> Dimension
forall (l :: * -> *). XConfig l -> Dimension
borderWidth (XConfig Layout -> Dimension)
-> (XConf -> XConfig Layout) -> XConf -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Dimension -> IO ()
setWindowBorderWidth Display
d Window
w Dimension
bw
    -- we must initially set the color of new windows, to maintain invariants
    -- required by the border setting in 'windows'
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
setWindowBorder Display
d Window
w Window
nb

-- | Render the currently visible workspaces, as determined by
-- the 'StackSet'. Also, set focus to the focused window.
--
-- This is our 'view' operation (MVC), in that it pretty prints our model
-- with X calls.
--
refresh :: X ()
refresh :: X ()
refresh = (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall a. a -> a
id

-- | Remove all events of a given type from the event queue.
clearEvents :: EventMask -> X ()
clearEvents :: Window -> X ()
clearEvents Window
mask = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Display -> Bool -> IO ()
sync Display
d Bool
False
    (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
again -> do
        Bool
more <- Display -> Window -> XEventPtr -> IO Bool
checkMaskEvent Display
d Window
mask XEventPtr
p
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
more IO ()
again -- beautiful

-- | Move and resize @w@ such that it fits inside the given rectangle,
-- including its border.
tileWindow :: Window -> Rectangle -> X ()
tileWindow :: Window -> Rectangle -> X ()
tileWindow Window
w Rectangle
r = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w ((WindowAttributes -> X ()) -> X ())
-> (WindowAttributes -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
    -- give all windows at least 1x1 pixels
    let bw :: Dimension
bw = CInt -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Dimension) -> CInt -> Dimension
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_border_width WindowAttributes
wa
        least :: Dimension -> Dimension
least Dimension
x | Dimension
x Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
<= Dimension
bwDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
*Dimension
2  = Dimension
1
                | Bool
otherwise  = Dimension
x Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
bwDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
*Dimension
2
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
moveResizeWindow Display
d Window
w (Rectangle -> Position
rect_x Rectangle
r) (Rectangle -> Position
rect_y Rectangle
r)
                              (Dimension -> Dimension
least (Dimension -> Dimension) -> Dimension -> Dimension
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
r) (Dimension -> Dimension
least (Dimension -> Dimension) -> Dimension -> Dimension
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
r)

-- ---------------------------------------------------------------------

-- | Returns 'True' if the first rectangle is contained within, but not equal
-- to the second.
containedIn :: Rectangle -> Rectangle -> Bool
containedIn :: Rectangle -> Rectangle -> Bool
containedIn r1 :: Rectangle
r1@(Rectangle Position
x1 Position
y1 Dimension
w1 Dimension
h1) r2 :: Rectangle
r2@(Rectangle Position
x2 Position
y2 Dimension
w2 Dimension
h2)
 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Rectangle
r1 Rectangle -> Rectangle -> Bool
forall a. Eq a => a -> a -> Bool
/= Rectangle
r2
       , Position
x1 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position
x2
       , Position
y1 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position
y2
       , Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x1 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
w1 Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
<= Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
w2
       , Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y1 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
h1 Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
<= Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
h2 ]

-- | Given a list of screens, remove all duplicated screens and screens that
-- are entirely contained within another.
nubScreens :: [Rectangle] -> [Rectangle]
nubScreens :: [Rectangle] -> [Rectangle]
nubScreens [Rectangle]
xs = [Rectangle] -> [Rectangle]
forall a. Eq a => [a] -> [a]
nub ([Rectangle] -> [Rectangle])
-> ([Rectangle] -> [Rectangle]) -> [Rectangle] -> [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rectangle -> Bool) -> [Rectangle] -> [Rectangle]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Rectangle
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Rectangle -> Bool) -> [Rectangle] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Rectangle
x Rectangle -> Rectangle -> Bool
`containedIn`) [Rectangle]
xs) ([Rectangle] -> [Rectangle]) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ [Rectangle]
xs

-- | Clean the list of screens according to the rules documented for
-- nubScreens.
getCleanedScreenInfo :: MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo :: Display -> m [Rectangle]
getCleanedScreenInfo = IO [Rectangle] -> m [Rectangle]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [Rectangle] -> m [Rectangle])
-> (Display -> IO [Rectangle]) -> Display -> m [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ([Rectangle] -> [Rectangle]) -> IO [Rectangle] -> IO [Rectangle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Rectangle] -> [Rectangle]
nubScreens (IO [Rectangle] -> IO [Rectangle])
-> (Display -> IO [Rectangle]) -> Display -> IO [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Display -> IO [Rectangle]
getScreenInfo

-- | The screen configuration may have changed (due to -- xrandr),
-- update the state and refresh the screen, and reset the gap.
rescreen :: X ()
rescreen :: X ()
rescreen = do
    [Rectangle]
xinesc <- (Display -> X [Rectangle]) -> X [Rectangle]
forall a. (Display -> X a) -> X a
withDisplay Display -> X [Rectangle]
forall (m :: * -> *). MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo

    (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ \ws :: WindowSet
ws@(W.StackSet { current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
v, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vs, hidden :: forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden = [Workspace WorkspaceId (Layout Window) Window]
hs }) ->
        let ([Workspace WorkspaceId (Layout Window) Window]
xs, [Workspace WorkspaceId (Layout Window) Window]
ys) = Int
-> [Workspace WorkspaceId (Layout Window) Window]
-> ([Workspace WorkspaceId (Layout Window) Window],
    [Workspace WorkspaceId (Layout Window) Window])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Rectangle] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rectangle]
xinesc) ([Workspace WorkspaceId (Layout Window) Window]
 -> ([Workspace WorkspaceId (Layout Window) Window],
     [Workspace WorkspaceId (Layout Window) Window]))
-> [Workspace WorkspaceId (Layout Window) Window]
-> ([Workspace WorkspaceId (Layout Window) Window],
    [Workspace WorkspaceId (Layout Window) Window])
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
vScreen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vs) [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a. [a] -> [a] -> [a]
++ [Workspace WorkspaceId (Layout Window) Window]
hs
            (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
a:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
as)   = (Workspace WorkspaceId (Layout Window) Window
 -> ScreenId
 -> ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> [Workspace WorkspaceId (Layout Window) Window]
-> [ScreenId]
-> [ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Workspace WorkspaceId (Layout Window) Window
-> ScreenId
-> ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen [Workspace WorkspaceId (Layout Window) Window]
xs [ScreenId
0..] ([ScreenDetail]
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> [ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ (Rectangle -> ScreenDetail) -> [Rectangle] -> [ScreenDetail]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> ScreenDetail
SD [Rectangle]
xinesc
        in  WindowSet
ws { current :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
W.current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
a
               , visible :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
W.visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
as
               , hidden :: [Workspace WorkspaceId (Layout Window) Window]
W.hidden  = [Workspace WorkspaceId (Layout Window) Window]
ys }

-- ---------------------------------------------------------------------

-- | Tell whether or not to intercept clicks on a given window
setButtonGrab :: Bool -> Window -> X ()
setButtonGrab :: Bool -> Window -> X ()
setButtonGrab Bool
grab Window
w = do
    CInt
pointerMode <- (XConf -> CInt) -> X CInt
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((XConf -> CInt) -> X CInt) -> (XConf -> CInt) -> X CInt
forall a b. (a -> b) -> a -> b
$ \XConf
c -> if XConfig Layout -> Bool
forall (l :: * -> *). XConfig l -> Bool
clickJustFocuses (XConf -> XConfig Layout
config XConf
c)
                                    then CInt
grabModeAsync
                                    else CInt
grabModeSync
    (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ if Bool
grab
        then [Dimension] -> (Dimension -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Dimension
button1, Dimension
button2, Dimension
button3] ((Dimension -> IO ()) -> IO ()) -> (Dimension -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Dimension
b ->
            Display
-> Dimension
-> ButtonMask
-> Window
-> Bool
-> Window
-> CInt
-> CInt
-> Window
-> Window
-> IO ()
grabButton Display
d Dimension
b ButtonMask
anyModifier Window
w Bool
False Window
buttonPressMask
                       CInt
pointerMode CInt
grabModeSync Window
none Window
none
        else Display -> Dimension -> ButtonMask -> Window -> IO ()
ungrabButton Display
d Dimension
anyButton ButtonMask
anyModifier Window
w

-- ---------------------------------------------------------------------
-- Setting keyboard focus

-- | Set the focus to the window on top of the stack, or root
setTopFocus :: X ()
setTopFocus :: X ()
setTopFocus = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ X () -> (Window -> X ()) -> Maybe Window -> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Window -> X ()
setFocusX (Window -> X ()) -> X Window -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot) Window -> X ()
setFocusX (Maybe Window -> X ())
-> (WindowSet -> Maybe Window) -> WindowSet -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek

-- | Set focus explicitly to window 'w' if it is managed by us, or root.
-- This happens if X notices we've moved the mouse (and perhaps moved
-- the mouse to a new screen).
focus :: Window -> X ()
focus :: Window -> X ()
focus Window
w = (XConf -> XConf) -> X () -> X ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\XConf
c -> XConf
c { mouseFocused :: Bool
mouseFocused = Bool
True }) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
    let stag :: Screen c l a sid sd -> c
stag = Workspace c l a -> c
forall i l a. Workspace i l a -> i
W.tag (Workspace c l a -> c)
-> (Screen c l a sid sd -> Workspace c l a)
-> Screen c l a sid sd
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen c l a sid sd -> Workspace c l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace
        curr :: WorkspaceId
curr = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall c l a sid sd. Screen c l a sid sd -> c
stag (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (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
s
    Maybe WorkspaceId
mnew <- X (Maybe WorkspaceId)
-> ((Position, Position) -> X (Maybe WorkspaceId))
-> Maybe (Position, Position)
-> X (Maybe WorkspaceId)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe WorkspaceId -> X (Maybe WorkspaceId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WorkspaceId
forall a. Maybe a
Nothing) ((Maybe
   (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> Maybe WorkspaceId)
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> X (Maybe WorkspaceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Maybe WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall c l a sid sd. Screen c l a sid sd -> c
stag) (X (Maybe
      (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
 -> X (Maybe WorkspaceId))
-> ((Position, Position)
    -> X (Maybe
            (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)))
-> (Position, Position)
-> X (Maybe WorkspaceId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position
 -> Position
 -> X (Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)))
-> (Position, Position)
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Position
-> Position
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
pointScreen)
            (Maybe (Position, Position) -> X (Maybe WorkspaceId))
-> X (Maybe (Position, Position)) -> X (Maybe WorkspaceId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XConf -> Maybe (Position, Position))
-> X (Maybe (Position, Position))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Maybe (Position, Position)
mousePosition
    Window
root <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    case () of
        ()
_ | Window -> WindowSet -> Bool
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
W.member Window
w WindowSet
s Bool -> Bool -> Bool
&& WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
s Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w -> (WindowSet -> WindowSet) -> X ()
windows (Window -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
w)
          | Just WorkspaceId
new <- Maybe WorkspaceId
mnew, Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
root Bool -> Bool -> Bool
&& WorkspaceId
curr WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
/= WorkspaceId
new
                                               -> (WindowSet -> WindowSet) -> X ()
windows (WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
new)
          | Bool
otherwise                          -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Call X to set the keyboard focus details.
setFocusX :: Window -> X ()
setFocusX :: Window -> X ()
setFocusX Window
w = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
    Display
dpy <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display

    -- clear mouse button grab and border on other windows
    [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> X ())
-> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (WindowSet
-> Screen WorkspaceId (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
ws Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
ws) ((Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> X ())
 -> X ())
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> X ())
-> X ()
forall a b. (a -> b) -> a -> b
$ \Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
wk ->
        [Window] -> (Window -> X ()) -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index (WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
wk)) WindowSet
ws)) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
otherw ->
            Bool -> Window -> X ()
setButtonGrab Bool
True Window
otherw

    -- If we ungrab buttons on the root window, we lose our mouse bindings.
    X Bool -> X () -> X ()
whenX (Bool -> Bool
not (Bool -> Bool) -> X Bool -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X Bool
isRoot Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Bool -> Window -> X ()
setButtonGrab Bool
False Window
w

    WMHints
hints <- IO WMHints -> X WMHints
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WMHints -> X WMHints) -> IO WMHints -> X WMHints
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WMHints
getWMHints Display
dpy Window
w
    [Window]
protocols <- IO [Window] -> X [Window]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [Window] -> X [Window]) -> IO [Window] -> X [Window]
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO [Window]
getWMProtocols Display
dpy Window
w
    Window
wmprot <- X Window
atom_WM_PROTOCOLS
    Window
wmtf <- X Window
atom_WM_TAKE_FOCUS
    Maybe Event
currevt <- (XConf -> Maybe Event) -> X (Maybe Event)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Maybe Event
currentEvent
    let inputHintSet :: Bool
inputHintSet = WMHints -> CLong
wmh_flags WMHints
hints CLong -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
inputHintBit

    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool
inputHintSet Bool -> Bool -> Bool
&& WMHints -> Bool
wmh_input WMHints
hints) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
inputHintSet)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do Display -> Window -> CInt -> Window -> IO ()
setInputFocus Display
dpy Window
w CInt
revertToPointerRoot Window
0
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
wmtf Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
protocols) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
ev -> do
        XEventPtr -> Dimension -> IO ()
setEventType XEventPtr
ev Dimension
clientMessage
        XEventPtr -> Window -> Window -> CInt -> Window -> Window -> IO ()
setClientMessageEvent XEventPtr
ev Window
w Window
wmprot CInt
32 Window
wmtf (Window -> IO ()) -> Window -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> (Event -> Window) -> Maybe Event -> Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Window
currentTime Event -> Window
event_time Maybe Event
currevt
        Display -> Window -> Bool -> Window -> XEventPtr -> IO ()
sendEvent Display
dpy Window
w Bool
False Window
noEventMask XEventPtr
ev
        where event_time :: Event -> Window
event_time Event
ev =
                if (Event -> Dimension
ev_event_type Event
ev) Dimension -> [Dimension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Dimension]
timedEvents then
                  Event -> Window
ev_time Event
ev
                else
                  Window
currentTime
              timedEvents :: [Dimension]
timedEvents = [ Dimension
keyPress, Dimension
keyRelease, Dimension
buttonPress, Dimension
buttonRelease, Dimension
enterNotify, Dimension
leaveNotify, Dimension
selectionRequest ]

------------------------------------------------------------------------
-- Message handling

-- | Throw a message to the current 'LayoutClass' possibly modifying how we
-- layout the windows, in which case changes are handled through a refresh.
sendMessage :: Message a => a -> X ()
sendMessage :: a -> X ()
sendMessage a
a = X Any -> X ()
windowBracket_ (X Any -> X ()) -> X Any -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Workspace WorkspaceId (Layout Window) Window
w <- Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> (WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen WorkspaceId (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 WorkspaceId (Layout Window) Window)
-> X WindowSet -> X (Workspace WorkspaceId (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
    Maybe (Layout Window)
ml' <- Layout Window -> SomeMessage -> X (Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage (Workspace WorkspaceId (Layout Window) Window -> Layout Window
forall i l a. Workspace i l a -> l
W.layout Workspace WorkspaceId (Layout Window) Window
w) (a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage a
a) X (Maybe (Layout Window))
-> X (Maybe (Layout Window)) -> X (Maybe (Layout Window))
forall a. X a -> X a -> X a
`catchX` Maybe (Layout Window) -> X (Maybe (Layout Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Layout Window)
forall a. Maybe a
Nothing
    Maybe (Layout Window) -> (Layout Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Layout Window)
ml' ((Layout Window -> X ()) -> X ())
-> (Layout Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Layout Window
l' ->
        (WindowSet -> WindowSet) -> X ()
modifyWindowSet ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> WindowSet
ws { current :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
W.current = (WindowSet
-> Screen WorkspaceId (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
ws)
                                { workspace :: Workspace WorkspaceId (Layout Window) Window
W.workspace = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (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
ws)
                                  { layout :: Layout Window
W.layout = Layout Window
l' }}}
    Any -> X Any
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Any
Any (Bool -> Any) -> Bool -> Any
forall a b. (a -> b) -> a -> b
$ Maybe (Layout Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Layout Window)
ml')

-- | Send a message to all layouts, without refreshing.
broadcastMessage :: Message a => a -> X ()
broadcastMessage :: a -> X ()
broadcastMessage a
a = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
    -- this is O(n²), but we can't really fix this as there's code in
    -- xmonad-contrib that touches the windowset during handleMessage
    -- (returning Nothing for changes to not get overwritten), so we
    -- unfortunately need to do this one by one and persist layout states
    -- of each workspace separately)
    let c :: Workspace WorkspaceId (Layout Window) Window
c = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> (WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen WorkspaceId (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 WorkspaceId (Layout Window) Window)
-> WindowSet -> Workspace WorkspaceId (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ WindowSet
ws
        v :: [Workspace WorkspaceId (Layout Window) Window]
v = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [Workspace WorkspaceId (Layout Window) Window])
-> (WindowSet
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> WindowSet
-> [Workspace WorkspaceId (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible (WindowSet -> [Workspace WorkspaceId (Layout Window) Window])
-> WindowSet -> [Workspace WorkspaceId (Layout Window) Window]
forall a b. (a -> b) -> a -> b
$ WindowSet
ws
        h :: [Workspace WorkspaceId (Layout Window) Window]
h = WindowSet -> [Workspace WorkspaceId (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden WindowSet
ws
    (Workspace WorkspaceId (Layout Window) Window -> X ())
-> [Workspace WorkspaceId (Layout Window) Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a -> Workspace WorkspaceId (Layout Window) Window -> X ()
forall a.
Message a =>
a -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendMessageWithNoRefresh a
a) (Workspace WorkspaceId (Layout Window) Window
c Workspace WorkspaceId (Layout Window) Window
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a. a -> [a] -> [a]
: [Workspace WorkspaceId (Layout Window) Window]
v [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a. [a] -> [a] -> [a]
++ [Workspace WorkspaceId (Layout Window) Window]
h)

-- | Send a message to a layout, without refreshing.
sendMessageWithNoRefresh :: Message a => a -> WindowSpace -> X ()
sendMessageWithNoRefresh :: a -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendMessageWithNoRefresh a
a Workspace WorkspaceId (Layout Window) Window
w =
    Layout Window -> SomeMessage -> X (Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage (Workspace WorkspaceId (Layout Window) Window -> Layout Window
forall i l a. Workspace i l a -> l
W.layout Workspace WorkspaceId (Layout Window) Window
w) (a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage a
a) X (Maybe (Layout Window))
-> X (Maybe (Layout Window)) -> X (Maybe (Layout Window))
forall a. X a -> X a -> X a
`catchX` Maybe (Layout Window) -> X (Maybe (Layout Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Layout Window)
forall a. Maybe a
Nothing X (Maybe (Layout Window))
-> (Maybe (Layout Window) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    WorkspaceId -> Maybe (Layout Window) -> X ()
updateLayout  (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag Workspace WorkspaceId (Layout Window) Window
w)

-- | Update the layout field of a workspace.
updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
updateLayout WorkspaceId
i Maybe (Layout Window)
ml = Maybe (Layout Window) -> (Layout Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Layout Window)
ml ((Layout Window -> X ()) -> X ())
-> (Layout Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Layout Window
l ->
    (Workspace WorkspaceId (Layout Window) Window
 -> X (Workspace WorkspaceId (Layout Window) Window))
-> X ()
runOnWorkspaces ((Workspace WorkspaceId (Layout Window) Window
  -> X (Workspace WorkspaceId (Layout Window) Window))
 -> X ())
-> (Workspace WorkspaceId (Layout Window) Window
    -> X (Workspace WorkspaceId (Layout Window) Window))
-> X ()
forall a b. (a -> b) -> a -> b
$ \Workspace WorkspaceId (Layout Window) Window
ww -> Workspace WorkspaceId (Layout Window) Window
-> X (Workspace WorkspaceId (Layout Window) Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Workspace WorkspaceId (Layout Window) Window
 -> X (Workspace WorkspaceId (Layout Window) Window))
-> Workspace WorkspaceId (Layout Window) Window
-> X (Workspace WorkspaceId (Layout Window) Window)
forall a b. (a -> b) -> a -> b
$ if Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag Workspace WorkspaceId (Layout Window) Window
ww WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId
i then Workspace WorkspaceId (Layout Window) Window
ww { layout :: Layout Window
W.layout = Layout Window
l} else Workspace WorkspaceId (Layout Window) Window
ww

-- | Set the layout of the currently viewed workspace.
setLayout :: Layout Window -> X ()
setLayout :: Layout Window -> X ()
setLayout Layout Window
l = do
    ss :: WindowSet
ss@(W.StackSet { current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current = c :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
c@(W.Screen { workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace = Workspace WorkspaceId (Layout Window) Window
ws })}) <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    Layout Window -> SomeMessage -> X (Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage (Workspace WorkspaceId (Layout Window) Window -> Layout Window
forall i l a. Workspace i l a -> l
W.layout Workspace WorkspaceId (Layout Window) Window
ws) (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
    (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WindowSet -> WindowSet -> WindowSet
forall a b. a -> b -> a
const (WindowSet -> WindowSet -> WindowSet)
-> WindowSet -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ WindowSet
ss {current :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
W.current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
c { workspace :: Workspace WorkspaceId (Layout Window) Window
W.workspace = Workspace WorkspaceId (Layout Window) Window
ws { layout :: Layout Window
W.layout = Layout Window
l } } }

------------------------------------------------------------------------
-- Utilities

-- | Return workspace visible on screen @sc@, or 'Nothing'.
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
sc = (WindowSet -> X (Maybe WorkspaceId)) -> X (Maybe WorkspaceId)
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X (Maybe WorkspaceId)) -> X (Maybe WorkspaceId))
-> (WindowSet -> X (Maybe WorkspaceId)) -> X (Maybe WorkspaceId)
forall a b. (a -> b) -> a -> b
$ Maybe WorkspaceId -> X (Maybe WorkspaceId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WorkspaceId -> X (Maybe WorkspaceId))
-> (WindowSet -> Maybe WorkspaceId)
-> WindowSet
-> X (Maybe WorkspaceId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId -> WindowSet -> Maybe WorkspaceId
forall s i l a sd. Eq s => s -> StackSet i l a s sd -> Maybe i
W.lookupWorkspace ScreenId
sc

-- | Apply an 'X' operation to the currently focused window, if there is one.
withFocused :: (Window -> X ()) -> X ()
withFocused :: (Window -> X ()) -> X ()
withFocused Window -> X ()
f = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
w -> Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
w) Window -> X ()
f

-- | Apply an 'X' operation to all unfocused windows on the current workspace, if there are any.
withUnfocused :: (Window -> X ()) -> X ()
withUnfocused :: (Window -> X ()) -> X ()
withUnfocused Window -> X ()
f = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
    Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w ->
        let unfocusedWindows :: [Window]
unfocusedWindows = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
w) ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
ws
        in (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
f [Window]
unfocusedWindows

-- | Is the window is under management by xmonad?
isClient :: Window -> X Bool
isClient :: Window -> X Bool
isClient Window
w = (WindowSet -> X Bool) -> X Bool
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X Bool) -> X Bool)
-> (WindowSet -> X Bool) -> X Bool
forall a b. (a -> b) -> a -> b
$ Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> (WindowSet -> Bool) -> WindowSet -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> Bool
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
W.member Window
w

-- | Combinations of extra modifier masks we need to grab keys\/buttons for.
-- (numlock and capslock)
extraModifiers :: X [KeyMask]
extraModifiers :: X [ButtonMask]
extraModifiers = do
    ButtonMask
nlm <- (XState -> ButtonMask) -> X ButtonMask
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> ButtonMask
numberlockMask
    [ButtonMask] -> X [ButtonMask]
forall (m :: * -> *) a. Monad m => a -> m a
return [ButtonMask
0, ButtonMask
nlm, ButtonMask
lockMask, ButtonMask
nlm ButtonMask -> ButtonMask -> ButtonMask
forall a. Bits a => a -> a -> a
.|. ButtonMask
lockMask ]

-- | Strip numlock\/capslock from a mask.
cleanMask :: KeyMask -> X KeyMask
cleanMask :: ButtonMask -> X ButtonMask
cleanMask ButtonMask
km = do
    ButtonMask
nlm <- (XState -> ButtonMask) -> X ButtonMask
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> ButtonMask
numberlockMask
    ButtonMask -> X ButtonMask
forall (m :: * -> *) a. Monad m => a -> m a
return (ButtonMask -> ButtonMask
forall a. Bits a => a -> a
complement (ButtonMask
nlm ButtonMask -> ButtonMask -> ButtonMask
forall a. Bits a => a -> a -> a
.|. ButtonMask
lockMask) ButtonMask -> ButtonMask -> ButtonMask
forall a. Bits a => a -> a -> a
.&. ButtonMask
km)

-- | Get the 'Pixel' value for a named color.
initColor :: Display -> String -> IO (Maybe Pixel)
initColor :: Display -> WorkspaceId -> IO (Maybe Window)
initColor Display
dpy WorkspaceId
c = (SomeException -> IO (Maybe Window))
-> IO (Maybe Window) -> IO (Maybe Window)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle (\(C.SomeException e
_) -> Maybe Window -> IO (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
forall a. Maybe a
Nothing) (IO (Maybe Window) -> IO (Maybe Window))
-> IO (Maybe Window) -> IO (Maybe Window)
forall a b. (a -> b) -> a -> b
$
    (Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window)
-> ((Color, Color) -> Window) -> (Color, Color) -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Window
color_pixel (Color -> Window)
-> ((Color, Color) -> Color) -> (Color, Color) -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color, Color) -> Color
forall a b. (a, b) -> a
fst) ((Color, Color) -> Maybe Window)
-> IO (Color, Color) -> IO (Maybe Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> WorkspaceId -> IO (Color, Color)
allocNamedColor Display
dpy Window
colormap WorkspaceId
c
    where colormap :: Window
colormap = Display -> Dimension -> Window
defaultColormap Display
dpy (Display -> Dimension
defaultScreen Display
dpy)

------------------------------------------------------------------------

-- | A type to help serialize xmonad's state to a file.
data StateFile = StateFile
  { StateFile
-> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
sfWins :: W.StackSet  WorkspaceId String Window ScreenId ScreenDetail
  , StateFile -> [(WorkspaceId, WorkspaceId)]
sfExt  :: [(String, String)]
  } deriving (Int -> StateFile -> ShowS
[StateFile] -> ShowS
StateFile -> WorkspaceId
(Int -> StateFile -> ShowS)
-> (StateFile -> WorkspaceId)
-> ([StateFile] -> ShowS)
-> Show StateFile
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [StateFile] -> ShowS
$cshowList :: [StateFile] -> ShowS
show :: StateFile -> WorkspaceId
$cshow :: StateFile -> WorkspaceId
showsPrec :: Int -> StateFile -> ShowS
$cshowsPrec :: Int -> StateFile -> ShowS
Show, ReadPrec [StateFile]
ReadPrec StateFile
Int -> ReadS StateFile
ReadS [StateFile]
(Int -> ReadS StateFile)
-> ReadS [StateFile]
-> ReadPrec StateFile
-> ReadPrec [StateFile]
-> Read StateFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StateFile]
$creadListPrec :: ReadPrec [StateFile]
readPrec :: ReadPrec StateFile
$creadPrec :: ReadPrec StateFile
readList :: ReadS [StateFile]
$creadList :: ReadS [StateFile]
readsPrec :: Int -> ReadS StateFile
$creadsPrec :: Int -> ReadS StateFile
Read)

-- | Write the current window state (and extensible state) to a file
-- so that xmonad can resume with that state intact.
writeStateToFile :: X ()
writeStateToFile :: X ()
writeStateToFile = do
    let maybeShow :: (a, Either WorkspaceId StateExtension) -> Maybe (a, WorkspaceId)
maybeShow (a
t, Right (PersistentExtension a
ext)) = (a, WorkspaceId) -> Maybe (a, WorkspaceId)
forall a. a -> Maybe a
Just (a
t, a -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show a
ext)
        maybeShow (a
t, Left WorkspaceId
str) = (a, WorkspaceId) -> Maybe (a, WorkspaceId)
forall a. a -> Maybe a
Just (a
t, WorkspaceId
str)
        maybeShow (a, Either WorkspaceId StateExtension)
_ = Maybe (a, WorkspaceId)
forall a. Maybe a
Nothing

        wsData :: XState
-> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
wsData   = (Layout Window -> WorkspaceId)
-> WindowSet
-> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
forall l l' i a s sd.
(l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
W.mapLayout Layout Window -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show (WindowSet
 -> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail)
-> (XState -> WindowSet)
-> XState
-> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
        extState :: XState -> [(WorkspaceId, WorkspaceId)]
extState = [Maybe (WorkspaceId, WorkspaceId)] -> [(WorkspaceId, WorkspaceId)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (WorkspaceId, WorkspaceId)]
 -> [(WorkspaceId, WorkspaceId)])
-> (XState -> [Maybe (WorkspaceId, WorkspaceId)])
-> XState
-> [(WorkspaceId, WorkspaceId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WorkspaceId, Either WorkspaceId StateExtension)
 -> Maybe (WorkspaceId, WorkspaceId))
-> [(WorkspaceId, Either WorkspaceId StateExtension)]
-> [Maybe (WorkspaceId, WorkspaceId)]
forall a b. (a -> b) -> [a] -> [b]
map (WorkspaceId, Either WorkspaceId StateExtension)
-> Maybe (WorkspaceId, WorkspaceId)
forall a.
(a, Either WorkspaceId StateExtension) -> Maybe (a, WorkspaceId)
maybeShow ([(WorkspaceId, Either WorkspaceId StateExtension)]
 -> [Maybe (WorkspaceId, WorkspaceId)])
-> (XState -> [(WorkspaceId, Either WorkspaceId StateExtension)])
-> XState
-> [Maybe (WorkspaceId, WorkspaceId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId (Either WorkspaceId StateExtension)
-> [(WorkspaceId, Either WorkspaceId StateExtension)]
forall k a. Map k a -> [(k, a)]
M.toList (Map WorkspaceId (Either WorkspaceId StateExtension)
 -> [(WorkspaceId, Either WorkspaceId StateExtension)])
-> (XState -> Map WorkspaceId (Either WorkspaceId StateExtension))
-> XState
-> [(WorkspaceId, Either WorkspaceId StateExtension)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Map WorkspaceId (Either WorkspaceId StateExtension)
extensibleState

    WorkspaceId
path <- (XConf -> WorkspaceId) -> X WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((XConf -> WorkspaceId) -> X WorkspaceId)
-> (XConf -> WorkspaceId) -> X WorkspaceId
forall a b. (a -> b) -> a -> b
$ Directories -> WorkspaceId
stateFileName (Directories -> WorkspaceId)
-> (XConf -> Directories) -> XConf -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories
    StateFile
stateData <- (XState -> StateFile) -> X StateFile
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\XState
s -> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
-> [(WorkspaceId, WorkspaceId)] -> StateFile
StateFile (XState
-> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
wsData XState
s) (XState -> [(WorkspaceId, WorkspaceId)]
extState XState
s))
    IO () -> X ()
forall (m :: * -> *). MonadIO m => IO () -> m ()
catchIO (WorkspaceId -> WorkspaceId -> IO ()
writeFile WorkspaceId
path (WorkspaceId -> IO ()) -> WorkspaceId -> IO ()
forall a b. (a -> b) -> a -> b
$ StateFile -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show StateFile
stateData)

-- | Read the state of a previous xmonad instance from a file and
-- return that state.  The state file is removed after reading it.
readStateFile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> X (Maybe XState)
readStateFile :: XConfig l -> X (Maybe XState)
readStateFile XConfig l
xmc = do
    WorkspaceId
path <- (XConf -> WorkspaceId) -> X WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((XConf -> WorkspaceId) -> X WorkspaceId)
-> (XConf -> WorkspaceId) -> X WorkspaceId
forall a b. (a -> b) -> a -> b
$ Directories -> WorkspaceId
stateFileName (Directories -> WorkspaceId)
-> (XConf -> Directories) -> XConf -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories

    -- I'm trying really hard here to make sure we read the entire
    -- contents of the file before it is removed from the file system.
    Maybe (Maybe StateFile)
sf' <- X (Maybe StateFile) -> X (Maybe (Maybe StateFile))
forall a. X a -> X (Maybe a)
userCode (X (Maybe StateFile) -> X (Maybe (Maybe StateFile)))
-> (IO (Maybe StateFile) -> X (Maybe StateFile))
-> IO (Maybe StateFile)
-> X (Maybe (Maybe StateFile))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe StateFile) -> X (Maybe StateFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe StateFile) -> X (Maybe (Maybe StateFile)))
-> IO (Maybe StateFile) -> X (Maybe (Maybe StateFile))
forall a b. (a -> b) -> a -> b
$ do
        WorkspaceId
raw <- WorkspaceId
-> IOMode -> (Handle -> IO WorkspaceId) -> IO WorkspaceId
forall r. WorkspaceId -> IOMode -> (Handle -> IO r) -> IO r
withFile WorkspaceId
path IOMode
ReadMode Handle -> IO WorkspaceId
readStrict
        Maybe StateFile -> IO (Maybe StateFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StateFile -> IO (Maybe StateFile))
-> Maybe StateFile -> IO (Maybe StateFile)
forall a b. (a -> b) -> a -> b
$! ReadS StateFile -> WorkspaceId -> Maybe StateFile
forall t a. (t -> [(a, WorkspaceId)]) -> t -> Maybe a
maybeRead ReadS StateFile
forall a. Read a => ReadS a
reads WorkspaceId
raw

    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (WorkspaceId -> IO ()
removeFile WorkspaceId
path)

    Maybe XState -> X (Maybe XState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XState -> X (Maybe XState))
-> Maybe XState -> X (Maybe XState)
forall a b. (a -> b) -> a -> b
$ do
      StateFile
sf <- Maybe (Maybe StateFile) -> Maybe StateFile
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe StateFile)
sf'

      let winset :: WindowSet
winset = Layout Window -> [WorkspaceId] -> WindowSet -> WindowSet
forall i l a s sd.
Eq i =>
l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
W.ensureTags Layout Window
layout (XConfig l -> [WorkspaceId]
forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces XConfig l
xmc) (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> Layout Window)
-> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
-> WindowSet
forall l l' i a s sd.
(l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
W.mapLayout (Layout Window -> Maybe (Layout Window) -> Layout Window
forall a. a -> Maybe a -> a
fromMaybe Layout Window
layout (Maybe (Layout Window) -> Layout Window)
-> (WorkspaceId -> Maybe (Layout Window))
-> WorkspaceId
-> Layout Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId -> [(Layout Window, WorkspaceId)])
-> WorkspaceId -> Maybe (Layout Window)
forall t a. (t -> [(a, WorkspaceId)]) -> t -> Maybe a
maybeRead WorkspaceId -> [(Layout Window, WorkspaceId)]
lreads) (StateFile
-> StackSet WorkspaceId WorkspaceId Window ScreenId ScreenDetail
sfWins StateFile
sf)
          extState :: Map WorkspaceId (Either WorkspaceId b)
extState = [(WorkspaceId, Either WorkspaceId b)]
-> Map WorkspaceId (Either WorkspaceId b)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(WorkspaceId, Either WorkspaceId b)]
 -> Map WorkspaceId (Either WorkspaceId b))
-> ([(WorkspaceId, WorkspaceId)]
    -> [(WorkspaceId, Either WorkspaceId b)])
-> [(WorkspaceId, WorkspaceId)]
-> Map WorkspaceId (Either WorkspaceId b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WorkspaceId, WorkspaceId) -> (WorkspaceId, Either WorkspaceId b))
-> [(WorkspaceId, WorkspaceId)]
-> [(WorkspaceId, Either WorkspaceId b)]
forall a b. (a -> b) -> [a] -> [b]
map ((WorkspaceId -> Either WorkspaceId b)
-> (WorkspaceId, WorkspaceId)
-> (WorkspaceId, Either WorkspaceId b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second WorkspaceId -> Either WorkspaceId b
forall a b. a -> Either a b
Left) ([(WorkspaceId, WorkspaceId)]
 -> Map WorkspaceId (Either WorkspaceId b))
-> [(WorkspaceId, WorkspaceId)]
-> Map WorkspaceId (Either WorkspaceId b)
forall a b. (a -> b) -> a -> b
$ StateFile -> [(WorkspaceId, WorkspaceId)]
sfExt StateFile
sf

      XState -> Maybe XState
forall (m :: * -> *) a. Monad m => a -> m a
return XState :: WindowSet
-> Set Window
-> Map Window Int
-> Maybe (Position -> Position -> X (), X ())
-> ButtonMask
-> Map WorkspaceId (Either WorkspaceId StateExtension)
-> XState
XState { windowset :: WindowSet
windowset       = WindowSet
winset
                    , numberlockMask :: ButtonMask
numberlockMask  = ButtonMask
0
                    , mapped :: Set Window
mapped          = Set Window
forall a. Set a
S.empty
                    , waitingUnmap :: Map Window Int
waitingUnmap    = Map Window Int
forall k a. Map k a
M.empty
                    , dragging :: Maybe (Position -> Position -> X (), X ())
dragging        = Maybe (Position -> Position -> X (), X ())
forall a. Maybe a
Nothing
                    , extensibleState :: Map WorkspaceId (Either WorkspaceId StateExtension)
extensibleState = Map WorkspaceId (Either WorkspaceId StateExtension)
forall b. Map WorkspaceId (Either WorkspaceId b)
extState
                    }
  where
    layout :: Layout Window
layout = l Window -> Layout Window
forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout (XConfig l -> l Window
forall (l :: * -> *). XConfig l -> l Window
layoutHook XConfig l
xmc)
    lreads :: WorkspaceId -> [(Layout Window, WorkspaceId)]
lreads = Layout Window -> WorkspaceId -> [(Layout Window, WorkspaceId)]
forall a. Layout a -> WorkspaceId -> [(Layout a, WorkspaceId)]
readsLayout Layout Window
layout
    maybeRead :: (t -> [(a, WorkspaceId)]) -> t -> Maybe a
maybeRead t -> [(a, WorkspaceId)]
reads' t
s = case t -> [(a, WorkspaceId)]
reads' t
s of
                           [(a
x, WorkspaceId
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                           [(a, WorkspaceId)]
_         -> Maybe a
forall a. Maybe a
Nothing

    readStrict :: Handle -> IO String
    readStrict :: Handle -> IO WorkspaceId
readStrict Handle
h = Handle -> IO WorkspaceId
hGetContents Handle
h IO WorkspaceId -> (WorkspaceId -> IO WorkspaceId) -> IO WorkspaceId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WorkspaceId
s -> WorkspaceId -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WorkspaceId
s Int -> IO WorkspaceId -> IO WorkspaceId
`seq` WorkspaceId -> IO WorkspaceId
forall (m :: * -> *) a. Monad m => a -> m a
return WorkspaceId
s

-- | @restart name resume@ attempts to restart xmonad by executing the program
-- @name@. If @resume@ is 'True', restart with the current window state.
-- When executing another window manager, @resume@ should be 'False'.
restart :: String -> Bool -> X ()
restart :: WorkspaceId -> Bool -> X ()
restart WorkspaceId
prog Bool
resume = do
    LayoutMessages -> X ()
forall a. Message a => a -> X ()
broadcastMessage LayoutMessages
ReleaseResources
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (Display -> IO ()) -> Display -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Display -> IO ()
flush (Display -> X ()) -> X Display -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
resume X ()
writeStateToFile
    IO () -> X ()
forall (m :: * -> *). MonadIO m => IO () -> m ()
catchIO (WorkspaceId
-> Bool
-> [WorkspaceId]
-> Maybe [(WorkspaceId, WorkspaceId)]
-> IO ()
forall a.
WorkspaceId
-> Bool
-> [WorkspaceId]
-> Maybe [(WorkspaceId, WorkspaceId)]
-> IO a
executeFile WorkspaceId
prog Bool
True [] Maybe [(WorkspaceId, WorkspaceId)]
forall a. Maybe a
Nothing)

------------------------------------------------------------------------
-- Floating layer support

-- | Given a window, find the screen it is located on, and compute
-- the geometry of that window WRT that screen.
floatLocation :: Window -> X (ScreenId, W.RationalRect)
floatLocation :: Window -> X (ScreenId, RationalRect)
floatLocation Window
w =
    X (ScreenId, RationalRect)
-> X (ScreenId, RationalRect) -> X (ScreenId, RationalRect)
forall a. X a -> X a -> X a
catchX X (ScreenId, RationalRect)
go (X (ScreenId, RationalRect) -> X (ScreenId, RationalRect))
-> X (ScreenId, RationalRect) -> X (ScreenId, RationalRect)
forall a b. (a -> b) -> a -> b
$ do
      -- Fallback solution if `go' fails.  Which it might, since it
      -- calls `getWindowAttributes'.
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc <- WindowSet
-> Screen WorkspaceId (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
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X WindowSet
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
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
      (ScreenId, RationalRect) -> X (ScreenId, RationalRect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc, Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1)

  where fi :: a -> b
fi a
x = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
        go :: X (ScreenId, RationalRect)
go = (Display -> X (ScreenId, RationalRect))
-> X (ScreenId, RationalRect)
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (ScreenId, RationalRect))
 -> X (ScreenId, RationalRect))
-> (Display -> X (ScreenId, RationalRect))
-> X (ScreenId, RationalRect)
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
          WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
          WindowAttributes
wa <- IO WindowAttributes -> X WindowAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WindowAttributes -> X WindowAttributes)
-> IO WindowAttributes -> X WindowAttributes
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
          let bw :: CInt
bw = (CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> CInt)
-> (WindowAttributes -> CInt) -> WindowAttributes -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowAttributes -> CInt
wa_border_width) WindowAttributes
wa
          Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
point_sc <- Position
-> Position
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
pointScreen (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa)
          Bool
managed <- Window -> X Bool
isClient Window
w

          -- ignore pointScreen for new windows unless it's the current
          -- screen, otherwise the float's relative size is computed against
          -- a different screen and the float ends up with the wrong size
          let sr_eq :: Maybe (Screen i l a sid ScreenDetail)
-> Maybe (Screen i l a sid ScreenDetail) -> Bool
sr_eq = Maybe Rectangle -> Maybe Rectangle -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Rectangle -> Maybe Rectangle -> Bool)
-> (Maybe (Screen i l a sid ScreenDetail) -> Maybe Rectangle)
-> Maybe (Screen i l a sid ScreenDetail)
-> Maybe (Screen i l a sid ScreenDetail)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Screen i l a sid ScreenDetail -> Rectangle)
-> Maybe (Screen i l a sid ScreenDetail) -> Maybe Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (Screen i l a sid ScreenDetail -> ScreenDetail)
-> Screen i l a sid ScreenDetail
-> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a sid ScreenDetail -> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail)
              sc :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a. a -> Maybe a -> a
fromMaybe (WindowSet
-> Screen WorkspaceId (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
ws) (Maybe
   (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$
                  if Bool
managed Bool -> Bool -> Bool
|| Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
point_sc Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Bool
forall i l a sid.
Maybe (Screen i l a sid ScreenDetail)
-> Maybe (Screen i l a sid ScreenDetail) -> Bool
`sr_eq` Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a. a -> Maybe a
Just (WindowSet
-> Screen WorkspaceId (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
ws) then Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
point_sc else Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a. Maybe a
Nothing
              sr :: Rectangle
sr = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenDetail)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Rectangle)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc
              x :: Rational
x = (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_x WindowAttributes
wa) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_x Rectangle
sr)) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
sr)
              y :: Rational
y = (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_y WindowAttributes
wa) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_y Rectangle
sr)) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
sr)
              width :: Rational
width  = CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_width  WindowAttributes
wa CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
bwCInt -> CInt -> CInt
forall a. Num a => a -> a -> a
*CInt
2) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
sr)
              height :: Rational
height = CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_height WindowAttributes
wa CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
bwCInt -> CInt -> CInt
forall a. Num a => a -> a -> a
*CInt
2) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
sr)
              -- adjust x/y of unmanaged windows if we ignored or didn't get pointScreen,
              -- it might be out of bounds otherwise
              rr :: RationalRect
rr = if Bool
managed Bool -> Bool -> Bool
|| Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
point_sc Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Bool
forall i l a sid.
Maybe (Screen i l a sid ScreenDetail)
-> Maybe (Screen i l a sid ScreenDetail) -> Bool
`sr_eq` Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a. a -> Maybe a
Just Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc
                  then Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
x Rational
y Rational
width Rational
height
                  else Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
widthRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
heightRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) Rational
width Rational
height

          (ScreenId, RationalRect) -> X (ScreenId, RationalRect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc, RationalRect
rr)

-- | Given a point, determine the screen (if any) that contains it.
pointScreen :: Position -> Position
            -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
pointScreen :: Position
-> Position
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
pointScreen Position
x Position
y = (WindowSet
 -> X (Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)))
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet
  -> X (Maybe
          (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)))
 -> X (Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)))
-> (WindowSet
    -> X (Maybe
            (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)))
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
forall a b. (a -> b) -> a -> b
$ Maybe
  (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X (Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)))
-> (WindowSet
    -> Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> WindowSet
-> X (Maybe
        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall i l a sid. Screen i l a sid ScreenDetail -> Bool
p ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> Maybe
      (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> (WindowSet
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> WindowSet
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.screens
  where p :: Screen i l a sid ScreenDetail -> Bool
p = Position -> Position -> Rectangle -> Bool
pointWithin Position
x Position
y (Rectangle -> Bool)
-> (Screen i l a sid ScreenDetail -> Rectangle)
-> Screen i l a sid ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (Screen i l a sid ScreenDetail -> ScreenDetail)
-> Screen i l a sid ScreenDetail
-> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a sid ScreenDetail -> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail

-- | @pointWithin x y r@ returns 'True' if the @(x, y)@ co-ordinate is within
-- @r@.
pointWithin :: Position -> Position -> Rectangle -> Bool
pointWithin :: Position -> Position -> Rectangle -> Bool
pointWithin Position
x Position
y Rectangle
r = Position
x Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Rectangle -> Position
rect_x Rectangle
r Bool -> Bool -> Bool
&&
                    Position
x Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<  Rectangle -> Position
rect_x Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
r) Bool -> Bool -> Bool
&&
                    Position
y Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Rectangle -> Position
rect_y Rectangle
r Bool -> Bool -> Bool
&&
                    Position
y Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<  Rectangle -> Position
rect_y Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_height Rectangle
r)

-- | Make a tiled window floating, using its suggested rectangle
float :: Window -> X ()
float :: Window -> X ()
float Window
w = do
    (ScreenId
sc, RationalRect
rr) <- Window -> X (ScreenId, RationalRect)
floatLocation Window
w
    (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> Window -> RationalRect -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w RationalRect
rr (WindowSet -> WindowSet)
-> (Maybe WindowSet -> WindowSet) -> Maybe WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe WindowSet -> WindowSet
forall a. a -> Maybe a -> a
fromMaybe WindowSet
ws (Maybe WindowSet -> WindowSet) -> Maybe WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ do
        WorkspaceId
i  <- Window -> WindowSet -> Maybe WorkspaceId
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w WindowSet
ws
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
i WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.screens WindowSet
ws)
        Window
f  <- WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws
        WorkspaceId
sw <- ScreenId -> WindowSet -> Maybe WorkspaceId
forall s i l a sd. Eq s => s -> StackSet i l a s sd -> Maybe i
W.lookupWorkspace ScreenId
sc WindowSet
ws
        WindowSet -> Maybe WindowSet
forall (m :: * -> *) a. Monad m => a -> m a
return (Window -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
f (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> Window -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
sw Window
w (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ WindowSet
ws)

-- ---------------------------------------------------------------------
-- Mouse handling

-- | Accumulate mouse motion events
mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
mouseDrag Position -> Position -> X ()
f X ()
done = do
    Maybe (Position -> Position -> X (), X ())
drag <- (XState -> Maybe (Position -> Position -> X (), X ()))
-> X (Maybe (Position -> Position -> X (), X ()))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Maybe (Position -> Position -> X (), X ())
dragging
    case Maybe (Position -> Position -> X (), X ())
drag of
        Just (Position -> Position -> X (), X ())
_ -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- error case? we're already dragging
        Maybe (Position -> Position -> X (), X ())
Nothing -> do
            XConf { theRoot :: XConf -> Window
theRoot = Window
root, display :: XConf -> Display
display = Display
d } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
            IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Bool
-> Window
-> CInt
-> CInt
-> Window
-> Window
-> Window
-> IO CInt
grabPointer Display
d Window
root Bool
False (Window
buttonReleaseMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
pointerMotionMask)
                    CInt
grabModeAsync CInt
grabModeAsync Window
none Window
none Window
currentTime
            (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
forall a b. (a -> b) -> a -> b
$ \XState
s -> XState
s { dragging :: Maybe (Position -> Position -> X (), X ())
dragging = (Position -> Position -> X (), X ())
-> Maybe (Position -> Position -> X (), X ())
forall a. a -> Maybe a
Just (Position -> Position -> X ()
motion, X ()
cleanup) }
 where
    cleanup :: X ()
cleanup = do
        (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (Display -> IO ()) -> Display -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Display -> Window -> IO ()) -> Window -> Display -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Display -> Window -> IO ()
ungrabPointer Window
currentTime
        (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
forall a b. (a -> b) -> a -> b
$ \XState
s -> XState
s { dragging :: Maybe (Position -> Position -> X (), X ())
dragging = Maybe (Position -> Position -> X (), X ())
forall a. Maybe a
Nothing }
        X ()
done
    motion :: Position -> Position -> X ()
motion Position
x Position
y = do ()
z <- Position -> Position -> X ()
f Position
x Position
y
                    Window -> X ()
clearEvents Window
pointerMotionMask
                    () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
z

-- | Drag the window under the cursor with the mouse while it is dragged.
mouseMoveWindow :: Window -> X ()
mouseMoveWindow :: Window -> X ()
mouseMoveWindow Window
w = X Bool -> X () -> X ()
whenX (Window -> X Bool
isClient Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    WindowAttributes
wa <- IO WindowAttributes -> X WindowAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WindowAttributes -> X WindowAttributes)
-> IO WindowAttributes -> X WindowAttributes
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
    (Bool
_, Window
_, Window
_, CInt
ox', CInt
oy', CInt
_, CInt
_, ButtonMask
_) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, ButtonMask)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, ButtonMask)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, ButtonMask)
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, ButtonMask))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, ButtonMask)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, ButtonMask)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, ButtonMask)
queryPointer Display
d Window
w
    let ox :: Position
ox = CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ox'
        oy :: Position
oy = CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
oy'
    (Position -> Position -> X ()) -> X () -> X ()
mouseDrag (\Position
ex Position
ey -> do
                  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Position -> Position -> IO ()
moveWindow Display
d Window
w (Position -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_x WindowAttributes
wa) Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Position
ex Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
ox)))
                                      (Position -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_y WindowAttributes
wa) Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Position
ey Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
oy)))
                  Window -> X ()
float Window
w
              )
              (Window -> X ()
float Window
w)

-- | Resize the window under the cursor with the mouse while it is dragged.
mouseResizeWindow :: Window -> X ()
mouseResizeWindow :: Window -> X ()
mouseResizeWindow Window
w = X Bool -> X () -> X ()
whenX (Window -> X Bool
isClient Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    WindowAttributes
wa <- IO WindowAttributes -> X WindowAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WindowAttributes -> X WindowAttributes)
-> IO WindowAttributes -> X WindowAttributes
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
    SizeHints
sh <- IO SizeHints -> X SizeHints
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO SizeHints -> X SizeHints) -> IO SizeHints -> X SizeHints
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO SizeHints
getWMNormalHints Display
d Window
w
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
warpPointer Display
d Window
none Window
w Position
0 Position
0 Dimension
0 Dimension
0 (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_width WindowAttributes
wa)) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_height WindowAttributes
wa))
    (Position -> Position -> X ()) -> X () -> X ()
mouseDrag (\Position
ex Position
ey -> do
                 IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Dimension -> Dimension -> IO ()
resizeWindow Display
d Window
w (Dimension -> Dimension -> IO ())
-> (Dimension, Dimension) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
`uncurry`
                    SizeHints -> (Position, Position) -> (Dimension, Dimension)
forall a.
Integral a =>
SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh (Position
ex Position -> Position -> Position
forall a. Num a => a -> a -> a
- CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_x WindowAttributes
wa),
                                               Position
ey Position -> Position -> Position
forall a. Num a => a -> a -> a
- CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_y WindowAttributes
wa))
                 Window -> X ()
float Window
w)

              (Window -> X ()
float Window
w)

-- ---------------------------------------------------------------------
-- Support for window size hints

-- | An alias for a (width, height) pair
type D = (Dimension, Dimension)

-- | Given a window, build an adjuster function that will reduce the given
-- dimensions according to the window's border width and size hints.
mkAdjust :: Window -> X (D -> D)
mkAdjust :: Window -> X ((Dimension, Dimension) -> (Dimension, Dimension))
mkAdjust Window
w = (Display -> X ((Dimension, Dimension) -> (Dimension, Dimension)))
-> X ((Dimension, Dimension) -> (Dimension, Dimension))
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ((Dimension, Dimension) -> (Dimension, Dimension)))
 -> X ((Dimension, Dimension) -> (Dimension, Dimension)))
-> (Display
    -> X ((Dimension, Dimension) -> (Dimension, Dimension)))
-> X ((Dimension, Dimension) -> (Dimension, Dimension))
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO ((Dimension, Dimension) -> (Dimension, Dimension))
-> X ((Dimension, Dimension) -> (Dimension, Dimension))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ((Dimension, Dimension) -> (Dimension, Dimension))
 -> X ((Dimension, Dimension) -> (Dimension, Dimension)))
-> IO ((Dimension, Dimension) -> (Dimension, Dimension))
-> X ((Dimension, Dimension) -> (Dimension, Dimension))
forall a b. (a -> b) -> a -> b
$ do
    SizeHints
sh <- Display -> Window -> IO SizeHints
getWMNormalHints Display
d Window
w
    Either SomeException WindowAttributes
wa <- IO WindowAttributes -> IO (Either SomeException WindowAttributes)
forall e a. Exception e => IO a -> IO (Either e a)
C.try (IO WindowAttributes -> IO (Either SomeException WindowAttributes))
-> IO WindowAttributes
-> IO (Either SomeException WindowAttributes)
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
    case Either SomeException WindowAttributes
wa of
         Left  SomeException
err -> IO ((Dimension, Dimension) -> (Dimension, Dimension))
-> SomeException
-> IO ((Dimension, Dimension) -> (Dimension, Dimension))
forall a b. a -> b -> a
const (((Dimension, Dimension) -> (Dimension, Dimension))
-> IO ((Dimension, Dimension) -> (Dimension, Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dimension, Dimension) -> (Dimension, Dimension)
forall a. a -> a
id) (SomeException
err :: C.SomeException)
         Right WindowAttributes
wa' ->
            let bw :: Dimension
bw = CInt -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Dimension) -> CInt -> Dimension
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_border_width WindowAttributes
wa'
            in  ((Dimension, Dimension) -> (Dimension, Dimension))
-> IO ((Dimension, Dimension) -> (Dimension, Dimension))
forall (m :: * -> *) a. Monad m => a -> m a
return (((Dimension, Dimension) -> (Dimension, Dimension))
 -> IO ((Dimension, Dimension) -> (Dimension, Dimension)))
-> ((Dimension, Dimension) -> (Dimension, Dimension))
-> IO ((Dimension, Dimension) -> (Dimension, Dimension))
forall a b. (a -> b) -> a -> b
$ Dimension
-> SizeHints -> (Dimension, Dimension) -> (Dimension, Dimension)
forall a.
Integral a =>
Dimension -> SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHints Dimension
bw SizeHints
sh

-- | Reduce the dimensions if needed to comply to the given SizeHints, taking
-- window borders into account.
applySizeHints :: Integral a => Dimension -> SizeHints -> (a, a) -> D
applySizeHints :: Dimension -> SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHints Dimension
bw SizeHints
sh =
    (Dimension -> Dimension)
-> (Dimension, Dimension) -> (Dimension, Dimension)
forall t b. (t -> b) -> (t, t) -> (b, b)
tmap (Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
bw) ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((a, a) -> (Dimension, Dimension))
-> (a, a)
-> (Dimension, Dimension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeHints -> (a, a) -> (Dimension, Dimension)
forall a.
Integral a =>
SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh ((a, a) -> (Dimension, Dimension))
-> ((a, a) -> (a, a)) -> (a, a) -> (Dimension, Dimension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> (a, a) -> (a, a)
forall t b. (t -> b) -> (t, t) -> (b, b)
tmap (a -> a -> a
forall a. Num a => a -> a -> a
subtract (a -> a -> a) -> a -> a -> a
forall a b. (a -> b) -> a -> b
$ a
2 a -> a -> a
forall a. Num a => a -> a -> a
* Dimension -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
bw)
    where
    tmap :: (t -> b) -> (t, t) -> (b, b)
tmap t -> b
f (t
x, t
y) = (t -> b
f t
x, t -> b
f t
y)

-- | Reduce the dimensions if needed to comply to the given SizeHints.
applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D
applySizeHintsContents :: SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh (a
w, a
h) =
    SizeHints -> (Dimension, Dimension) -> (Dimension, Dimension)
applySizeHints' SizeHints
sh (a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Dimension) -> a -> Dimension
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max a
1 a
w, a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Dimension) -> a -> Dimension
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max a
1 a
h)

-- | Use X11 size hints to scale a pair of dimensions.
applySizeHints' :: SizeHints -> D -> D
applySizeHints' :: SizeHints -> (Dimension, Dimension) -> (Dimension, Dimension)
applySizeHints' SizeHints
sh =
      ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension)
    -> (Dimension, Dimension) -> (Dimension, Dimension))
-> Maybe (Dimension, Dimension)
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Dimension, Dimension) -> (Dimension, Dimension)
forall a. a -> a
id (Dimension, Dimension)
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyMaxSizeHint                   (SizeHints -> Maybe (Dimension, Dimension)
sh_max_size   SizeHints
sh)
    ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension) -> (Dimension, Dimension))
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension)
    -> (Dimension, Dimension) -> (Dimension, Dimension))
-> Maybe (Dimension, Dimension)
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Dimension, Dimension) -> (Dimension, Dimension)
forall a. a -> a
id (\(Dimension
bw, Dimension
bh) (Dimension
w, Dimension
h) -> (Dimension
wDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+Dimension
bw, Dimension
hDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+Dimension
bh)) (SizeHints -> Maybe (Dimension, Dimension)
sh_base_size  SizeHints
sh)
    ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension) -> (Dimension, Dimension))
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension)
    -> (Dimension, Dimension) -> (Dimension, Dimension))
-> Maybe (Dimension, Dimension)
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Dimension, Dimension) -> (Dimension, Dimension)
forall a. a -> a
id (Dimension, Dimension)
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyResizeIncHint                 (SizeHints -> Maybe (Dimension, Dimension)
sh_resize_inc SizeHints
sh)
    ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension) -> (Dimension, Dimension))
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dimension, Dimension) -> (Dimension, Dimension))
-> (((Dimension, Dimension), (Dimension, Dimension))
    -> (Dimension, Dimension) -> (Dimension, Dimension))
-> Maybe ((Dimension, Dimension), (Dimension, Dimension))
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Dimension, Dimension) -> (Dimension, Dimension)
forall a. a -> a
id ((Dimension, Dimension), (Dimension, Dimension))
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyAspectHint                    (SizeHints -> Maybe ((Dimension, Dimension), (Dimension, Dimension))
sh_aspect     SizeHints
sh)
    ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension) -> (Dimension, Dimension))
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dimension, Dimension) -> (Dimension, Dimension))
-> ((Dimension, Dimension)
    -> (Dimension, Dimension) -> (Dimension, Dimension))
-> Maybe (Dimension, Dimension)
-> (Dimension, Dimension)
-> (Dimension, Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Dimension, Dimension) -> (Dimension, Dimension)
forall a. a -> a
id (\(Dimension
bw,Dimension
bh) (Dimension
w,Dimension
h)   -> (Dimension
wDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
bw, Dimension
hDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
bh)) (SizeHints -> Maybe (Dimension, Dimension)
sh_base_size  SizeHints
sh)

-- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios.
applyAspectHint :: (D, D) -> D -> D
applyAspectHint :: ((Dimension, Dimension), (Dimension, Dimension))
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyAspectHint ((Dimension
minx, Dimension
miny), (Dimension
maxx, Dimension
maxy)) x :: (Dimension, Dimension)
x@(Dimension
w,Dimension
h)
    | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Dimension
minx Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
< Dimension
1, Dimension
miny Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
< Dimension
1, Dimension
maxx Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
< Dimension
1, Dimension
maxy Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
< Dimension
1] = (Dimension, Dimension)
x
    | Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
maxy Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
> Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
maxx                         = (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
maxx Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
maxy, Dimension
h)
    | Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
miny Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
< Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
minx                         = (Dimension
w, Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
miny Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
minx)
    | Bool
otherwise                                   = (Dimension, Dimension)
x

-- | Reduce the dimensions so they are a multiple of the size increments.
applyResizeIncHint :: D -> D -> D
applyResizeIncHint :: (Dimension, Dimension)
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyResizeIncHint (Dimension
iw,Dimension
ih) x :: (Dimension, Dimension)
x@(Dimension
w,Dimension
h) =
    if Dimension
iw Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
> Dimension
0 Bool -> Bool -> Bool
&& Dimension
ih Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
> Dimension
0 then (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
w Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`mod` Dimension
iw, Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
h Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`mod` Dimension
ih) else (Dimension, Dimension)
x

-- | Reduce the dimensions if they exceed the given maximum dimensions.
applyMaxSizeHint  :: D -> D -> D
applyMaxSizeHint :: (Dimension, Dimension)
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyMaxSizeHint (Dimension
mw,Dimension
mh) x :: (Dimension, Dimension)
x@(Dimension
w,Dimension
h) =
    if Dimension
mw Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
> Dimension
0 Bool -> Bool -> Bool
&& Dimension
mh Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
> Dimension
0 then (Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
w Dimension
mw,Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
h Dimension
mh) else (Dimension, Dimension)
x