aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Hooks/XPropManage.hs
blob: 245a6a6027ba048c27c652b7234f17f141508045 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Hooks.XPropManage
-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
-- License      : BSD
--
-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
-- Stability    : unstable
-- Portability  : unportable
--
-- A ManageHook matching on XProperties.
-----------------------------------------------------------------------------

module XMonad.Hooks.XPropManage (
                 -- * Usage
                 -- $usage
                 xPropManageHook, XPropMatch, pmX, pmP
                 ) where

import Data.Char (chr)
import Data.List (concat)

import Control.Monad.State
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

import XMonad

-- $usage
-- 
-- Add something like the following lines to Config.hs to use this module
--
-- > import XMonad.Hooks.XPropManage
-- 
-- > manageHook = xPropManageHook xPropMatches 
-- >
-- > xPropMatches :: [XPropMatch]
-- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==)))], (\w -> float w >> return (W.shift "2")))
-- >                , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen"))
-- >                , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3"))
-- >                ]
--
-- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND
--
-- A XPropMatch consists of a list of conditions and function telling what to do.
--
-- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1,
-- and an function which matches onto the value of the property (represented as a List
-- of Strings).
--
-- If a match succeeds the function is called immediately, can perform any action and then return
-- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the
-- WindowSet use just 'pmP function'.
--
-- \*1 You can get the available properties of an application with the xprop utility. STRING properties
-- should work fine. Others might not work.
--

type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet)))

pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
pmX f w = f w >> return id

pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)
pmP f _ = return f

xPropManageHook :: [XPropMatch] -> Window -> X (WindowSet -> WindowSet)
xPropManageHook tms w = withDisplay $ \d -> do
    fs <- mapM (matchProp d w `uncurry`) tms
    return (foldr (.) id fs)

matchProp :: Display -> Window -> [(Atom, [String] -> Bool)] -> (Window -> X (WindowSet -> WindowSet)) -> X (WindowSet -> WindowSet)
matchProp d w tm tf = do
    m <- and `liftM` sequence (map (\(k,f) -> f `liftM` getProp d w k) tm)
    case m of
        True   -> tf w
        False  -> return id

getProp :: Display -> Window -> Atom -> X ([String])
getProp d w p = do
    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])
    let filt q | q == wM_COMMAND = concat . map splitAtNull
               | otherwise       = id
    return (filt p prop)

splitAtNull :: String -> [String]
splitAtNull s = case dropWhile (== (chr 0)) s of
    "" -> []
    s' -> w : splitAtNull s''
          where (w, s'') = break (== (chr 0)) s'