{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module XMonad.Main (xmonad, launch) where
import System.Locale.SetLocale
import qualified Control.Exception as E
import Data.Bits
import Data.List ((\\))
import Data.Foldable (traverse_)
import Data.Function
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Monad.Reader
import Control.Monad.State
import Data.Maybe (fromMaybe, isJust)
import Data.Monoid (getAll)
import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
import Graphics.X11.Xlib.Extras
import XMonad.Core
import qualified XMonad.Config as Default
import XMonad.StackSet (new, floating, member)
import qualified XMonad.StackSet as W
import XMonad.Operations
import System.IO
import System.Directory
import System.Info
import System.Environment (getArgs, getProgName, withArgs)
import System.Posix.Process (executeFile)
import System.Exit (exitFailure)
import System.FilePath
import Paths_xmonad (version)
import Data.Version (showVersion)
import Graphics.X11.Xinerama (compiledWithXinerama)
import Graphics.X11.Xrandr (xrrQueryExtension, xrrUpdateConfiguration)
xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
xmonad :: forall (l :: * -> *).
(LayoutClass l ScreenNumber, Read (l ScreenNumber)) =>
XConfig l -> IO ()
xmonad XConfig l
conf = do
forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers
Directories
dirs <- IO Directories
getDirectories
let launch' :: [String] -> IO ()
launch' [String]
args = do
forall (m :: * -> *). MonadIO m => IO () -> m ()
catchIO (Directories -> IO ()
buildLaunch Directories
dirs)
conf' :: XConfig Layout
conf'@XConfig { layoutHook :: forall (l :: * -> *). XConfig l -> l ScreenNumber
layoutHook = Layout l ScreenNumber
l }
<- forall (l :: * -> *).
XConfig l -> [String] -> XConfig Layout -> IO (XConfig Layout)
handleExtraArgs XConfig l
conf [String]
args XConfig l
conf{ layoutHook :: Layout ScreenNumber
layoutHook = forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout (forall (l :: * -> *). XConfig l -> l ScreenNumber
layoutHook XConfig l
conf) }
forall a. [String] -> IO a -> IO a
withArgs [] forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *).
(LayoutClass l ScreenNumber, Read (l ScreenNumber)) =>
XConfig l -> Directories -> IO ()
launch (XConfig Layout
conf' { layoutHook :: l ScreenNumber
layoutHook = l ScreenNumber
l }) Directories
dirs
[String]
args <- IO [String]
getArgs
case [String]
args of
[String
"--help"] -> IO ()
usage
[String
"--recompile"] -> forall (m :: * -> *). MonadIO m => Directories -> Bool -> m Bool
recompile Directories
dirs Bool
True forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless forall a. IO a
exitFailure
[String
"--restart"] -> IO ()
sendRestart
[String
"--version"] -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
shortVersion
[String
"--verbose-version"] -> String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ [String]
shortVersion forall a. [a] -> [a] -> [a]
++ [String]
longVersion
String
"--replace" : [String]
args' -> IO ()
sendReplace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> IO ()
launch' [String]
args'
[String]
_ -> [String] -> IO ()
launch' [String]
args
where
shortVersion :: [String]
shortVersion = [String
"xmonad", Version -> String
showVersion Version
version]
longVersion :: [String]
longVersion = [ String
"compiled by", String
compilerName, Version -> String
showVersion Version
compilerVersion
, String
"for", String
arch forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ String
os
, String
"\nXinerama:", forall a. Show a => a -> String
show Bool
compiledWithXinerama ]
usage :: IO ()
usage :: IO ()
usage = do
String
self <- IO String
getProgName
String -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
[ String
"Usage: " forall a. Semigroup a => a -> a -> a
<> String
self forall a. Semigroup a => a -> a -> a
<> String
" [OPTION]"
, String
"Options:"
, String
" --help Print this message"
, String
" --version Print the version number"
, String
" --recompile Recompile your xmonad.hs"
, String
" --replace Replace the running window manager with xmonad"
, String
" --restart Request a running xmonad process to restart"
]
buildLaunch :: Directories -> IO ()
buildLaunch :: Directories -> IO ()
buildLaunch Directories
dirs = do
String
whoami <- IO String
getProgName
let bin :: String
bin = Directories -> String
binFileName Directories
dirs
let compiledConfig :: String
compiledConfig = String -> String
takeFileName String
bin
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
whoami forall a. Eq a => a -> a -> Bool
== String
compiledConfig) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => String -> m ()
trace forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"XMonad is recompiling and replacing itself with another XMonad process because the current process is called "
, forall a. Show a => a -> String
show String
whoami
, String
" but the compiled configuration should be called "
, forall a. Show a => a -> String
show String
compiledConfig
]
forall (m :: * -> *). MonadIO m => Directories -> Bool -> m Bool
recompile Directories
dirs Bool
False
[String]
args <- IO [String]
getArgs
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
bin Bool
False [String]
args forall a. Maybe a
Nothing
sendRestart :: IO ()
sendRestart :: IO ()
sendRestart = do
Display
dpy <- String -> IO Display
openDisplay String
""
ScreenNumber
rw <- Display -> ScreenNumber -> IO ScreenNumber
rootWindow Display
dpy forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber
defaultScreen Display
dpy
ScreenNumber
xmonad_restart <- Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy String
"XMONAD_RESTART" Bool
False
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
XEventPtr -> ScreenNumber -> IO ()
setEventType XEventPtr
e ScreenNumber
clientMessage
XEventPtr
-> ScreenNumber -> ScreenNumber -> CInt -> [CInt] -> IO ()
setClientMessageEvent' XEventPtr
e ScreenNumber
rw ScreenNumber
xmonad_restart CInt
32 []
Display
-> ScreenNumber -> Bool -> ScreenNumber -> XEventPtr -> IO ()
sendEvent Display
dpy ScreenNumber
rw Bool
False ScreenNumber
structureNotifyMask XEventPtr
e
Display -> Bool -> IO ()
sync Display
dpy Bool
False
sendReplace :: IO ()
sendReplace :: IO ()
sendReplace = do
Display
dpy <- String -> IO Display
openDisplay String
""
let dflt :: ScreenNumber
dflt = Display -> ScreenNumber
defaultScreen Display
dpy
ScreenNumber
rootw <- Display -> ScreenNumber -> IO ScreenNumber
rootWindow Display
dpy ScreenNumber
dflt
Display -> ScreenNumber -> ScreenNumber -> IO ()
replace Display
dpy ScreenNumber
dflt ScreenNumber
rootw
launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> Directories -> IO ()
launch :: forall (l :: * -> *).
(LayoutClass l ScreenNumber, Read (l ScreenNumber)) =>
XConfig l -> Directories -> IO ()
launch XConfig l
initxmc Directories
drs = do
Category -> Maybe String -> IO (Maybe String)
setLocale Category
LC_ALL (forall a. a -> Maybe a
Just String
"")
forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers
let xmc :: XConfig Layout
xmc = XConfig l
initxmc { layoutHook :: Layout ScreenNumber
layoutHook = forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> l ScreenNumber
layoutHook XConfig l
initxmc }
Display
dpy <- String -> IO Display
openDisplay String
""
let dflt :: ScreenNumber
dflt = Display -> ScreenNumber
defaultScreen Display
dpy
ScreenNumber
rootw <- Display -> ScreenNumber -> IO ScreenNumber
rootWindow Display
dpy ScreenNumber
dflt
Display -> ScreenNumber -> ScreenNumber -> IO ()
selectInput Display
dpy ScreenNumber
rootw forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> ScreenNumber
rootMask XConfig l
initxmc
Display -> Bool -> IO ()
sync Display
dpy Bool
False
IO ()
xSetErrorHandler
[Rectangle]
xinesc <- forall (m :: * -> *). MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo Display
dpy
ScreenNumber
nbc <- do Maybe ScreenNumber
v <- Display -> String -> IO (Maybe ScreenNumber)
initColor Display
dpy forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> String
normalBorderColor XConfig Layout
xmc
Just ScreenNumber
nbc_ <- Display -> String -> IO (Maybe ScreenNumber)
initColor Display
dpy forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> String
normalBorderColor forall a. Default a => a
Default.def
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a -> a
fromMaybe ScreenNumber
nbc_ Maybe ScreenNumber
v)
ScreenNumber
fbc <- do Maybe ScreenNumber
v <- Display -> String -> IO (Maybe ScreenNumber)
initColor Display
dpy forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> String
focusedBorderColor XConfig Layout
xmc
Just ScreenNumber
fbc_ <- Display -> String -> IO (Maybe ScreenNumber)
initColor Display
dpy forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> String
focusedBorderColor forall a. Default a => a
Default.def
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a -> a
fromMaybe ScreenNumber
fbc_ Maybe ScreenNumber
v)
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
let layout :: Layout ScreenNumber
layout = forall (l :: * -> *). XConfig l -> l ScreenNumber
layoutHook XConfig Layout
xmc
initialWinset :: StackSet String (Layout ScreenNumber) a ScreenId ScreenDetail
initialWinset = let padToLen :: Int -> [String] -> [String]
padToLen Int
n [String]
xs = forall a. Int -> [a] -> [a]
take (forall a. Ord a => a -> a -> a
max Int
n (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs)) forall a b. (a -> b) -> a -> b
$ [String]
xs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat String
""
in forall s l i sd a.
Integral s =>
l -> [i] -> [sd] -> StackSet i l a s sd
new Layout ScreenNumber
layout (Int -> [String] -> [String]
padToLen (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rectangle]
xinesc) (forall (l :: * -> *). XConfig l -> [String]
workspaces XConfig Layout
xmc)) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> ScreenDetail
SD [Rectangle]
xinesc
cf :: XConf
cf = XConf
{ display :: Display
display = Display
dpy
, config :: XConfig Layout
config = XConfig Layout
xmc
, theRoot :: ScreenNumber
theRoot = ScreenNumber
rootw
, normalBorder :: ScreenNumber
normalBorder = ScreenNumber
nbc
, focusedBorder :: ScreenNumber
focusedBorder = ScreenNumber
fbc
, keyActions :: Map (ButtonMask, ScreenNumber) (X ())
keyActions = forall (l :: * -> *).
XConfig l
-> XConfig Layout -> Map (ButtonMask, ScreenNumber) (X ())
keys XConfig Layout
xmc XConfig Layout
xmc
, buttonActions :: Map (ButtonMask, ScreenNumber) (ScreenNumber -> X ())
buttonActions = forall (l :: * -> *).
XConfig l
-> XConfig Layout
-> Map (ButtonMask, ScreenNumber) (ScreenNumber -> X ())
mouseBindings XConfig Layout
xmc XConfig Layout
xmc
, mouseFocused :: Bool
mouseFocused = Bool
False
, mousePosition :: Maybe (Position, Position)
mousePosition = forall a. Maybe a
Nothing
, currentEvent :: Maybe Event
currentEvent = forall a. Maybe a
Nothing
, directories :: Directories
directories = Directories
drs
}
st :: XState
st = XState
{ windowset :: WindowSet
windowset = forall {a}.
StackSet String (Layout ScreenNumber) a ScreenId ScreenDetail
initialWinset
, numberlockMask :: ButtonMask
numberlockMask = ButtonMask
0
, mapped :: Set ScreenNumber
mapped = forall a. Set a
S.empty
, waitingUnmap :: Map ScreenNumber Int
waitingUnmap = forall k a. Map k a
M.empty
, dragging :: Maybe (Position -> Position -> X (), X ())
dragging = forall a. Maybe a
Nothing
, extensibleState :: Map String (Either String StateExtension)
extensibleState = forall k a. Map k a
M.empty
}
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e ->
forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
cf XState
st forall a b. (a -> b) -> a -> b
$ do
Maybe XState
serializedSt <- do
String
path <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ Directories -> String
stateFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> IO Bool
doesFileExist String
path)
if Bool
exists then forall (l :: * -> *).
(LayoutClass l ScreenNumber, Read (l ScreenNumber)) =>
XConfig l -> X (Maybe XState)
readStateFile XConfig l
initxmc else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
let extst :: Map String (Either String StateExtension)
extst = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall k a. Map k a
M.empty XState -> Map String (Either String StateExtension)
extensibleState Maybe XState
serializedSt
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s {extensibleState :: Map String (Either String StateExtension)
extensibleState = Map String (Either String StateExtension)
extst})
X ()
cacheNumlockMask
X ()
grabKeys
X ()
grabButtons
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Bool -> IO ()
sync Display
dpy Bool
False
[ScreenNumber]
ws <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber -> IO [ScreenNumber]
scan Display
dpy ScreenNumber
rootw
let winset :: WindowSet
winset = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}.
StackSet String (Layout ScreenNumber) a ScreenId ScreenDetail
initialWinset XState -> WindowSet
windowset Maybe XState
serializedSt
(WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.delete WindowSet
winset forall a b. (a -> b) -> a -> b
$ forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
winset forall a. Eq a => [a] -> [a] -> [a]
\\ [ScreenNumber]
ws
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ScreenNumber -> X ()
manage ([ScreenNumber]
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
winset)
forall a. X a -> X (Maybe a)
userCode forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig l
initxmc
Maybe (CInt, CInt)
rrData <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> IO (Maybe (CInt, CInt))
xrrQueryExtension Display
dpy
forall {a} {b}. Display -> XEventPtr -> Maybe a -> X b
mainLoop Display
dpy XEventPtr
e Maybe (CInt, CInt)
rrData
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
prehandle :: Event -> X ()
prehandle Event
e = let mouse :: Maybe (Position, Position)
mouse = do forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Event -> ScreenNumber
ev_event_type Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScreenNumber]
evs)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Event -> CInt
ev_x_root Event
e)
,forall a b. (Integral a, Num b) => a -> b
fromIntegral (Event -> CInt
ev_y_root Event
e))
in forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\XConf
c -> XConf
c { mousePosition :: Maybe (Position, Position)
mousePosition = Maybe (Position, Position)
mouse, currentEvent :: Maybe Event
currentEvent = forall a. a -> Maybe a
Just Event
e }) (Event -> X ()
handleWithHook Event
e)
evs :: [ScreenNumber]
evs = [ ScreenNumber
keyPress, ScreenNumber
keyRelease, ScreenNumber
enterNotify, ScreenNumber
leaveNotify
, ScreenNumber
buttonPress, ScreenNumber
buttonRelease]
rrUpdate :: XEventPtr -> Maybe a -> IO ()
rrUpdate XEventPtr
e Maybe a
r = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe a
r) (forall (f :: * -> *) a. Functor f => f a -> f ()
void (XEventPtr -> IO CInt
xrrUpdateConfiguration XEventPtr
e))
mainLoop :: Display -> XEventPtr -> Maybe a -> X b
mainLoop Display
d XEventPtr
e Maybe a
r = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> XEventPtr -> IO ()
nextEvent Display
d XEventPtr
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. XEventPtr -> Maybe a -> IO ()
rrUpdate XEventPtr
e Maybe a
r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XEventPtr -> IO Event
getEvent XEventPtr
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> X ()
prehandle forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Display -> XEventPtr -> Maybe a -> X b
mainLoop Display
d XEventPtr
e Maybe a
r
handleWithHook :: Event -> X ()
handleWithHook :: Event -> X ()
handleWithHook Event
e = do
Event -> X All
evHook <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
X Bool -> X () -> X ()
whenX (forall a. a -> X a -> X a
userCodeDef Bool
True forall a b. (a -> b) -> a -> b
$ All -> Bool
getAll forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Event -> X All
evHook Event
e) (Event -> X ()
handle Event
e)
handle :: Event -> X ()
handle :: Event -> X ()
handle (KeyEvent {ev_event_type :: Event -> ScreenNumber
ev_event_type = ScreenNumber
t, ev_state :: Event -> ButtonMask
ev_state = ButtonMask
m, ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
code})
| ScreenNumber
t forall a. Eq a => a -> a -> Bool
== ScreenNumber
keyPress = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
ScreenNumber
s <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> KeyCode -> CInt -> IO ScreenNumber
keycodeToKeysym Display
dpy KeyCode
code CInt
0
ButtonMask
mClean <- ButtonMask -> X ButtonMask
cleanMask ButtonMask
m
Map (ButtonMask, ScreenNumber) (X ())
ks <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Map (ButtonMask, ScreenNumber) (X ())
keyActions
forall a. a -> X a -> X a
userCodeDef () forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ButtonMask
mClean, ScreenNumber
s) Map (ButtonMask, ScreenNumber) (X ())
ks) forall a. a -> a
id
handle (MapRequestEvent {ev_window :: Event -> ScreenNumber
ev_window = ScreenNumber
w}) = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
Display -> ScreenNumber -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy ScreenNumber
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
Bool
managed <- ScreenNumber -> X Bool
isClient ScreenNumber
w
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (WindowAttributes -> Bool
wa_override_redirect WindowAttributes
wa) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
managed) forall a b. (a -> b) -> a -> b
$ ScreenNumber -> X ()
manage ScreenNumber
w
handle e :: Event
e@(DestroyWindowEvent {ev_window :: Event -> ScreenNumber
ev_window = ScreenNumber
w}) = do
X Bool -> X () -> X ()
whenX (ScreenNumber -> X Bool
isClient ScreenNumber
w) forall a b. (a -> b) -> a -> b
$ do
ScreenNumber -> X ()
unmanage ScreenNumber
w
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { mapped :: Set ScreenNumber
mapped = forall a. Ord a => a -> Set a -> Set a
S.delete ScreenNumber
w (XState -> Set ScreenNumber
mapped XState
s)
, waitingUnmap :: Map ScreenNumber Int
waitingUnmap = forall k a. Ord k => k -> Map k a -> Map k a
M.delete ScreenNumber
w (XState -> Map ScreenNumber Int
waitingUnmap XState
s)})
forall a. Message a => a -> X ()
broadcastMessage Event
e
handle (UnmapEvent {ev_window :: Event -> ScreenNumber
ev_window = ScreenNumber
w, ev_send_event :: Event -> Bool
ev_send_event = Bool
synthetic}) = X Bool -> X () -> X ()
whenX (ScreenNumber -> X Bool
isClient ScreenNumber
w) forall a b. (a -> b) -> a -> b
$ do
Int
e <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ScreenNumber
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Map ScreenNumber Int
waitingUnmap)
if Bool
synthetic Bool -> Bool -> Bool
|| Int
e forall a. Eq a => a -> a -> Bool
== Int
0
then ScreenNumber -> X ()
unmanage ScreenNumber
w
else forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { waitingUnmap :: Map ScreenNumber Int
waitingUnmap = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update forall {a}. (Eq a, Num a, Enum a) => a -> Maybe a
mpred ScreenNumber
w (XState -> Map ScreenNumber Int
waitingUnmap XState
s) })
where mpred :: a -> Maybe a
mpred a
1 = forall a. Maybe a
Nothing
mpred a
n = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred a
n
handle e :: Event
e@(MappingNotifyEvent {}) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Event -> IO ()
refreshKeyboardMapping Event
e
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> CInt
ev_request Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt
mappingKeyboard, CInt
mappingModifier]) forall a b. (a -> b) -> a -> b
$ do
X ()
cacheNumlockMask
X ()
grabKeys
handle e :: Event
e@(ButtonEvent {ev_event_type :: Event -> ScreenNumber
ev_event_type = ScreenNumber
t})
| ScreenNumber
t forall a. Eq a => a -> a -> Bool
== ScreenNumber
buttonRelease = 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 ()
f) -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s { dragging :: Maybe (Position -> Position -> X (), X ())
dragging = forall a. Maybe a
Nothing }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
f
Maybe (Position -> Position -> X (), X ())
Nothing -> forall a. Message a => a -> X ()
broadcastMessage Event
e
handle e :: Event
e@(MotionEvent {ev_event_type :: Event -> ScreenNumber
ev_event_type = ScreenNumber
_t, ev_x :: Event -> CInt
ev_x = CInt
x, ev_y :: Event -> CInt
ev_y = CInt
y}) = 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 ()
d,X ()
_) -> Position -> Position -> X ()
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y)
Maybe (Position -> Position -> X (), X ())
Nothing -> forall a. Message a => a -> X ()
broadcastMessage Event
e
handle e :: Event
e@(ButtonEvent {ev_window :: Event -> ScreenNumber
ev_window = ScreenNumber
w,ev_event_type :: Event -> ScreenNumber
ev_event_type = ScreenNumber
t,ev_button :: Event -> ScreenNumber
ev_button = ScreenNumber
b })
| ScreenNumber
t forall a. Eq a => a -> a -> Bool
== ScreenNumber
buttonPress = do
Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
Bool
isr <- ScreenNumber -> X Bool
isRoot ScreenNumber
w
ButtonMask
m <- ButtonMask -> X ButtonMask
cleanMask forall a b. (a -> b) -> a -> b
$ Event -> ButtonMask
ev_state Event
e
Maybe (ScreenNumber -> X ())
mact <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ButtonMask
m, ScreenNumber
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Map (ButtonMask, ScreenNumber) (ScreenNumber -> X ())
buttonActions)
case Maybe (ScreenNumber -> X ())
mact of
Just ScreenNumber -> X ()
act | Bool
isr -> ScreenNumber -> X ()
act forall a b. (a -> b) -> a -> b
$ Event -> ScreenNumber
ev_subwindow Event
e
Maybe (ScreenNumber -> X ())
_ -> do
ScreenNumber -> X ()
focus ScreenNumber
w
Bool
ctf <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> Bool
clickJustFocuses forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ctf forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> CInt -> ScreenNumber -> IO ()
allowEvents Display
dpy CInt
replayPointer ScreenNumber
currentTime)
forall a. Message a => a -> X ()
broadcastMessage Event
e
handle e :: Event
e@(CrossingEvent {ev_window :: Event -> ScreenNumber
ev_window = ScreenNumber
w, ev_event_type :: Event -> ScreenNumber
ev_event_type = ScreenNumber
t})
| ScreenNumber
t forall a. Eq a => a -> a -> Bool
== ScreenNumber
enterNotify Bool -> Bool -> Bool
&& Event -> CInt
ev_mode Event
e forall a. Eq a => a -> a -> Bool
== CInt
notifyNormal
= X Bool -> X () -> X ()
whenX (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> Bool
focusFollowsMouse forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) forall a b. (a -> b) -> a -> b
$ do
Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
ScreenNumber
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> ScreenNumber
theRoot
(Bool
_, ScreenNumber
_, ScreenNumber
w', CInt
_, CInt
_, CInt
_, CInt
_, ButtonMask
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> ScreenNumber
-> IO
(Bool, ScreenNumber, ScreenNumber, CInt, CInt, CInt, CInt,
ButtonMask)
queryPointer Display
dpy ScreenNumber
root
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScreenNumber
w' forall a. Eq a => a -> a -> Bool
== ScreenNumber
0 Bool -> Bool -> Bool
|| ScreenNumber
w forall a. Eq a => a -> a -> Bool
== ScreenNumber
w') (ScreenNumber -> X ()
focus ScreenNumber
w)
handle e :: Event
e@(CrossingEvent {ev_event_type :: Event -> ScreenNumber
ev_event_type = ScreenNumber
t})
| ScreenNumber
t forall a. Eq a => a -> a -> Bool
== ScreenNumber
leaveNotify
= do ScreenNumber
rootw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> ScreenNumber
theRoot
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> ScreenNumber
ev_window Event
e forall a. Eq a => a -> a -> Bool
== ScreenNumber
rootw Bool -> Bool -> Bool
&& Bool -> Bool
not (Event -> Bool
ev_same_screen Event
e)) forall a b. (a -> b) -> a -> b
$ ScreenNumber -> X ()
setFocusX ScreenNumber
rootw
handle e :: Event
e@(ConfigureRequestEvent {ev_window :: Event -> ScreenNumber
ev_window = ScreenNumber
w}) = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
ScreenNumber
bw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> ScreenNumber
borderWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
if forall k a. Ord k => k -> Map k a -> Bool
M.member ScreenNumber
w (forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
floating WindowSet
ws)
Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
member ScreenNumber
w WindowSet
ws)
then do forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber -> CULong -> WindowChanges -> IO ()
configureWindow Display
dpy ScreenNumber
w (Event -> CULong
ev_value_mask Event
e) forall a b. (a -> b) -> a -> b
$ WindowChanges
{ wc_x :: CInt
wc_x = Event -> CInt
ev_x Event
e
, wc_y :: CInt
wc_y = Event -> CInt
ev_y Event
e
, wc_width :: CInt
wc_width = Event -> CInt
ev_width Event
e
, wc_height :: CInt
wc_height = Event -> CInt
ev_height Event
e
, wc_border_width :: CInt
wc_border_width = forall a b. (Integral a, Num b) => a -> b
fromIntegral ScreenNumber
bw
, wc_sibling :: ScreenNumber
wc_sibling = Event -> ScreenNumber
ev_above Event
e
, wc_stack_mode :: CInt
wc_stack_mode = Event -> CInt
ev_detail Event
e }
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
member ScreenNumber
w WindowSet
ws) (ScreenNumber -> X ()
float ScreenNumber
w)
else Display -> ScreenNumber -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy ScreenNumber
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> 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 -> ScreenNumber -> IO ()
setEventType XEventPtr
ev ScreenNumber
configureNotify
XEventPtr
-> ScreenNumber
-> ScreenNumber
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> ScreenNumber
-> Bool
-> IO ()
setConfigureEvent XEventPtr
ev ScreenNumber
w ScreenNumber
w
(WindowAttributes -> CInt
wa_x WindowAttributes
wa) (WindowAttributes -> CInt
wa_y WindowAttributes
wa) (WindowAttributes -> CInt
wa_width WindowAttributes
wa)
(WindowAttributes -> CInt
wa_height WindowAttributes
wa) (Event -> CInt
ev_border_width Event
e) ScreenNumber
none (WindowAttributes -> Bool
wa_override_redirect WindowAttributes
wa)
Display
-> ScreenNumber -> Bool -> ScreenNumber -> XEventPtr -> IO ()
sendEvent Display
dpy ScreenNumber
w Bool
False ScreenNumber
0 XEventPtr
ev
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Bool -> IO ()
sync Display
dpy Bool
False
handle (ConfigureEvent {ev_window :: Event -> ScreenNumber
ev_window = ScreenNumber
w}) = X Bool -> X () -> X ()
whenX (ScreenNumber -> X Bool
isRoot ScreenNumber
w) X ()
rescreen
handle event :: Event
event@(PropertyEvent { ev_event_type :: Event -> ScreenNumber
ev_event_type = ScreenNumber
t, ev_atom :: Event -> ScreenNumber
ev_atom = ScreenNumber
a })
| ScreenNumber
t forall a. Eq a => a -> a -> Bool
== ScreenNumber
propertyNotify Bool -> Bool -> Bool
&& ScreenNumber
a forall a. Eq a => a -> a -> Bool
== ScreenNumber
wM_NAME = 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 () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall a. Message a => a -> X ()
broadcastMessage Event
event
handle e :: Event
e@ClientMessageEvent { ev_message_type :: Event -> ScreenNumber
ev_message_type = ScreenNumber
mt } = do
ScreenNumber
a <- String -> X ScreenNumber
getAtom String
"XMONAD_RESTART"
if ScreenNumber
mt forall a. Eq a => a -> a -> Bool
== ScreenNumber
a
then String -> Bool -> X ()
restart String
"xmonad" Bool
True
else forall a. Message a => a -> X ()
broadcastMessage Event
e
handle Event
e = forall a. Message a => a -> X ()
broadcastMessage Event
e
scan :: Display -> Window -> IO [Window]
scan :: Display -> ScreenNumber -> IO [ScreenNumber]
scan Display
dpy ScreenNumber
rootw = do
(ScreenNumber
_, ScreenNumber
_, [ScreenNumber]
ws) <- Display
-> ScreenNumber -> IO (ScreenNumber, ScreenNumber, [ScreenNumber])
queryTree Display
dpy ScreenNumber
rootw
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\ScreenNumber
w -> ScreenNumber -> IO Bool
ok ScreenNumber
w forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` SomeException -> IO Bool
skip) [ScreenNumber]
ws
where ok :: ScreenNumber -> IO Bool
ok ScreenNumber
w = do WindowAttributes
wa <- Display -> ScreenNumber -> IO WindowAttributes
getWindowAttributes Display
dpy ScreenNumber
w
ScreenNumber
a <- Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy String
"WM_STATE" Bool
False
Maybe [CLong]
p <- Display -> ScreenNumber -> ScreenNumber -> IO (Maybe [CLong])
getWindowProperty32 Display
dpy ScreenNumber
a ScreenNumber
w
let ic :: Bool
ic = case Maybe [CLong]
p of
Just (CLong
3:[CLong]
_) -> Bool
True
Maybe [CLong]
_ -> Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (WindowAttributes -> Bool
wa_override_redirect WindowAttributes
wa)
Bool -> Bool -> Bool
&& (WindowAttributes -> CInt
wa_map_state WindowAttributes
wa forall a. Eq a => a -> a -> Bool
== CInt
waIsViewable Bool -> Bool -> Bool
|| Bool
ic)
skip :: E.SomeException -> IO Bool
skip :: SomeException -> IO Bool
skip SomeException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
grabKeys :: X ()
grabKeys :: X ()
grabKeys = do
XConf { display :: XConf -> Display
display = Display
dpy, theRoot :: XConf -> ScreenNumber
theRoot = ScreenNumber
rootw } <- 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
$ Display -> KeyCode -> ButtonMask -> ScreenNumber -> IO ()
ungrabKey Display
dpy KeyCode
anyKey ButtonMask
anyModifier ScreenNumber
rootw
let grab :: (KeyMask, KeyCode) -> X ()
grab :: (ButtonMask, KeyCode) -> X ()
grab (ButtonMask
km, KeyCode
kc) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> KeyCode
-> ButtonMask
-> ScreenNumber
-> Bool
-> CInt
-> CInt
-> IO ()
grabKey Display
dpy KeyCode
kc ButtonMask
km ScreenNumber
rootw Bool
True CInt
grabModeAsync CInt
grabModeAsync
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ButtonMask, KeyCode) -> X ()
grab forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(ButtonMask, ScreenNumber)] -> X [(ButtonMask, KeyCode)]
mkGrabs 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 (forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Map (ButtonMask, ScreenNumber) (X ())
keyActions)
grabButtons :: X ()
grabButtons :: X ()
grabButtons = do
XConf { display :: XConf -> Display
display = Display
dpy, theRoot :: XConf -> ScreenNumber
theRoot = ScreenNumber
rootw } <- forall r (m :: * -> *). MonadReader r m => m r
ask
let grab :: ScreenNumber -> ButtonMask -> m ()
grab ScreenNumber
button ButtonMask
mask = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> ScreenNumber
-> ButtonMask
-> ScreenNumber
-> Bool
-> ScreenNumber
-> CInt
-> CInt
-> ScreenNumber
-> ScreenNumber
-> IO ()
grabButton Display
dpy ScreenNumber
button ButtonMask
mask ScreenNumber
rootw Bool
False ScreenNumber
buttonPressMask
CInt
grabModeAsync CInt
grabModeSync ScreenNumber
none ScreenNumber
none
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber -> ButtonMask -> ScreenNumber -> IO ()
ungrabButton Display
dpy ScreenNumber
anyButton ButtonMask
anyModifier ScreenNumber
rootw
[ButtonMask]
ems <- X [ButtonMask]
extraModifiers
Map (ButtonMask, ScreenNumber) (ScreenNumber -> X ())
ba <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Map (ButtonMask, ScreenNumber) (ScreenNumber -> X ())
buttonActions
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(ButtonMask
m,ScreenNumber
b) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
MonadIO m =>
ScreenNumber -> ButtonMask -> m ()
grab ScreenNumber
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ButtonMask
m forall a. Bits a => a -> a -> a
.|.)) [ButtonMask]
ems) (forall k a. Map k a -> [k]
M.keys Map (ButtonMask, ScreenNumber) (ScreenNumber -> X ())
ba)
replace :: Display -> ScreenNumber -> Window -> IO ()
replace :: Display -> ScreenNumber -> ScreenNumber -> IO ()
replace Display
dpy ScreenNumber
dflt ScreenNumber
rootw = do
ScreenNumber
wmSnAtom <- Display -> String -> Bool -> IO ScreenNumber
internAtom Display
dpy (String
"WM_S" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ScreenNumber
dflt) Bool
False
ScreenNumber
currentWmSnOwner <- Display -> ScreenNumber -> IO ScreenNumber
xGetSelectionOwner Display
dpy ScreenNumber
wmSnAtom
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScreenNumber
currentWmSnOwner forall a. Eq a => a -> a -> Bool
/= ScreenNumber
0) forall a b. (a -> b) -> a -> b
$ do
Display -> ScreenNumber -> ScreenNumber -> IO ()
selectInput Display
dpy ScreenNumber
currentWmSnOwner ScreenNumber
structureNotifyMask
ScreenNumber
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 -> ScreenNumber -> IO ()
set_event_mask Ptr SetWindowAttributes
attributes ScreenNumber
propertyChangeMask
let screen :: Screen
screen = Display -> Screen
defaultScreenOfDisplay Display
dpy
visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
screen
attrmask :: ScreenNumber
attrmask = ScreenNumber
cWOverrideRedirect forall a. Bits a => a -> a -> a
.|. ScreenNumber
cWEventMask
Display
-> ScreenNumber
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> CInt
-> CInt
-> CInt
-> Visual
-> ScreenNumber
-> Ptr SetWindowAttributes
-> IO ScreenNumber
createWindow Display
dpy ScreenNumber
rootw (-Position
100) (-Position
100) ScreenNumber
1 ScreenNumber
1 CInt
0 CInt
copyFromParent CInt
copyFromParent Visual
visual ScreenNumber
attrmask Ptr SetWindowAttributes
attributes
Display -> ScreenNumber -> ScreenNumber -> ScreenNumber -> IO ()
xSetSelectionOwner Display
dpy ScreenNumber
wmSnAtom ScreenNumber
netWmSnOwner ScreenNumber
currentTime
forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \IO ()
again -> do
ScreenNumber
evt <- forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
event -> do
Display -> ScreenNumber -> ScreenNumber -> XEventPtr -> IO ()
windowEvent Display
dpy ScreenNumber
currentWmSnOwner ScreenNumber
structureNotifyMask XEventPtr
event
XEventPtr -> IO ScreenNumber
get_EventType XEventPtr
event
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScreenNumber
evt forall a. Eq a => a -> a -> Bool
/= ScreenNumber
destroyNotify) IO ()
again