{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- --------------------------------------------------------------------------
-- |
-- 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, isFixedSizeOrTransient,

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

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

    -- * Messages
    sendMessage, broadcastMessage, sendMessageWithNoRefresh,
    sendRestart, sendReplace,

    -- * 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, setBit, 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.Fix (fix)
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad (forM, forM_, guard, join, unless, void, when)
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

-- | Detect whether a window has fixed size or is transient. This check
-- can be used to determine whether the window should be floating or not
--
isFixedSizeOrTransient :: Display -> Window -> X Bool
isFixedSizeOrTransient :: Display -> Pixel -> X Bool
isFixedSizeOrTransient Display
d Pixel
w = do
    SizeHints
sh <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO SizeHints
getWMNormalHints Display
d Pixel
w
    let isFixedSize :: Bool
isFixedSize = forall a. Maybe a -> Bool
isJust (SizeHints -> Maybe (Dimension, Dimension)
sh_min_size SizeHints
sh) Bool -> Bool -> Bool
&& SizeHints -> Maybe (Dimension, Dimension)
sh_min_size SizeHints
sh forall a. Eq a => a -> a -> Bool
== SizeHints -> Maybe (Dimension, Dimension)
sh_max_size SizeHints
sh
    Bool
isTransient <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> Pixel -> IO (Maybe Pixel)
getTransientForHint Display
d Pixel
w)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isFixedSize Bool -> Bool -> Bool
|| Bool
isTransient)

-- |
-- 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 :: Pixel -> X ()
manage Pixel
w = X Bool -> X () -> X ()
whenX (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pixel -> X Bool
isClient Pixel
w) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do

    Bool
shouldFloat <- Display -> Pixel -> X Bool
isFixedSizeOrTransient Display
d Pixel
w

    RationalRect
rr <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pixel -> X (ScreenId, RationalRect)
floatLocation Pixel
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 forall a. Num a => a -> a -> a
+ Rational
wid forall a. Ord a => a -> a -> Bool
> Rational
1 Bool -> Bool -> Bool
|| Rational
y forall a. Num a => a -> a -> a
+ Rational
h forall a. Ord a => a -> a -> Bool
> Rational
1 Bool -> Bool -> Bool
|| Rational
x forall a. Ord a => a -> a -> Bool
< Rational
0 Bool -> Bool -> Bool
|| Rational
y forall a. Ord a => a -> a -> Bool
< Rational
0
                                              = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect (Rational
0.5 forall a. Num a => a -> a -> a
- Rational
widforall a. Fractional a => a -> a -> a
/Rational
2) (Rational
0.5 forall a. Num a => a -> a -> a
- Rational
hforall a. Fractional a => a -> a -> a
/Rational
2) Rational
wid Rational
h
        adjust RationalRect
r = RationalRect
r

        f :: StackSet i l Pixel s sd -> StackSet i l Pixel s sd
f StackSet i l Pixel s sd
ws | Bool
shouldFloat = forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Pixel
w (RationalRect -> RationalRect
adjust RationalRect
rr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp Pixel
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ StackSet i l Pixel s sd
ws
             | Bool
otherwise   = forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp Pixel
w StackSet i l Pixel s sd
ws
            where i :: i
i = forall i l a. Workspace i l a -> i
W.tag forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current StackSet i l Pixel s sd
ws

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

-- | A window no longer exists; remove it from the window
-- list, on whatever workspace it is.
--
unmanage :: Window -> X ()
unmanage :: Pixel -> X ()
unmanage = (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Pixel -> X ()
killWindow Pixel
w = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    Pixel
wmdelt <- X Pixel
atom_WM_DELETE_WINDOW  ;  Pixel
wmprot <- X Pixel
atom_WM_PROTOCOLS

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

-- | Kill the currently focused client.
kill :: X ()
kill :: X ()
kill = (Pixel -> X ()) -> X ()
withFocused Pixel -> 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 } <- forall s (m :: * -> *). MonadState s m => m s
get
    let oldvisible :: [Pixel]
oldvisible = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
old forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
old
        newwindows :: [Pixel]
newwindows = forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
ws forall a. Eq a => [a] -> [a] -> [a]
\\ 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 -> Pixel
normalBorder = Pixel
nbc, focusedBorder :: XConf -> Pixel
focusedBorder = Pixel
fbc } <- forall r (m :: * -> *). MonadReader r m => m r
ask

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

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

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

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

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

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

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

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

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

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

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

    -- hide every window that was potentially visible before, but is not
    -- given a position by a layout now.
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pixel -> X ()
hide (forall a. Eq a => [a] -> [a]
nub ([Pixel]
oldvisible forall a. [a] -> [a] -> [a]
++ [Pixel]
newwindows) forall a. Eq a => [a] -> [a] -> [a]
\\ [Pixel]
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
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Pixel -> Int -> X ()
`setWMState` Int
withdrawnState) (forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
old forall a. Eq a => [a] -> [a] -> [a]
\\ forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
ws)

    Bool
isMouseFocused <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Bool
mouseFocused
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isMouseFocused forall a b. (a -> b) -> a -> b
$ Pixel -> X ()
clearEvents Pixel
enterWindowMask
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> X ()
logHook forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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 :: forall a. (a -> Bool) -> X a -> X a
windowBracket a -> Bool
p X a
action = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
old -> do
  a
a <- X a
action
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
new -> do
    (WindowSet -> WindowSet) -> X ()
