{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: WildBind.X11.Internal.Window
-- Description: types and functions related to X11 windows
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. Package users should not rely on this.__
module WildBind.X11.Internal.Window
    ( -- * The 'Window' data type
      Window
    , ActiveWindow
    , emptyWindow
    , fromWinID
      -- * Accessor functions for 'Window'
    , winInstance
    , winClass
    , winName
      -- ** project-internal accessor
    , winID
      -- * Functions
    , 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

-- | Information about window. You can inspect properties 'winInstance'
-- and 'winClass' by @wmctrl@ command.
--
-- > $ wmctrl -lx
-- > 0x01400004 -1 xfce4-panel.Xfce4-panel  mydesktop xfce4-panel
-- > 0x01800003 -1 xfdesktop.Xfdesktop   mydesktop desktop
-- > 0x03800004  0 xfce4-terminal.Xfce4-terminal  mydesktop Terminal - toshio@mydesktop - byobu
-- > 0x03a000a7  0 emacs.Emacs23         mydesktop emacs@mydesktop
-- > 0x03e010fc  0 Navigator.Firefox     mydesktop debug-ito (Toshio Ito) - Mozilla Firefox
-- > 0x02600003  0 totem.Totem           mydesktop Movie Player
--
-- In the above example, the third column shows @winInstance.winClass@.
data Window
  = Window
      { Window -> Text
winInstance :: Text
        -- ^ name of the application instance (part of @WM_CLASS@ property)
      , Window -> Text
winClass    :: Text
        -- ^ name of the application class (part of @WM_CLASS@ property)
      , Window -> Text
winName     :: Text
        -- ^ what's shown in the title bar
      , Window -> Atom
winID       :: Xlib.Window
        -- ^ X11 window ID.
        --
        -- @since 0.2.0.0
      }
  deriving (Window -> Window -> Bool
(Window -> Window -> Bool)
-> (Window -> Window -> Bool) -> Eq Window
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Window -> Window -> Bool
== :: Window -> Window -> Bool
$c/= :: Window -> Window -> Bool
/= :: Window -> Window -> Bool
Eq, Eq Window
Eq Window =>
(Window -> Window -> Ordering)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Window)
-> (Window -> Window -> Window)
-> Ord 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
$ccompare :: Window -> Window -> Ordering
compare :: Window -> Window -> Ordering
$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
>= :: Window -> Window -> Bool
$cmax :: Window -> Window -> Window
max :: Window -> Window -> Window
$cmin :: Window -> Window -> Window
min :: Window -> Window -> Window
Ord, Int -> Window -> ShowS
[Window] -> ShowS
Window -> String
(Int -> Window -> ShowS)
-> (Window -> String) -> ([Window] -> ShowS) -> Show Window
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Window -> ShowS
showsPrec :: Int -> Window -> ShowS
$cshow :: Window -> String
show :: Window -> String
$cshowList :: [Window] -> ShowS
showList :: [Window] -> ShowS
Show)

-- | Use this type especially when the 'Window' is active.
type ActiveWindow = Window

-- | An empty Window instance used for fallback and/or default value.
emptyWindow :: Window
emptyWindow :: Window
emptyWindow = Text -> Text -> Text -> Atom -> Window
Window Text
"" Text
"" Text
"" Atom
0

-- | Create 'Window' from X11's 'Xlib.Window'. Only for testing.
--
-- @since 0.2.0.0
fromWinID :: Xlib.Window -> Window
fromWinID :: Atom -> Window
fromWinID Atom
wid = Window
emptyWindow { winID = wid }

-- | Get currently active 'Window'.
getActiveWindow :: Xlib.Display -> IO ActiveWindow
getActiveWindow :: Display -> IO Window
getActiveWindow Display
disp = Window -> (Window -> Window) -> Maybe Window -> Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Window
emptyWindow Window -> Window
forall a. a -> a
id (Maybe Window -> Window) -> IO (Maybe Window) -> IO Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT IO Window -> IO (Maybe Window)
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
    Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Atom
awin Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
/= Atom
0) -- sometimes X11 returns 0 (NULL) as a window ID, which I think is always invalid
    Text
name <- Display -> Atom -> MaybeT IO Text
xGetWindowName Display
disp Atom
awin
    (Text, Text)
class_hint <- IO (Text, Text) -> MaybeT IO (Text, Text)
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Text) -> MaybeT IO (Text, Text))
-> IO (Text, Text) -> MaybeT IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO (Text, Text)
xGetClassHint Display
disp Atom
awin
    Window -> MaybeT IO Window
