{-# LANGUAGE OverloadedStrings #-}
module WildBind.X11.Internal.Window
(
Window
, ActiveWindow
, emptyWindow
, fromWinID
, winInstance
, winClass
, winName
, winID
, getActiveWindow
, defaultRootWindowForDisplay
) where
import Control.Applicative (empty, (<$>), (<|>))
import Control.Monad (guard)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Foreign
import qualified Graphics.X11.Xlib as Xlib
import qualified Graphics.X11.Xlib.Extras as XlibE
data Window
= Window
{ Window -> Text
winInstance :: Text
, Window -> Text
winClass :: Text
, Window -> Text
winName :: Text
, Window -> Atom
winID :: Xlib.Window
}
deriving (Window -> Window -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Window -> Window -> Bool
$c/= :: Window -> Window -> Bool
== :: Window -> Window -> Bool
$c== :: Window -> Window -> Bool
Eq, Eq Window
Window -> Window -> Bool
Window -> Window -> Ordering
Window -> Window -> Window
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Window -> Window -> Window
$cmin :: Window -> Window -> Window
max :: Window -> Window -> Window
$cmax :: Window -> Window -> Window
>= :: Window -> Window -> Bool
$c>= :: Window -> Window -> Bool
> :: Window -> Window -> Bool
$c> :: Window -> Window -> Bool
<= :: Window -> Window -> Bool
$c<= :: Window -> Window -> Bool
< :: Window -> Window -> Bool
$c< :: Window -> Window -> Bool
compare :: Window -> Window -> Ordering
$ccompare :: Window -> Window -> Ordering
Ord, Int -> Window -> ShowS
[Window] -> ShowS
Window -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Window] -> ShowS
$cshowList :: [Window] -> ShowS
show :: Window -> String
$cshow :: Window -> String
showsPrec :: Int -> Window -> ShowS
$cshowsPrec :: Int -> Window -> ShowS
Show)
type ActiveWindow = Window
emptyWindow :: Window
emptyWindow :: Window
emptyWindow = Text -> Text -> Text -> Atom -> Window
Window Text
"" Text
"" Text
"" Atom
0
fromWinID :: Xlib.Window -> Window
fromWinID :: Atom -> Window
fromWinID Atom
wid = Window
emptyWindow { winID :: Atom
winID = Atom
wid }
getActiveWindow :: Xlib.Display -> IO ActiveWindow
getActiveWindow :: Display -> IO Window
getActiveWindow Display
disp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Window
emptyWindow forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT IO Window
getActiveWindowM where
getActiveWindowM :: MaybeT IO Window
getActiveWindowM = do
Atom
awin <- Display -> MaybeT IO Atom
xGetActiveWindow Display
disp
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Atom
awin forall a. Eq a => a -> a -> Bool
/= Atom
0)
Text
name <- Display -> Atom -> MaybeT IO Text
xGetWindowName Display
disp Atom
awin
(Text, Text)
class_hint <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO (Text, Text)
xGetClassHint Display
disp Atom
awin
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text -> Atom -> Window
Window) (Text, Text)
class_hint Text
name Atom
awin
defaultRootWindowForDisplay :: Xlib.Display -> Window
defaultRootWindowForDisplay :: Display -> Window
defaultRootWindowForDisplay Display
disp = Text -> Text -> Text -> Atom -> Window
Window Text
"" Text
"" Text
"" forall a b. (a -> b) -> a -> b
$ Display -> Atom
Xlib.defaultRootWindow Display
disp
ewmhIsSupported :: Xlib.Display -> String -> IO Bool
ewmhIsSupported :: Display -> String -> IO Bool
ewmhIsSupported Display
disp String
feature_str = do
Atom
req <- Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
"_NET_SUPPORTED" Bool
False
Atom
feature <- Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
feature_str Bool
False
Maybe [CLong]
result <- Display -> Atom -> Atom -> IO (Maybe [CLong])
XlibE.getWindowProperty32 Display
disp Atom
req (Display -> Atom
Xlib.defaultRootWindow Display
disp)
case Maybe [CLong]
result of
Maybe [CLong]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just [CLong]
atoms -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Atom
feature forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [CLong]
atoms
xGetActiveWindow :: Xlib.Display -> MaybeT IO Xlib.Window
xGetActiveWindow :: Display -> MaybeT IO Atom
xGetActiveWindow Display
disp = do
let req_str :: String
req_str = String
"_NET_ACTIVE_WINDOW"
Bool
supported <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> String -> IO Bool
ewmhIsSupported Display
disp String
req_str
if Bool -> Bool
not Bool
supported
then forall (f :: * -> *) a. Alternative f => f a
empty
else do
Atom
req <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
req_str Bool
False
[CLong]
result <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO (Maybe [CLong])
XlibE.getWindowProperty32 Display
disp Atom
req (Display -> Atom
Xlib.defaultRootWindow Display
disp)
case [CLong]
result of
[] -> forall (f :: * -> *) a. Alternative f => f a
empty
(CLong
val:[CLong]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
val
xGetClassHint :: Xlib.Display -> Xlib.Window -> IO (Text, Text)
xGetClassHint :: Display -> Atom -> IO (Text, Text)
xGetClassHint Display
disp Atom
win = do
ClassHint
hint <- Display -> Atom -> IO ClassHint
XlibE.getClassHint Display
disp Atom
win
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ ClassHint -> String
XlibE.resName ClassHint
hint, String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ ClassHint -> String
XlibE.resClass ClassHint
hint)
xGetTextProperty :: Xlib.Display -> Xlib.Window -> String -> MaybeT IO Text
xGetTextProperty :: Display -> Atom -> String -> MaybeT IO Text
xGetTextProperty Display
disp Atom
win String
prop_name = do
Atom
req <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
prop_name Bool
False
TextProperty
text_prop <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca forall a b. (a -> b) -> a -> b
$ \Ptr TextProperty
ptr_prop -> do
Status
status <- Display -> Atom -> Ptr TextProperty -> Atom -> IO Status
XlibE.xGetTextProperty Display
disp Atom
win Ptr TextProperty
ptr_prop Atom
req
if Status
status forall a. Eq a => a -> a -> Bool
== Status
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr TextProperty
ptr_prop
String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Display -> TextProperty -> IO [String]
XlibE.wcTextPropertyToTextList Display
disp TextProperty
text_prop))
xGetWindowName :: Xlib.Display -> Xlib.Window -> MaybeT IO Text
xGetWindowName :: Display -> Atom -> MaybeT IO Text
xGetWindowName Display
disp Atom
win = Display -> Atom -> String -> MaybeT IO Text
xGetTextProperty Display
disp Atom
win String
"_NET_WM_NAME" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Display -> Atom -> String -> MaybeT IO Text
xGetTextProperty Display
disp Atom
win String
"WM_NAME"