modifyWindowSet forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const WindowSet
old
    (WindowSet -> WindowSet) -> X ()
windows         forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const WindowSet
new
  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_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Num a => a -> a -> a
+ forall {b} {a}. (Integral b, Real a) => a -> Rational -> b
scale Dimension
sw Rational
rx) (Position
sy forall a. Num a => a -> a -> a
+ forall {b} {a}. (Integral b, Real a) => a -> Rational -> b
scale Dimension
sh Rational
ry) (forall {b} {a}. (Integral b, Real a) => a -> Rational -> b
scale Dimension
sw Rational
rw) (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 = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Real a => a -> Rational
toRational a
s forall a. Num a => a -> a -> a
* Rational
r)

-- | Set a window's WM_STATE property.
setWMState :: Window -> Int -> X ()
setWMState :: Pixel -> Int -> X ()
setWMState Pixel
w Int
v = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Pixel
a <- X Pixel
atom_WM_STATE
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> Pixel -> Pixel -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Pixel
w Pixel
a Pixel
a CInt
propModeReplace [forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v, forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel
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 -> Pixel -> WorkspaceId -> Pixel -> X ()
setWindowBorderWithFallback Display
dpy Pixel
w WorkspaceId
color Pixel
basic = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle SomeException -> IO ()
fallback forall a b. (a -> b) -> a -> b
$ do
      WindowAttributes
wa <- Display -> Pixel -> IO WindowAttributes
getWindowAttributes Display
dpy Pixel
w
      Pixel
pixel <- Pixel -> Pixel
setPixelSolid forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Pixel
color_pixel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Pixel -> WorkspaceId -> IO (Color, Color)
allocNamedColor Display
dpy (WindowAttributes -> Pixel
wa_colormap WindowAttributes
wa) WorkspaceId
color
      Display -> Pixel -> Pixel -> IO ()
setWindowBorder Display
dpy Pixel
w Pixel
pixel
  where
    fallback :: C.SomeException -> IO ()
    fallback :: SomeException -> IO ()
fallback SomeException
_ = Display -> Pixel -> Pixel -> IO ()
setWindowBorder Display
dpy Pixel
w Pixel
basic

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

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

-- | Remove all events of a given type from the event queue.
clearEvents :: EventMask -> X ()
clearEvents :: Pixel -> X ()
clearEvents Pixel
mask = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    Display -> Bool -> IO ()
sync Display
d Bool
False
    forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \IO ()
again -> do
        Bool
more <- Display -> Pixel -> XEventPtr -> IO Bool
checkMaskEvent Display
d Pixel
mask XEventPtr
p
        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 :: Pixel -> Rectangle -> X ()
tileWindow Pixel
w Rectangle
r = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> Display -> Pixel -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Pixel
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
    -- give all windows at least 1x1 pixels
    let bw :: Dimension
bw = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_border_width WindowAttributes
wa
        least :: Dimension -> Dimension
least Dimension
x | Dimension
x forall a. Ord a => a -> a -> Bool
<= Dimension
bwforall a. Num a => a -> a -> a
*Dimension
2  = Dimension
1
                | Bool
otherwise  = Dimension
x forall a. Num a => a -> a -> a
- Dimension
bwforall a. Num a => a -> a -> a
*Dimension
2
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Pixel -> Position -> Position -> Dimension -> Dimension -> IO ()
moveResizeWindow Display
d Pixel
w (Rectangle -> Position
rect_x Rectangle
r) (Rectangle -> Position
rect_y Rectangle
r)
                              (Dimension -> Dimension
least forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
r) (Dimension -> Dimension
least 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)
 = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Rectangle
r1 forall a. Eq a => a -> a -> Bool
/= Rectangle
r2
       , Position
x1 forall a. Ord a => a -> a -> Bool
>= Position
x2
       , Position
y1 forall a. Ord a => a -> a -> Bool
>= Position
y2
       , forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x1 forall a. Num a => a -> a -> a
+ Dimension
w1 forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x2 forall a. Num a => a -> a -> a
+ Dimension
w2
       , forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y1 forall a. Num a => a -> a -> a
+ Dimension
h1 forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y2 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 = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Rectangle
x -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Rectangle
x Rectangle -> Rectangle -> Bool
`containedIn`) [Rectangle]
xs) 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 :: forall (m :: * -> *). MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Rectangle] -> [Rectangle]
nubScreens 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 = forall a. (Display -> X a) -> X a
withDisplay forall (m :: * -> *). MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [] -> forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
trace WorkspaceId
"getCleanedScreenInfo returned []"
    Rectangle
xinesc:[Rectangle]
xinescs ->
        (WindowSet -> WindowSet) -> X ()
windows 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 Pixel) Pixel 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 Pixel) Pixel 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 Pixel) Pixel]
hs } ->
            let ([Workspace WorkspaceId (Layout Pixel) Pixel]
xs, [Workspace WorkspaceId (Layout Pixel) Pixel]
ys) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rectangle]
xinescs) (forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace [Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail]
vs forall a. [a] -> [a] -> [a]
++ [Workspace WorkspaceId (Layout Pixel) Pixel]
hs)
                a :: Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
a = forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
v) ScreenId
0 (Rectangle -> ScreenDetail
SD Rectangle
xinesc)
                as :: [Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail]
as = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen [Workspace WorkspaceId (Layout Pixel) Pixel]
xs [ScreenId
1..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> ScreenDetail
SD [Rectangle]
xinescs
            in  WindowSet
ws { current :: Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
W.current = Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
a
                   , visible :: [Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail]
W.visible = [Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail]
as
                   , hidden :: [Workspace WorkspaceId (Layout Pixel) Pixel]
W.hidden  = [Workspace WorkspaceId (Layout Pixel) Pixel]
ys }

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

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

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

-- | Set the focus to the window on top of the stack, or root
setTopFocus :: X ()
setTopFocus :: X ()
setTopFocus = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pixel -> X ()
setFocusX forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Pixel
theRoot) Pixel -> X ()
setFocusX forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Pixel -> X ()
focus Pixel
w = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\XConf
c -> XConf
c { mouseFocused :: Bool
mouseFocused = Bool
True }) forall a b. (a -> b) -> a -> b
$ forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
    let stag :: Screen c l a sid sd -> c
stag = forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace
        curr :: WorkspaceId
curr = forall {c} {l} {a} {sid} {sd}. Screen c l a sid sd -> c
stag forall a b. (a -> b) -> a -> b
$ 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {c} {l} {a} {sid} {sd}. Screen c l a sid sd -> c
stag) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Position
-> Position
-> X (Maybe
        (Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail))
pointScreen)
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Maybe (Position, Position)
mousePosition
    Pixel
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Pixel
theRoot
    case () of
        ()
_ | forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
W.member Pixel
w WindowSet
s Bool -> Bool -> Bool
&& forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
s forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Pixel
w -> (WindowSet -> WindowSet) -> X ()
windows (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 Pixel
w)
          | Just WorkspaceId
new <- Maybe WorkspaceId
mnew, Pixel
w forall a. Eq a => a -> a -> Bool
== Pixel
root Bool -> Bool -> Bool
&& WorkspaceId
curr forall a. Eq a => a -> a -> Bool
/= WorkspaceId
new
                                               -> (WindowSet -> WindowSet) -> X ()
windows (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                          -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

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

    WMHints
hints <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO WMHints
getWMHints Display
dpy Pixel
w
    [Pixel]
protocols <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO [Pixel]
getWMProtocols Display
dpy Pixel
w
    Pixel
wmprot <- X Pixel
atom_WM_PROTOCOLS
    Pixel
wmtf <- X Pixel
atom_WM_TAKE_FOCUS
    Maybe Event
currevt <- 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 forall a. Bits a => a -> Int -> Bool
`testBit` Int
inputHintBit

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

cacheNumlockMask :: X ()
cacheNumlockMask :: X ()
cacheNumlockMask = do
    Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    [(KeyMask, [KeyCode])]
ms <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> IO [(KeyMask, [KeyCode])]
getModifierMapping Display
dpy
    [KeyMask]
xs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ do Pixel
ks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> KeyCode -> CInt -> IO Pixel
keycodeToKeysym Display
dpy KeyCode
kc CInt
0
                        if Pixel
ks forall a. Eq a => a -> a -> Bool
== Pixel
xK_Num_Lock
                            then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Bits a => a -> Int -> a
setBit KeyMask
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyMask
m))
                            else forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
0 :: KeyMask)
                   | (KeyMask
m, [KeyCode]
kcs) <- [(KeyMask, [KeyCode])]
ms, KeyCode
kc <- [KeyCode]
kcs, KeyCode
kc forall a. Eq a => a -> a -> Bool
/= KeyCode
0
                   ]
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { numberlockMask :: KeyMask
numberlockMask = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) KeyMask
0 [KeyMask]
xs })

-- | Given a list of keybindings, turn the given 'KeySym's into actual
-- 'KeyCode's and prepare them for grabbing.
mkGrabs :: [(KeyMask, KeySym)] -> X [(KeyMask, KeyCode)]
mkGrabs :: [(KeyMask, Pixel)] -> X [(KeyMask, KeyCode)]
mkGrabs [(KeyMask, Pixel)]
ks = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    let (CInt
minCode, CInt
maxCode) = Display -> (CInt, CInt)
displayKeycodes Display
dpy
        allCodes :: [KeyCode]
allCodes = [forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
minCode .. forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
maxCode]
    -- build a map from keysyms to lists of keysyms (doing what
    -- XGetKeyboardMapping would do if the X11 package bound it)
    [Pixel]
syms <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [KeyCode]
allCodes forall a b. (a -> b) -> a -> b
$ \KeyCode
code -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> KeyCode -> CInt -> IO Pixel
keycodeToKeysym Display
dpy KeyCode
code CInt
0)
    let -- keycodeToKeysym returns noSymbol for all unbound keycodes,
        -- and we don't want to grab those whenever someone accidentally
        -- uses def :: KeySym
        keysymMap :: Map Pixel [KeyCode]
keysymMap = forall k a. Ord k => k -> Map k a -> Map k a
M.delete Pixel
noSymbol forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. [a] -> [a] -> [a]
(++) (forall a b. [a] -> [b] -> [(a, b)]
zip [Pixel]
syms [[KeyCode
code] | KeyCode
code <- [KeyCode]
allCodes])
        keysymToKeycodes :: Pixel -> [KeyCode]
keysymToKeycodes Pixel
sym = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Pixel
sym Map Pixel [KeyCode]
keysymMap
    [KeyMask]
extraMods <- X [KeyMask]
extraModifiers
    forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (KeyMask
mask forall a. Bits a => a -> a -> a
.|. KeyMask
extraMod, KeyCode
keycode)
         | (KeyMask
mask, Pixel
sym) <- [(KeyMask, Pixel)]
ks
         , KeyCode
