{-# 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 -> Window
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
/= :: Window -> Window -> Bool
$c/= :: Window -> Window -> Bool
== :: Window -> Window -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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
showList :: [Window] -> ShowS
$cshowList :: [Window] -> ShowS
show :: Window -> String
$cshow :: Window -> String
showsPrec :: Int -> Window -> ShowS
$cshowsPrec :: Int -> 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 -> Window -> Window
Window Text
"" Text
"" Text
"" Window
0

-- | Create 'Window' from X11's 'Xlib.Window'. Only for testing.
--
-- @since 0.2.0.0
fromWinID :: Xlib.Window -> Window
fromWinID :: Window -> Window
fromWinID Window
wid = Window
emptyWindow { winID :: Window
winID = Window
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
    Window
awin <- Display -> MaybeT IO Window
xGetActiveWindow Display
disp
    Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Window
awin Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
0) -- sometimes X11 returns 0 (NULL) as a window ID, which I think is always invalid
    Text
name <- Display -> Window -> MaybeT IO Text
xGetWindowName Display
disp Window
awin
    (Text, Text)
class_hint <- IO (Text, Text) -> MaybeT IO (Text, Text)
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 -> Window -> IO (Text, Text)
xGetClassHint Display
disp Window
awin
    Window -> MaybeT IO Window
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 -> Window -> Window)
-> (Text, Text) -> Text -> Window -> Window
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text -> Window -> Window
Window) (Text, Text)
class_hint Text
name Window
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 -> Window -> Window
Window Text
"" Text
"" Text
"" (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ Display -> Window
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
  Window
req <- Display -> String -> Bool -> IO Window
Xlib.internAtom Display
disp String
"_NET_SUPPORTED" Bool
False
  Window
feature <- Display -> String -> Bool -> IO Window
Xlib.internAtom Display
disp String
feature_str Bool
False
  Maybe [CLong]
result <- Display -> Window -> Window -> IO (Maybe [CLong])
XlibE.getWindowProperty32 Display
disp Window
req (Display -> Window
Xlib.defaultRootWindow Display
disp)
  case Maybe [CLong]
result of
    Maybe [CLong]
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just [CLong]
atoms -> Bool -> IO Bool
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 ((Window
feature Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
==) (Window -> Bool) -> (CLong -> Window) -> CLong -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Window
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 Window
xGetActiveWindow Display
disp = do
  let req_str :: String
req_str = String
"_NET_ACTIVE_WINDOW"
  Bool
supported <- IO Bool -> MaybeT IO Bool
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 Window
forall (f :: * -> *) a. Alternative f => f a
empty
    else do
    Window
req <- IO Window -> MaybeT IO Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> MaybeT IO Window) -> IO Window -> MaybeT IO Window
forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
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 -> Window -> Window -> IO (Maybe [CLong])
XlibE.getWindowProperty32 Display
disp Window
req (Display -> Window
Xlib.defaultRootWindow Display
disp)
    case [CLong]
result of
      [] -> MaybeT IO Window
forall (f :: * -> *) a. Alternative f => f a
empty
      (CLong
val:[CLong]
_) -> Window -> MaybeT IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return (Window -> MaybeT IO Window) -> Window -> MaybeT IO Window
forall a b. (a -> b) -> a -> b
$ CLong -> Window
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
val

xGetClassHint :: Xlib.Display -> Xlib.Window -> IO (Text, Text)
xGetClassHint :: Display -> Window -> IO (Text, Text)
xGetClassHint Display
disp Window
win = do
  ClassHint
hint <- Display -> Window -> IO ClassHint
XlibE.getClassHint Display
disp Window
win
  (Text, Text) -> IO (Text, Text)
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 -> Window -> String -> MaybeT IO Text
xGetTextProperty Display
disp Window
win String
prop_name = do
  Window
req <- IO Window -> MaybeT IO Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> MaybeT IO Window) -> IO Window -> MaybeT IO Window
forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
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 -> Window -> Ptr TextProperty -> Window -> IO Status
XlibE.xGetTextProperty Display
disp Window
win Ptr TextProperty
ptr_prop Window
req
    if Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
0
      then Maybe TextProperty -> IO (Maybe TextProperty)
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 (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 -> Window -> MaybeT IO Text
xGetWindowName Display
disp Window
win = Display -> Window -> String -> MaybeT IO Text
xGetTextProperty Display
disp Window
win String
"_NET_WM_NAME" MaybeT IO Text -> MaybeT IO Text -> MaybeT IO Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Display -> Window -> String -> MaybeT IO Text
xGetTextProperty Display
disp Window
win String
"WM_NAME"