module XMonad.Util.NamedWindows (
NamedWindow,
getName,
getNameWMClass,
withNamedWindow,
unName
) where
import Control.Exception as E
import XMonad.Prelude ( fromMaybe, listToMaybe, (>=>) )
import qualified XMonad.StackSet as W ( peek )
import XMonad
data NamedWindow = NW !String !Window
instance Eq NamedWindow where
(NW String
s Window
_) == :: NamedWindow -> NamedWindow -> Bool
== (NW String
s' Window
_) = String
s forall a. Eq a => a -> a -> Bool
== String
s'
instance Ord NamedWindow where
compare :: NamedWindow -> NamedWindow -> Ordering
compare (NW String
s Window
_) (NW String
s' Window
_) = forall a. Ord a => a -> a -> Ordering
compare String
s String
s'
instance Show NamedWindow where
show :: NamedWindow -> String
show (NW String
n Window
_) = String
n
getName :: Window -> X NamedWindow
getName :: Window -> X NamedWindow
getName Window
w = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
let getIt :: IO NamedWindow
getIt = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO TextProperty
getProp (forall a. Ptr a -> IO CInt
xFree forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextProperty -> CString
tp_value) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Window -> NamedWindow
`NW` Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextProperty -> IO String
copy)
getProp :: IO TextProperty
getProp = (Display -> String -> Bool -> IO Window
internAtom Display
d String
"_NET_WM_NAME" Bool
False forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
_) -> Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w Window
wM_NAME
copy :: TextProperty -> IO String
copy TextProperty
prop = forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> TextProperty -> IO [String]
wcTextPropertyToTextList Display
d TextProperty
prop
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ IO NamedWindow
getIt forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
_) -> (String -> Window -> NamedWindow
`NW` Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassHint -> String
resName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> IO ClassHint
getClassHint Display
d Window
w
getNameWMClass :: Window -> X NamedWindow
getNameWMClass :: Window -> X NamedWindow
getNameWMClass Window
w =
forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d
-> do
let getIt :: IO NamedWindow
getIt = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO TextProperty
getProp (forall a. Ptr a -> IO CInt
xFree forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextProperty -> CString
tp_value) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Window -> NamedWindow
`NW` Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextProperty -> IO String
copy)
getProp :: IO TextProperty
getProp = Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w Window
wM_CLASS
copy :: TextProperty -> IO String
copy TextProperty
prop =
forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> TextProperty -> IO [String]
wcTextPropertyToTextList Display
d TextProperty
prop
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
IO NamedWindow
getIt forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
_) ->
(String -> Window -> NamedWindow
`NW` Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassHint -> String
resName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> IO ClassHint
getClassHint Display
d Window
w
unName :: NamedWindow -> Window
unName :: NamedWindow -> Window
unName (NW String
_ Window
w) = Window
w
withNamedWindow :: (NamedWindow -> X ()) -> X ()
withNamedWindow :: (NamedWindow -> X ()) -> X ()
withNamedWindow NamedWindow -> X ()
f = do WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws) (Window -> X NamedWindow
getName forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> NamedWindow -> X ()
f)