keycode     <- Pixel -> [KeyCode]
keysymToKeycodes Pixel
sym
         , KeyMask
extraMod    <- [KeyMask]
extraMods
         ]

-- | Release XMonad's keyboard grab, so other grabbers can do their thing.
--
-- Start a keyboard action with this if it is going to run something
-- that needs to do a keyboard, pointer, or server grab. For example,
--
-- > , ((modm .|. controlMask, xK_p), unGrab >> spawn "scrot")
--
-- (Other examples are certain screen lockers and "gksu".)
-- This avoids needing to insert a pause/sleep before running the
-- command.
--
-- XMonad retains the keyboard grab during key actions because if they
-- use a submap, they need the keyboard to be grabbed, and if they had
-- to assert their own grab then the asynchronous nature of X11 allows
-- race conditions between XMonad, other clients, and the X server that
-- would cause keys to sometimes be "leaked" to the focused window.
unGrab :: X ()
unGrab :: X ()
unGrab = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    Display -> Pixel -> IO ()
ungrabKeyboard Display
d Pixel
currentTime
    Display -> Pixel -> IO ()
ungrabPointer  Display
d Pixel
currentTime
    Display -> Bool -> IO ()
sync Display
d Bool
False

------------------------------------------------------------------------
-- 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 :: forall a. Message a => a -> X ()
sendMessage a
a = X Any -> X ()
windowBracket_ forall a b. (a -> b) -> a -> b
$ do
    Workspace WorkspaceId (Layout Pixel) Pixel
w <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
    Maybe (Layout Pixel)
ml' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage (forall i l a. Workspace i l a -> l
W.layout Workspace WorkspaceId (Layout Pixel) Pixel
w) (forall a. Message a => a -> SomeMessage
SomeMessage a
a) forall a. X a -> X a -> X a
`catchX` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Layout Pixel)
ml' forall a b. (a -> b) -> a -> b
$ \Layout Pixel
l' ->
        (WindowSet -> WindowSet) -> X ()
modifyWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> WindowSet
ws { current :: Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
W.current = (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 Pixel) Pixel
W.workspace = (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws)
                                  { layout :: Layout Pixel
W.layout = Layout Pixel
l' }}}
    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Any
Any forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust Maybe (Layout Pixel)
ml')

-- | Send a message to all layouts, without refreshing.
broadcastMessage :: Message a => a -> X ()
broadcastMessage :: forall a. Message a => a -> X ()
broadcastMessage a
a = forall a. (WindowSet -> X a) -> X a
withWindowSet 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 Pixel) Pixel
c = forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ WindowSet
ws
        v :: [Workspace WorkspaceId (Layout Pixel) Pixel]
v = forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible forall a b. (a -> b) -> a -> b
$ WindowSet
ws
        h :: [Workspace WorkspaceId (Layout Pixel) Pixel]
h = forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden WindowSet
ws
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a.
Message a =>
a -> Workspace WorkspaceId (Layout Pixel) Pixel -> X ()
sendMessageWithNoRefresh a
a) (Workspace WorkspaceId (Layout Pixel) Pixel
c forall a. a -> [a] -> [a]
: [Workspace WorkspaceId (Layout Pixel) Pixel]
v forall a. [a] -> [a] -> [a]
++ [Workspace WorkspaceId (Layout Pixel) Pixel]
h)

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

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

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

-- | Signal xmonad to restart itself.
sendRestart :: IO ()
sendRestart :: IO ()
sendRestart = do
    Display
dpy <- WorkspaceId -> IO Display
openDisplay WorkspaceId
""
    Pixel
rw  <- Display -> Dimension -> IO Pixel
rootWindow Display
dpy forall a b. (a -> b) -> a -> b
$ Display -> Dimension
defaultScreen Display
dpy
    Pixel
xmonad_restart <- Display -> WorkspaceId -> Bool -> IO Pixel
internAtom Display
dpy WorkspaceId
"XMONAD_RESTART" Bool
False
    forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
        XEventPtr -> Dimension -> IO ()
setEventType XEventPtr
e Dimension
clientMessage
        XEventPtr -> Pixel -> Pixel -> CInt -> [CInt] -> IO ()
setClientMessageEvent' XEventPtr
e Pixel
rw Pixel
xmonad_restart CInt
32 []
        Display -> Pixel -> Bool -> Pixel -> XEventPtr -> IO ()
sendEvent Display
dpy Pixel
rw Bool
False Pixel
structureNotifyMask XEventPtr
e
    Display -> Bool -> IO ()
sync Display
dpy Bool
False

-- | Signal compliant window managers to exit.
sendReplace :: IO ()
sendReplace :: IO ()
sendReplace = do
    Display
dpy <- WorkspaceId -> IO Display
openDisplay WorkspaceId
""
    let dflt :: Dimension
dflt = Display -> Dimension
defaultScreen Display
dpy
    Pixel
rootw <- Display -> Dimension -> IO Pixel
rootWindow Display
dpy Dimension
dflt
    Display -> Dimension -> Pixel -> IO ()
replace Display
dpy Dimension
dflt Pixel
rootw

-- | Signal compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO ()
replace :: Display -> Dimension -> Pixel -> IO ()
replace Display
dpy Dimension
dflt Pixel
rootw = do
    -- check for other WM
    Pixel
wmSnAtom <- Display -> WorkspaceId -> Bool -> IO Pixel
internAtom Display
dpy (WorkspaceId
"WM_S" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show Dimension
dflt) Bool
False
    Pixel
