-----------------------------------------------------------------------------
-- |
-- 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]
(Int -> ReadS Property)
-> ReadS [Property]
-> ReadPrec Property
-> ReadPrec [Property]
-> Read 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
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
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 = Query Bool -> Window -> X Bool
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 <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    let ms :: Maybe (Stack Window)
ms = Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
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 (Window -> X Bool) -> Window -> X Bool
forall a b. (a -> b) -> a -> b
$ Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
s
        Maybe (Stack Window)
Nothing -> Bool -> X Bool
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 = (Display -> X [Window]) -> X [Window]
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X [Window]) -> X [Window])
-> (Display -> X [Window]) -> X [Window]
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Window
rootw <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    (Window
_,Window
_,[Window]
wins) <- IO (Window, Window, [Window]) -> X (Window, Window, [Window])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Window, Window, [Window]) -> X (Window, Window, [Window]))
-> IO (Window, Window, [Window]) -> X (Window, Window, [Window])
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 (Window -> X Bool) -> [Window] -> X [Window]
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 Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (Resource String
s) = Query String
resource Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (ClassName String
s) = Query String
className Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (Role String
s) = String -> Query String
stringProperty String
"WM_WINDOW_ROLE" Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (Machine String
s) = String -> Query String
stringProperty String
"WM_CLIENT_MACHINE" Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
s
propertyToQuery (And Property
p1 Property
p2) = Property -> Query Bool
propertyToQuery Property
p1 Query Bool -> Query Bool -> Query Bool
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 Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Property -> Query Bool
propertyToQuery Property
p2
propertyToQuery (Not Property
p) = Bool -> Bool
not (Bool -> Bool) -> Query Bool -> Query Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Property -> Query Bool
propertyToQuery Property
p
propertyToQuery (Const Bool
b) = Bool -> Query Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
propertyToQuery (Tagged String
s) = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> Query Bool) -> Query Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X Bool -> Query Bool
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 = (Display -> X (Maybe [CLong])) -> X (Maybe [CLong])
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (Maybe [CLong])) -> X (Maybe [CLong]))
-> (Display -> X (Maybe [CLong])) -> X (Maybe [CLong])
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> IO (Maybe [CLong]) -> X (Maybe [CLong])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe [CLong]) -> X (Maybe [CLong]))
-> IO (Maybe [CLong]) -> X (Maybe [CLong])
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 }