aboutsummaryrefslogtreecommitdiffstats
path: root/EwmhDesktops.hs
blob: 0fbe0fa898296d818c3952e128c3a5016ea97245 (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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
-----------------------------------------------------------------------------
-- |
-- Module       : XMonadContrib.EwmhDesktops
-- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
-- License      : BSD
--
-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
-- Stability    : unstable
-- Portability  : unportable
--
-- Makes xmonad use the EWMH hints to tell panel applications about its
-- workspaces and the windows therein.
-----------------------------------------------------------------------------
module XMonadContrib.EwmhDesktops (
	-- * Usage
	-- $usage
	ewmhDesktopsLogHook
	) where

import Data.List	(elemIndex, sortBy)
import Data.Ord 	(comparing)
import Data.Maybe	(fromMaybe)

import Control.Monad.Reader
import XMonad
import qualified StackSet as W
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

import XMonadContrib.SetWMName

-- $usage
-- Add the imports to your configuration file and add the logHook:
--
-- > import XMonadContrib.EwmhDesktops
--
-- > logHook :: X()
-- > logHook = do ewmhDesktopsLogHook
-- >              return ()

-- %import XMonadContrib.EwmhDesktops
-- %def -- comment out default logHook definition above if you uncomment this:
-- %def logHook = ewmhDesktopsLogHook


-- |
-- Notifies pagers and window lists, such as those in the gnome-panel
-- of the current state of workspaces and windows.
ewmhDesktopsLogHook :: X ()
ewmhDesktopsLogHook = withWindowSet $ \s -> do
	-- Bad hack because xmonad forgets the original order of things, it seems
	-- see http://code.google.com/p/xmonad/issues/detail?id=53
	let ws = sortBy (comparing W.tag) $ W.workspaces s
	let wins = W.allWindows s

	setSupported

	-- Number of Workspaces
	setNumberOfDesktops (length ws)

	-- Names thereof
	setDesktopNames (map W.tag ws)
	
	-- Current desktop
	fromMaybe (return ()) $ do
		n <- W.lookupWorkspace 0 s
		i <- elemIndex n $ map W.tag ws
		return $ setCurrentDesktop i

	setClientList wins

	-- Per window Desktop
	forM (zip ws [(0::Int)..]) $ \(w, wn) ->
		forM (W.integrate' (W.stack w)) $ \win -> do 
			setWindowDesktop win wn
	
	return ()


setNumberOfDesktops :: (Integral a) => a -> X ()
setNumberOfDesktops n = withDisplay $ \dpy -> do 
        a <- getAtom "_NET_NUMBER_OF_DESKTOPS"
        c <- getAtom "CARDINAL"
	r <- asks theRoot
	io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]

setCurrentDesktop :: (Integral a) => a -> X ()
setCurrentDesktop i = withDisplay $ \dpy -> do
	a <- getAtom "_NET_CURRENT_DESKTOP"
	c <- getAtom "CARDINAL"
	r <- asks theRoot
	io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]

setDesktopNames :: [String] -> X ()
setDesktopNames names = withDisplay $ \dpy -> do
	-- Names thereof
	r <- asks theRoot
	a <- getAtom "_NET_DESKTOP_NAMES"
	c <- getAtom "UTF8_STRING"
	let names' = map (fromIntegral.fromEnum) $
			concatMap (("Workspace "++) . (++['\0'])) names
	io $ changeProperty8 dpy r a c propModeReplace names'

setClientList :: [Window] -> X ()
setClientList wins = withDisplay $ \dpy -> do
	-- (What order do we really need? Something about age and stacking)
	r <- asks theRoot
	c <- getAtom "WINDOW"
	a <- getAtom "_NET_CLIENT_LIST"
	io $ changeProperty32 dpy r a c propModeReplace wins
	a' <- getAtom "_NET_CLIENT_LIST_STACKING"
	io $ changeProperty32 dpy r a' c propModeReplace wins

setWindowDesktop :: (Integral a) => Window -> a -> X ()
setWindowDesktop win i = withDisplay $ \dpy -> do 
	a <- getAtom "_NET_WM_DESKTOP"
	c <- getAtom "CARDINAL"
	io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]

setSupported :: X ()
setSupported = withDisplay $ \dpy -> do 
	r <- asks theRoot
	a <- getAtom "_NET_SUPPORTED"
	c <- getAtom "ATOM"
	supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"]
	io $ changeProperty32 dpy r a c propModeReplace supp
	
	setWMName "xmonad"