{-# 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
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)

-- | 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 :: Atom
winID = Atom
wid }

-- | Get currently active 'Window'.
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) -- 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 <- 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

-- | 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
"" 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    -> 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

-- | 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 <- 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))

-- | 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" 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"