currentWmSnOwner <- Display -> Pixel -> IO Pixel
xGetSelectionOwner Display
dpy Pixel
wmSnAtom
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Pixel
currentWmSnOwner forall a. Eq a => a -> a -> Bool
/= Pixel
0) forall a b. (a -> b) -> a -> b
$ do
        -- prepare to receive destroyNotify for old WM
        Display -> Pixel -> Pixel -> IO ()
selectInput Display
dpy Pixel
currentWmSnOwner Pixel
structureNotifyMask

        -- create off-screen window
        Pixel
netWmSnOwner <- forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes forall a b. (a -> b) -> a -> b
$ \Ptr SetWindowAttributes
attributes -> do
            Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
True
            Ptr SetWindowAttributes -> Pixel -> IO ()
set_event_mask Ptr SetWindowAttributes
attributes Pixel
propertyChangeMask
            let screen :: Screen
screen = Display -> Screen
defaultScreenOfDisplay Display
dpy
                visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
screen
                attrmask :: Pixel
attrmask = Pixel
cWOverrideRedirect forall a. Bits a => a -> a -> a
.|. Pixel
cWEventMask
            Display
-> Pixel
-> Position
-> Position
-> Dimension
-> Dimension
-> CInt
-> CInt
-> CInt
-> Visual
-> Pixel
-> Ptr SetWindowAttributes
-> IO Pixel
createWindow Display
dpy Pixel
rootw (-Position
100) (-Position
100) Dimension
1 Dimension
1 CInt
0 CInt
copyFromParent CInt
copyFromParent Visual
visual Pixel
attrmask Ptr SetWindowAttributes
attributes

        -- try to acquire wmSnAtom, this should signal the old WM to terminate
        Display -> Pixel -> Pixel -> Pixel -> IO ()
xSetSelectionOwner Display
dpy Pixel
wmSnAtom Pixel
netWmSnOwner Pixel
currentTime

        -- SKIPPED: check if we acquired the selection
        -- SKIPPED: send client message indicating that we are now the WM

        -- wait for old WM to go away
        forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \IO ()
again -> do
            Dimension
evt <- forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
event -> do
                Display -> Pixel -> Pixel -> XEventPtr -> IO ()
windowEvent Display
dpy Pixel
currentWmSnOwner Pixel
structureNotifyMask XEventPtr
event
                XEventPtr -> IO Dimension
get_EventType XEventPtr
event

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Dimension
evt forall a. Eq a => a -> a -> Bool
/= Dimension
destroyNotify) IO ()
again

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

-- | Return workspace visible on screen @sc@, or 'Nothing'.
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
sc = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: (Pixel -> X ()) -> X ()
withFocused Pixel -> X ()
f = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
w -> forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
w) Pixel -> X ()
f

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

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

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

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

-- | Set the 'Pixel' alpha value to 255.
setPixelSolid :: Pixel -> Pixel
setPixelSolid :: Pixel -> Pixel
setPixelSolid Pixel
p = Pixel
p forall a. Bits a => a -> a -> a
.|. Pixel
0xff000000

-- | Get the 'Pixel' value for a named color.
initColor :: Display -> String -> IO (Maybe Pixel)
initColor :: Display -> WorkspaceId -> IO (Maybe Pixel)
initColor Display
dpy WorkspaceId
c = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle (\(C.SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
    forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel -> Pixel
setPixelSolid forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Pixel
color_pixel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Pixel -> WorkspaceId -> IO (Color, Color)
allocNamedColor Display
dpy Pixel
colormap WorkspaceId
c
    where colormap :: Pixel
colormap = Display -> Dimension -> Pixel
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 Pixel ScreenId ScreenDetail
sfWins :: W.StackSet  WorkspaceId String Window ScreenId ScreenDetail
  , StateFile -> [(WorkspaceId, WorkspaceId)]
sfExt  :: [(String, String)]
  } deriving (Int -> StateFile -> ShowS
[StateFile] -> ShowS
StateFile -> WorkspaceId
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]
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)) = forall a. a -> Maybe a
Just (a
t, forall a. Show a => a -> WorkspaceId
show a
ext)
        maybeShow (a
t, Left WorkspaceId
str) = forall a. a -> Maybe a
Just (a
t, WorkspaceId
str)
        maybeShow (a, Either WorkspaceId StateExtension)
_ = forall a. Maybe a
Nothing

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

    WorkspaceId
path <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ Directories -> WorkspaceId
stateFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories
    StateFile
stateData <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\XState
s -> StackSet WorkspaceId WorkspaceId Pixel ScreenId ScreenDetail
-> [(WorkspaceId, WorkspaceId)] -> StateFile
StateFile (XState
-> StackSet WorkspaceId WorkspaceId Pixel ScreenId ScreenDetail
wsData XState
s) (XState -> [(WorkspaceId, WorkspaceId)]
extState XState
s))
    forall (m :: * -> *). MonadIO m => IO () -> m ()