forall a. a -> MaybeT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Window -> MaybeT IO Window) -> Window -> MaybeT IO Window
forall a b. (a -> b) -> a -> b
$ ((Text -> Text -> Text -> Atom -> Window)
-> (Text, Text) -> Text -> Atom -> Window
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

-- | Get the default root window of the display.
--
-- @since 0.2.0.0
defaultRootWindowForDisplay :: Xlib.Display -> Window
defaultRootWindowForDisplay :: Display -> Window
defaultRootWindowForDisplay Display
disp = Text -> Text -> Text -> Atom -> Window
Window Text
"" Text
"" Text
"" (Atom -> Window) -> Atom -> Window
forall a b. (a -> b) -> a -> b
$ Display -> Atom
Xlib.defaultRootWindow Display
disp

-- | Check whether specified feature is supported by the window
-- manager(?) Port of libxdo's @_xdo_ewmh_is_supported()@ function.
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    -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just [CLong]
atoms -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (CLong -> Bool) -> [CLong] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Atom
feature Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
==) (Atom -> Bool) -> (CLong -> Atom) -> CLong -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Atom
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [CLong]
atoms

-- | Get X11 Window handle for the active window. Port of libxdo's
-- @xdo_window_get_active()@ function.
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 <- IO Bool -> MaybeT IO Bool
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ Display -> String -> IO Bool
ewmhIsSupported Display
disp String
req_str
  if Bool -> Bool
not Bool
supported
    then MaybeT IO Atom
forall a. MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a
empty
    else do
    Atom
req <- IO Atom -> MaybeT IO Atom
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Atom -> MaybeT IO Atom) -> IO Atom -> MaybeT IO Atom
forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
req_str Bool
False
    [CLong]
result <- IO (Maybe [CLong]) -> MaybeT IO [CLong]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe [CLong]) -> MaybeT IO [CLong])
-> IO (Maybe [CLong]) -> MaybeT IO [CLong]
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
      []      -> MaybeT IO Atom
forall a. MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a
empty
      (CLong
val:[CLong]
_) -> Atom -> MaybeT IO Atom
forall a. a -> MaybeT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Atom -> MaybeT IO Atom) -> Atom -> MaybeT IO Atom
forall a b. (a -> b) -> a -> b
$ CLong -> Atom
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
  (Text, Text) -> IO (Text, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ClassHint -> String
XlibE.resName ClassHint
hint, String -> Text
Text.pack (String -> Text) -> String -> Text
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 <- IO Atom -> MaybeT IO Atom
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Atom -> MaybeT IO Atom) -> IO Atom -> MaybeT IO Atom
forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
prop_name Bool
False
  TextProperty
text_prop <- IO (Maybe TextProperty) -> MaybeT IO TextProperty
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe TextProperty) -> MaybeT IO TextProperty)
-> IO (Maybe TextProperty) -> MaybeT IO TextProperty
forall a b. (a -> b) -> a -> b
$ (Ptr TextProperty -> IO (Maybe TextProperty))
-> IO (Maybe TextProperty)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca ((Ptr TextProperty -> IO (Maybe TextProperty))
 -> IO (Maybe TextProperty))
-> (Ptr TextProperty -> IO (Maybe TextProperty))
-> IO (Maybe TextProperty)
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 Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
0
      then Maybe TextProperty -> IO (Maybe TextProperty)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextProperty
forall a. Maybe a
Nothing
      else (TextProperty -> Maybe TextProperty)
-> IO TextProperty -> IO (Maybe TextProperty)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextProperty -> Maybe TextProperty
forall a. a -> Maybe a
Just (IO TextProperty -> IO (Maybe TextProperty))
-> IO TextProperty -> IO (Maybe TextProperty)
forall a b. (a -> b) -> a -> b
$ Ptr TextProperty -> IO TextProperty
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr TextProperty
ptr_prop
  String -> Text
Text.pack (String -> Text) -> MaybeT IO String -> MaybeT IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> IO [String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Display -> TextProperty -> IO [String]
XlibE.wcTextPropertyToTextList Display
disp TextProperty
text_prop))

-- | Get the window name for the X11 window. The window name refers to
-- @_NET_WM_NAME@ or @WM_NAME@.
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" MaybeT IO Text -> MaybeT IO Text -> MaybeT IO Text
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
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"