-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.WindowProperties
-- Description :  EDSL for specifying window properties.
-- Copyright   :  (c) Roman Cheplyaka
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
-- Stability   :  unstable
-- Portability :  unportable
--
-- EDSL for specifying window properties; various utilities related to window
-- properties.
--
-----------------------------------------------------------------------------
module XMonad.Util.WindowProperties (
    -- * EDSL for window properties
    -- $edsl
    Property(..), hasProperty, focusedHasProperty, allWithProperty,
    propertyToQuery,
    -- * Helper functions
    -- $helpers
    getProp32, getProp32s)
where

import Foreign.C.Types (CLong)
import XMonad
import XMonad.Actions.TagWindows (hasTag)
import XMonad.Prelude (filterM)
import qualified XMonad.StackSet as W

-- $edsl
-- Allows to specify window properties, such as title, classname or
-- resource, and to check them.
--
-- In contrast to ManageHook properties, these are instances of Show and Read,
-- so they can be used in layout definitions etc. For example usage see "XMonad.Layout.IM"

-- | Most of the property constructors are quite self-explaining.
data Property = Title String
              | ClassName String
              | Resource String
              | Role String -- ^ WM_WINDOW_ROLE property
              | Machine String -- ^ WM_CLIENT_MACHINE property
              | And Property Property
              | Or  Property Property
              | Not Property
              | Const Bool
              | Tagged String -- ^ Tagged via "XMonad.Actions.TagWindows"
              deriving (ReadPrec [Property]
ReadPrec Property
Int -> ReadS Property
ReadS [Property]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Property]
$creadListPrec :: ReadPrec [Property]
readPrec :: ReadPrec Property
$creadPrec :: ReadPrec Property
readList :: ReadS [Property]
$creadList :: ReadS [Property]
readsPrec :: Int -> ReadS Property
$creadsPrec :: Int -> ReadS Property
Read, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show)
infixr 9 `And`
infixr 8 `Or`

-- | Does given window have this property?
hasProperty :: Property -> Window -> X Bool
hasProperty :: Property -> Window -> X Bool
hasProperty Property
p = forall a. Query a -> Window -> X a
runQuery (Property -> Query Bool
propertyToQuery Property
p)

-- | Does the focused window have this property?
focusedHasProperty :: Property -> X Bool
focusedHasProperty :: Property -> X Bool
focusedHasProperty Property
p = do
    WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    let ms :: Maybe (Stack Window)
ms = forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws
    case Maybe (Stack Window)
ms of
        Just Stack Window
s  -> Property -> Window -> X Bool
hasProperty Property
p forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack Window
s
        Maybe (Stack Window)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Find all existing windows with specified property
allWithProperty :: Property -> X [Window]
allWithProperty :: Property -> X [Window]
allWithProperty Property
prop = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Window
rootw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    (Window
_,Window
_,[Window]
wins) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO (Window, Window, [Window])
queryTree Display
dpy Window
rootw
    Property -> Window -> X Bool
hasProperty Property
prop forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
`filterM` [Window]
wins

-- | Convert property to 'Query' 'Bool' (see "XMonad.ManageHook")
propertyToQuery :: Property -> Query Bool
propertyToQuery :: Property -> Query Bool
propertyToQuery (Title String
s) = Query String
title forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (Resource String
s) = Query String
resource forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (ClassName String
s) = Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (Role String
s) = String -> Query String
stringProperty String
"WM_WINDOW_ROLE" forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (Machine String
s) = String -> Query String
stringProperty String
"WM_CLIENT_MACHINE" forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (And Property
p1 Property
p2) = Property -> Query Bool
propertyToQuery Property
p1 forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Property -> Query Bool
propertyToQuery Property
p2
propertyToQuery (Or Property
p1 Property
p2) = Property -> Query Bool
propertyToQuery Property
p1 forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Property -> Query Bool
propertyToQuery Property
p2
propertyToQuery (Not Property
p) = Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Property -> Query Bool
propertyToQuery Property
p
propertyToQuery (Const Bool
b) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
propertyToQuery (Tagged String
s) = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. X a -> Query a
liftX (String -> Window -> X Bool
hasTag String
s Window
w)

-- $helpers

-- | Get a window property from atom
getProp32 :: Atom -> Window -> X (Maybe [CLong])
getProp32 :: Window -> Window -> X (Maybe [CLong])
getProp32 Window
a Window
w = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO (Maybe [CLong])
getWindowProperty32 Display
dpy Window
a Window
w

-- | Get a window property from string
getProp32s :: String -> Window -> X (Maybe [CLong])
getProp32s :: String -> Window -> X (Maybe [CLong])
getProp32s String
str Window
w = do { Window
a <- String -> X Window
getAtom String
str; Window -> Window -> X (Maybe [CLong])
getProp32 Window
a Window
w }