catchIO (WorkspaceId -> WorkspaceId -> IO ()
writeFile WorkspaceId
path forall a b. (a -> b) -> a -> b
$ 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 :: forall (l :: * -> *).
(LayoutClass l Pixel, Read (l Pixel)) =>
XConfig l -> X (Maybe XState)
readStateFile XConfig l
xmc = do
    WorkspaceId
path <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ Directories -> WorkspaceId
stateFileName 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' <- forall a. X a -> X (Maybe a)
userCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
        WorkspaceId
raw <- forall r. WorkspaceId -> IOMode -> (Handle -> IO r) -> IO r
withFile WorkspaceId
path IOMode
ReadMode Handle -> IO WorkspaceId
readStrict
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {t} {a}. (t -> [(a, WorkspaceId)]) -> t -> Maybe a
maybeRead forall a. Read a => ReadS a
reads WorkspaceId
raw

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

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

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

      forall (m :: * -> *) a. Monad m => a -> m a
return XState { windowset :: WindowSet
windowset       = WindowSet
winset
                    , numberlockMask :: KeyMask
numberlockMask  = KeyMask
0
                    , mapped :: Set Pixel
mapped          = forall a. Set a
S.empty
                    , waitingUnmap :: Map Pixel Int
waitingUnmap    = forall k a. Map k a
M.empty
                    , dragging :: Maybe (Position -> Position -> X (), X ())
dragging        = forall a. Maybe a
Nothing
                    , extensibleState :: Map WorkspaceId (Either WorkspaceId StateExtension)
extensibleState = forall {b}. Map WorkspaceId (Either WorkspaceId b)
extState
                    }
  where
    layout :: Layout Pixel
layout = forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout (forall (l :: * -> *). XConfig l -> l Pixel
layoutHook XConfig l
xmc)
    lreads :: WorkspaceId -> [(Layout Pixel, WorkspaceId)]
lreads = forall a. Layout a -> WorkspaceId -> [(Layout a, WorkspaceId)]
readsLayout Layout Pixel
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
"")] -> forall a. a -> Maybe a
Just a
x
                           [(a, WorkspaceId)]
_         -> forall a. Maybe a
Nothing

    readStrict :: Handle -> IO String
    readStrict :: Handle -> IO WorkspaceId
readStrict Handle
h = Handle -> IO WorkspaceId
hGetContents Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WorkspaceId
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length WorkspaceId
s seq :: forall a b. a -> b -> b
`seq` 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
    forall a. Message a => a -> X ()
broadcastMessage LayoutMessages
ReleaseResources
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. Display -> IO ()
flush forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
resume X ()
writeStateToFile
    forall (m :: * -> *). MonadIO m => IO () -> m ()
catchIO (forall a.
WorkspaceId
-> Bool
-> [WorkspaceId]
-> Maybe [(WorkspaceId, WorkspaceId)]
-> IO a
executeFile WorkspaceId
prog Bool
True [] 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 :: Pixel -> X (ScreenId, RationalRect)
floatLocation Pixel
w =
    forall a. X a -> X a -> X a
catchX X (ScreenId, RationalRect)
go forall a b. (a -> b) -> a -> b
$ do
      -- Fallback solution if `go' fails.  Which it might, since it
      -- calls `getWindowAttributes'.
      Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
sc <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
sc, Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1)

  where go :: X (ScreenId, RationalRect)
go = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
          WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
          SizeHints
sh <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO SizeHints
getWMNormalHints Display
d Pixel
w
          WindowAttributes
wa <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO WindowAttributes
getWindowAttributes Display
d Pixel
w
          let bw :: Dimension
bw = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowAttributes -> CInt
wa_border_width) WindowAttributes
wa
          Maybe
  (Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail)
point_sc <- Position
-> Position
-> X (Maybe
        (Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail))
pointScreen (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa)
          Bool
managed <- Pixel -> X Bool
isClient Pixel
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 = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail)
              sc :: Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
sc = forall a. a -> Maybe a -> a
fromMaybe (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws) forall a b. (a -> b) -> a -> b
$
                  if Bool
managed Bool -> Bool -> Bool
|| Maybe
  (Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail)
point_sc forall {i} {l} {a} {sid}.
Maybe (Screen i l a sid ScreenDetail)
-> Maybe (Screen i l a sid ScreenDetail) -> Bool
`sr_eq` forall a. a -> Maybe a
Just (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 Pixel) Pixel ScreenId ScreenDetail)
point_sc else forall a. Maybe a
Nothing
              sr :: Rectangle
sr = ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
sc
              x :: Rational
x = (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_x WindowAttributes
wa) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_x Rectangle
sr)) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
sr)
              y :: Rational
y = (forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_y WindowAttributes
wa) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_y Rectangle
sr)) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
sr)
              (Dimension
width, Dimension
height) = forall a.
Integral a =>
SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh (WindowAttributes -> CInt
wa_width WindowAttributes
wa, WindowAttributes -> CInt
wa_height WindowAttributes
wa)
              rwidth :: Rational
rwidth  = forall a b. (Integral a, Num b) => a -> b
fi (Dimension
width forall a. Num a => a -> a -> a
+ Dimension
bwforall a. Num a => a -> a -> a
*Dimension
2) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
sr)
              rheight :: Rational
rheight = forall a b. (Integral a, Num b) => a -> b
fi (Dimension
height forall a. Num a => a -> a -> a
+ Dimension
bwforall a. Num a => a -> a -> a
*Dimension
2) forall a. Integral a => a -> a -> Ratio a
% 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 Pixel) Pixel ScreenId ScreenDetail)
point_sc forall {i} {l} {a} {sid}.
Maybe (Screen i l a sid ScreenDetail)
-> Maybe (Screen i l a sid ScreenDetail) -> Bool
`sr_eq` forall a. a -> Maybe a
Just Screen WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
sc
                  then Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
