-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.NamedWindows
-- Description :  Associate the X titles of windows with them.
-- Copyright   :  (c) David Roundy <droundy@darcs.net>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  none
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module allows you to associate the X titles of windows with
-- them.
--
-----------------------------------------------------------------------------

module XMonad.Util.NamedWindows (
                                   -- * Usage
                                   -- $usage
                                   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

-- $usage
-- See "XMonad.Layout.Tabbed" for an example of its use.


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
    -- TODO, this code is ugly and convoluted -- clean it up
    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

-- | Get 'NamedWindow' using 'wM_CLASS'
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
    -- TODO, this code is ugly and convoluted -- clean it up
   -> 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)