x Rational
y Rational
rwidth Rational
rheight
                  else Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect (Rational
0.5 forall a. Num a => a -> a -> a
- Rational
rwidthforall a. Fractional a => a -> a -> a
/Rational
2) (Rational
0.5 forall a. Num a => a -> a -> a
- Rational
rheightforall a. Fractional a => a -> a -> a
/Rational
2) Rational
rwidth Rational
rheight

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

        fi :: (Integral a, Num b) => a -> b
        fi :: forall a b. (Integral a, Num b) => a -> b
fi = forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 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 Pixel) Pixel ScreenId ScreenDetail))
pointScreen Position
x Position
y = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall {i} {l} {a} {sid}. Screen i l a sid ScreenDetail -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.screens
  where p :: Screen i l a sid ScreenDetail -> Bool
p = Position -> Position -> Rectangle -> Bool
pointWithin Position
x Position
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
>= Rectangle -> Position
rect_x Rectangle
r Bool -> Bool -> Bool
&&
                    Position
x forall a. Ord a => a -> a -> Bool
<  Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
r) Bool -> Bool -> Bool
&&
                    Position
y forall a. Ord a => a -> a -> Bool
>= Rectangle -> Position
rect_y Rectangle
r Bool -> Bool -> Bool
&&
                    Position
y forall a. Ord a => a -> a -> Bool
<  Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ 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 :: Pixel -> X ()
float Pixel
w = do
    (ScreenId
sc, RationalRect
rr) <- Pixel -> X (ScreenId, RationalRect)
floatLocation Pixel
w
    (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Pixel
w RationalRect
rr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe WindowSet
ws forall a b. (a -> b) -> a -> b
$ do
        WorkspaceId
i  <- forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Pixel
w WindowSet
ws
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ WorkspaceId
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.screens WindowSet
ws)
        Pixel
f  <- forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws
        WorkspaceId
sw <- forall s i l a sd. Eq s => s -> StackSet i l a s sd -> Maybe i
W.lookupWorkspace ScreenId
sc WindowSet
ws
        forall (m :: * -> *) a. Monad m => a -> m a
return (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 Pixel
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Pixel
w 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 = Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
mouseDragCursor forall a. Maybe a
Nothing

-- | Like 'mouseDrag', but with the ability to specify a custom cursor
-- shape.
mouseDragCursor :: Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
mouseDragCursor :: Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
mouseDragCursor Maybe Glyph
cursorGlyph Position -> Position -> X ()
f X ()
done = do
    Maybe (Position -> Position -> X (), X ())
drag <- 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 ())
_ -> 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 -> Pixel
theRoot = Pixel
root, display :: XConf -> Display
display = Display
d } <- forall r (m :: * -> *). MonadReader r m => m r
ask
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do Pixel
cursor <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure Pixel
none) (Display -> Glyph -> IO Pixel
createFontCursor Display
d) Maybe Glyph
cursorGlyph
                    Display
-> Pixel
-> Bool
-> Pixel
-> CInt
-> CInt
-> Pixel
-> Pixel
-> Pixel
-> IO CInt
grabPointer Display
d Pixel
root Bool
False (Pixel
buttonReleaseMask forall a. Bits a => a -> a -> a
.|. Pixel
pointerMotionMask)
                      CInt
grabModeAsync CInt
grabModeAsync Pixel
none Pixel
cursor Pixel
currentTime
            forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XState
s -> XState
s { dragging :: Maybe (Position -> Position -> X (), X ())
dragging = forall a. a -> Maybe a
Just (Position -> Position -> X ()
motion, X ()
cleanup) }
 where
    cleanup :: X ()
cleanup = do
        forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Display -> Pixel -> IO ()
ungrabPointer Pixel
currentTime
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XState
s -> XState
s { dragging :: Maybe (Position -> Position -> X (), X ())
dragging = 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
                    Pixel -> X ()
clearEvents Pixel
pointerMotionMask
                    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 :: Pixel -> X ()
mouseMoveWindow Pixel
w = X Bool -> X () -> X ()
whenX (Pixel -> X Bool
isClient Pixel
w) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    WindowAttributes
wa <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO WindowAttributes
getWindowAttributes Display
d Pixel
w
    (Bool
_, Pixel
_, Pixel
_, CInt
ox', CInt
oy', CInt
_, CInt
_, KeyMask
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Pixel
-> IO (Bool, Pixel, Pixel, CInt, CInt, CInt, CInt, KeyMask)
queryPointer Display
d Pixel
w
    let ox :: Position
ox = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ox'
        oy :: Position
oy = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
oy'
    Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
mouseDragCursor
              (forall a. a -> Maybe a
Just Glyph
xC_fleur)
              (\Position
ex Position
ey -> do
                  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> Position -> Position -> IO ()
moveWindow Display
d Pixel
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_x WindowAttributes
wa) forall a. Num a => a -> a -> a
+ (Position
ex forall a. Num a => a -> a -> a
- Position
ox)))
                                      (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_y WindowAttributes
wa) forall a. Num a => a -> a -> a
+ (Position
ey forall a. Num a => a -> a -> a
- Position
oy)))
                  Pixel -> X ()
float Pixel
w
              )
              (Pixel -> X ()
float Pixel
w)

-- | Resize the window under the cursor with the mouse while it is dragged.
mouseResizeWindow :: Window -> X ()
mouseResizeWindow :: Pixel -> X ()
mouseResizeWindow Pixel
w = X Bool -> X () -> X ()
whenX (Pixel -> X Bool
isClient Pixel
w) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    WindowAttributes
wa <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO WindowAttributes
getWindowAttributes Display
d Pixel
w
    SizeHints
sh <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO SizeHints
getWMNormalHints Display
d Pixel
w
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Pixel
-> Pixel
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
warpPointer Display
d Pixel
none Pixel
w Position
0 Position
0 Dimension
0 Dimension
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_width WindowAttributes
wa)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_height WindowAttributes
wa))
    Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
mouseDragCursor
              (forall a. a -> Maybe a
Just Glyph
xC_bottom_right_corner)
              (\Position
ex Position
ey -> do
                 forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> Dimension -> Dimension -> IO ()
resizeWindow Display
d Pixel
w forall a b c. (a -> b -> c) -> (a, b) -> c
`uncurry`
                    forall a.
Integral a =>
SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh (Position
ex forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_x WindowAttributes
wa),
                                               Position
ey forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_y WindowAttributes
wa))
                 Pixel -> X ()
float Pixel
w)
              (Pixel -> X ()
float Pixel
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 :: Pixel -> X ((Dimension, Dimension) -> (Dimension, Dimension))
mkAdjust Pixel
w = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    SizeHints
sh <- Display -> Pixel -> IO SizeHints
getWMNormalHints Display
d Pixel
w
    Either SomeException WindowAttributes
wa <- forall e a. Exception e => IO a -> IO (Either e a)
C.try forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO WindowAttributes
getWindowAttributes Display
d Pixel
w
    case Either SomeException WindowAttributes
wa of
         Left (SomeException
_ :: C.SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id
         Right WindowAttributes
wa' ->
            let bw :: Dimension
bw = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_border_width WindowAttributes
wa'
            in  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall a.
Integral a =>
Dimension -> SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHints Dimension
bw SizeHints
sh =
    forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
tmap (forall a. Num a => a -> a -> a
+ Dimension
2 forall a. Num a => a -> a -> a
* Dimension
bw) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Integral a =>
SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
tmap (forall a. Num a => a -> a -> a
subtract forall a b. (a -> b) -> a -> b
$ a
2 forall a. Num a => a -> a -> 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 :: forall a.
Integral a =>
SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh (a
w, a
h) =
    SizeHints -> (Dimension, Dimension) -> (Dimension, Dimension)
applySizeHints' SizeHints
sh (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max a
1 a
w, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (Dimension, Dimension)
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyMaxSizeHint                   (SizeHints -> Maybe (Dimension, Dimension)
sh_max_size   SizeHints
sh)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\(Dimension
bw, Dimension
bh) (Dimension
w, Dimension
h) -> (Dimension
wforall a. Num a => a -> a -> a
+Dimension
bw, Dimension
hforall a. Num a => a -> a -> a
+Dimension
bh)) (SizeHints -> Maybe (Dimension, Dimension)
sh_base_size  SizeHints
sh)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (Dimension, Dimension)
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyResizeIncHint                 (SizeHints -> Maybe (Dimension, Dimension)
sh_resize_inc SizeHints
sh)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ((Dimension, Dimension), (Dimension, Dimension))
-> (Dimension, Dimension) -> (Dimension, Dimension)
applyAspectHint                    (SizeHints -> Maybe ((Dimension, Dimension), (Dimension, Dimension))
sh_aspect     SizeHints
sh)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\(Dimension
bw,Dimension
bh) (Dimension
w,Dimension
h)   -> (Dimension
wforall a. Num a => a -> a -> a
-Dimension
bw, Dimension
hforall 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)
    | forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Dimension
minx forall a. Ord a => a -> a -> Bool
< Dimension
1, Dimension
miny forall a. Ord a => a -> a -> Bool
< Dimension
1, Dimension
maxx forall a. Ord a => a -> a -> Bool
< Dimension
1, Dimension
maxy forall a. Ord a => a -> a -> Bool
< Dimension
1] = (Dimension, Dimension)
x
    | Dimension
w forall a. Num a => a -> a -> a
* Dimension
maxy forall a. Ord a => a -> a -> Bool
> Dimension
h forall a. Num a => a -> a -> a
* Dimension
maxx                         = (Dimension
h forall a. Num a => a -> a -> a
* Dimension
maxx forall a. Integral a => a -> a -> a
`div` Dimension
maxy, Dimension
h)
    | Dimension
w forall a. Num a => a -> a -> a
* Dimension
miny forall a. Ord a => a -> a -> Bool
< Dimension
h forall a. Num a => a -> a -> a
* Dimension
minx                         = (Dimension
w, Dimension
w forall a. Num a => a -> a -> a
* Dimension
miny 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 forall a. Ord a => a -> a -> Bool
> Dimension
0 Bool -> Bool -> Bool
&& Dimension
ih forall a. Ord a => a -> a -> Bool
> Dimension
0 then (Dimension
w forall a. Num a => a -> a -> a
- Dimension
w forall a. Integral a => a -> a -> a
`mod` Dimension
iw, Dimension
h forall a. Num a => a -> a -> a
- Dimension
h 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 forall a. Ord a => a -> a -> Bool
> Dimension
0 Bool -> Bool -> Bool
&& Dimension
mh forall a. Ord a => a -> a -> Bool
> Dimension
0 then (forall a. Ord a => a -> a -> a
min Dimension
w Dimension
mw,forall a. Ord a => a -> a -> a
min Dimension
h Dimension
mh) else (Dimension, Dimension)
x