Skip to content

Commit a6b4578

Browse files
liskinliskin
committed
X.H.EWMH.Desktops: New module; implement desktops/windows EWMH hints
This is almost functionally equivalent to X.H.EwmhDesktops except for the manageHook window activation (will be replaced by a configurable activateHook) and full-screen handling (will go into its own module).
1 parent 28970d9 commit a6b4578

File tree

2 files changed

+232
-0
lines changed

2 files changed

+232
-0
lines changed

‎XMonad/Hooks/EWMH/Desktops.hs

Lines changed: 231 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,231 @@
1+
{-# LANGUAGE MultiWayIf #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE PatternGuards #-}
4+
5+
-- |
6+
-- Module : XMonad.Hooks.EWMH.Desktops
7+
-- Description : Extended Window Manager Hints (EWMH) support for workspaces (virtual desktops).
8+
-- Copyright : (c) 2021 Tomáš Janoušek <[email protected]>
9+
-- License : BSD3
10+
-- Maintainer : Tomáš Janoušek <[email protected]>
11+
--
12+
-- Makes xmonad use the EWMH hints to tell panel applications about its
13+
-- workspaces and the windows therein. It also allows the user to interact
14+
-- with xmonad by clicking on panels and window lists.
15+
--
16+
17+
module XMonad.Hooks.EWMH.Desktops (
18+
-- * Usage
19+
-- $usage
20+
ewmhDesktops,
21+
setEwmhWorkspaceListTransform,
22+
addEwmhWorkspaceListTransform,
23+
) where
24+
25+
import Codec.Binary.UTF8.String (encode)
26+
import Data.Bits (complement)
27+
import XMonad
28+
import XMonad.Prelude
29+
import XMonad.Util.EWMH
30+
import XMonad.Util.WorkspaceCompare (getSortByIndex)
31+
import qualified Data.Map as M
32+
import qualified XMonad.StackSet as W
33+
import qualified XMonad.Util.ExtensibleConf as XC
34+
import qualified XMonad.Util.ExtensibleState as XS
35+
36+
-- ---------------------------------------------------------------------
37+
-- $usage
38+
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
39+
--
40+
-- > main = xmonad $ … . ewmhDesktops . … $ def{…}
41+
42+
newtype EwmhDesktopsConfig =
43+
EwmhDesktopsConfig
44+
{ workspaceListTransform :: [WindowSpace] -> [WindowSpace]
45+
}
46+
47+
instance Default EwmhDesktopsConfig where
48+
def = EwmhDesktopsConfig
49+
{ workspaceListTransform = id
50+
}
51+
52+
data EwmhDesktops = EwmhDesktops
53+
54+
-- | Add EWMH support for workspaces (virtual desktops) to 'XConfig'.
55+
ewmhDesktops :: XConfig l -> XConfig l
56+
ewmhDesktops = ewmhSupported hints . XC.onceIni EwmhDesktops hooks
57+
where
58+
hints = [ "_NET_DESKTOP_NAMES"
59+
, "_NET_NUMBER_OF_DESKTOPS"
60+
, "_NET_CLIENT_LIST"
61+
, "_NET_CLIENT_LIST_STACKING"
62+
, "_NET_CURRENT_DESKTOP"
63+
, "_NET_WM_DESKTOP"
64+
, "_NET_ACTIVE_WINDOW"
65+
, "_NET_CLOSE_WINDOW"
66+
]
67+
hooks c = c{ handleEventHook = handleEventHook c <> ewmhDesktopsEventHook
68+
, logHook = logHook c <> ewmhDesktopsLogHook }
69+
70+
-- | Set an arbitrary user-specified function to transform the workspace list
71+
-- (post-sorting). This can be used to e.g. filter out scratchpad workspaces.
72+
setEwmhWorkspaceListTransform :: ([WindowSpace] -> [WindowSpace]) -> XConfig l -> XConfig l
73+
setEwmhWorkspaceListTransform f = XC.modifyDef $ \c -> c{ workspaceListTransform = f }
74+
75+
-- | Like 'setEwmhWorkspaceListTransform', but compose (after) with the
76+
-- existing instead of replacing it.
77+
addEwmhWorkspaceListTransform :: ([WindowSpace] -> [WindowSpace]) -> XConfig l -> XConfig l
78+
addEwmhWorkspaceListTransform f = XC.modifyDef $ \c ->
79+
c{ workspaceListTransform = workspaceListTransform c <> f }
80+
81+
ewmhDesktopsLogHook :: X ()
82+
ewmhDesktopsLogHook = XC.withDef $ \EwmhDesktopsConfig{workspaceListTransform} -> do
83+
withWindowSet $ \s -> do
84+
sort' <- getSortByIndex
85+
let ws = workspaceListTransform $ sort' $ W.workspaces s
86+
87+
-- Set number of workspaces and names thereof
88+
let desktopNames = map W.tag ws
89+
whenModified (NetDesktopNames desktopNames) $ do
90+
setNumberOfDesktops (length desktopNames)
91+
setDesktopNames desktopNames
92+
93+
-- Set client list which should be sorted by window age. We just
94+
-- guess that StackSet contains windows list in this order which
95+
-- isn't true but at least gives consistency with windows cycling
96+
let clientList = nub . concatMap (W.integrate' . W.stack) $ ws
97+
whenModified (NetClientList clientList) $ do
98+
setClientList clientList
99+
100+
-- Set stacking client list which should have bottom-to-top
101+
-- stacking order, i.e. focused window should be last
102+
let clientListStacking = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws
103+
whenModified (NetClientListStacking clientListStacking) $ do
104+
setClientListStacking clientListStacking
105+
106+
-- Set current desktop (remap the current workspace to handle any
107+
-- renames that workspaceListTransform might be doing).
108+
let maybeCurrent' = W.tag <$> listToMaybe (workspaceListTransform [W.workspace $ W.current s])
109+
current = flip elemIndex (map W.tag ws) =<< maybeCurrent'
110+
whenModified (NetCurrentDesktop $ fromMaybe 0 current) $
111+
mapM_ setCurrentDesktop current
112+
113+
-- Set window-desktop mapping
114+
let windowDesktops =
115+
let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]
116+
in M.unions $ zipWith f [0..] ws
117+
whenModified (NetWmDesktop windowDesktops) $
118+
mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
119+
120+
-- Set active window
121+
let activeWindow = fromMaybe none (W.peek s)
122+
whenModified (NetActiveWindow activeWindow) $ do
123+
setActiveWindow activeWindow
124+
125+
ewmhDesktopsEventHook :: Event -> X All
126+
ewmhDesktopsEventHook ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} =
127+
XC.withDef $ \EwmhDesktopsConfig{workspaceListTransform} ->
128+
withWindowSet $ \s -> do
129+
sort' <- getSortByIndex
130+
let ws = workspaceListTransform $ sort' $ W.workspaces s
131+
132+
a_cd <- getAtom "_NET_CURRENT_DESKTOP"
133+
a_d <- getAtom "_NET_WM_DESKTOP"
134+
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
135+
a_cw <- getAtom "_NET_CLOSE_WINDOW"
136+
137+
if | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->
138+
if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww)
139+
| mt == a_cd ->
140+
trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d
141+
| mt == a_d, n : _ <- d, Just ww <- ws !? fi n ->
142+
if W.findTag w s == Just (W.tag ww) then mempty else windows $ W.shiftWin (W.tag ww) w
143+
| mt == a_d ->
144+
trace $ "Bad _NET_WM_DESKTOP with data=" ++ show d
145+
| mt == a_aw, 2 : _ <- d ->
146+
-- when the request comes from a pager, honor it unconditionally
147+
-- https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html#sourceindication
148+
windows $ W.focusWindow w
149+
| mt == a_aw, W.peek s /= Just w -> do
150+
-- TODO: activateHook
151+
windows $ W.focusWindow w
152+
| mt == a_cw ->
153+
killWindow w
154+
| otherwise ->
155+
-- The Message is unknown to us, but that is ok, not all are meant
156+
-- to be handled by the window manager
157+
mempty
158+
159+
mempty
160+
ewmhDesktopsEventHook _ = mempty
161+
162+
-- | Cached @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@
163+
newtype NetDesktopNames = NetDesktopNames [String] deriving Eq
164+
instance ExtensionClass NetDesktopNames where initialValue = NetDesktopNames []
165+
166+
-- | Cached @_NET_CLIENT_LIST@
167+
newtype NetClientList = NetClientList [Window] deriving Eq
168+
instance ExtensionClass NetClientList where initialValue = NetClientList [none]
169+
170+
-- | Cached @_NET_CLIENT_LIST_STACKING@
171+
newtype NetClientListStacking = NetClientListStacking [Window] deriving Eq
172+
instance ExtensionClass NetClientListStacking where initialValue = NetClientListStacking [none]
173+
174+
-- | Cached @_NET_CURRENT_DESKTOP@
175+
newtype NetCurrentDesktop = NetCurrentDesktop Int deriving Eq
176+
instance ExtensionClass NetCurrentDesktop where initialValue = NetCurrentDesktop (complement 0)
177+
178+
-- | Cached @_NET_WM_DESKTOP@
179+
newtype NetWmDesktop = NetWmDesktop (M.Map Window Int) deriving Eq
180+
instance ExtensionClass NetWmDesktop where initialValue = NetWmDesktop (M.singleton none (complement 0))
181+
182+
-- | Cached @_NET_ACTIVE_WINDOW@
183+
newtype NetActiveWindow = NetActiveWindow Window deriving Eq
184+
instance ExtensionClass NetActiveWindow where initialValue = NetActiveWindow (complement none)
185+
186+
-- | Update value in extensible state, run action if it changed.
187+
whenModified :: (Eq a, ExtensionClass a) => a -> X () -> X ()
188+
whenModified = whenX . XS.modified . const
189+
190+
setNumberOfDesktops :: Int -> X ()
191+
setNumberOfDesktops n = withDisplay $ \dpy -> do
192+
a <- getAtom "_NET_NUMBER_OF_DESKTOPS"
193+
r <- asks theRoot
194+
io $ changeProperty32 dpy r a cARDINAL propModeReplace [fi n]
195+
196+
setDesktopNames :: [String] -> X ()
197+
setDesktopNames names = withDisplay $ \dpy -> do
198+
r <- asks theRoot
199+
a <- getAtom "_NET_DESKTOP_NAMES"
200+
c <- getAtom "UTF8_STRING"
201+
let enc = map fi . concatMap ((++[0]) . encode)
202+
io $ changeProperty8 dpy r a c propModeReplace $ enc names
203+
204+
setClientList :: [Window] -> X ()
205+
setClientList wins = withDisplay $ \dpy -> do
206+
r <- asks theRoot
207+
a <- getAtom "_NET_CLIENT_LIST"
208+
io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fi wins)
209+
210+
setClientListStacking :: [Window] -> X ()
211+
setClientListStacking wins = withDisplay $ \dpy -> do
212+
r <- asks theRoot
213+
a <- getAtom "_NET_CLIENT_LIST_STACKING"
214+
io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fi wins)
215+
216+
setCurrentDesktop :: Int -> X ()
217+
setCurrentDesktop i = withDisplay $ \dpy -> do
218+
a <- getAtom "_NET_CURRENT_DESKTOP"
219+
r <- asks theRoot
220+
io $ changeProperty32 dpy r a cARDINAL propModeReplace [fi i]
221+
222+
setWindowDesktop :: Window -> Int -> X ()
223+
setWindowDesktop win i = withDisplay $ \dpy -> do
224+
a <- getAtom "_NET_WM_DESKTOP"
225+
io $ changeProperty32 dpy win a cARDINAL propModeReplace [fi i]
226+
227+
setActiveWindow :: Window -> X ()
228+
setActiveWindow w = withDisplay $ \dpy -> do
229+
r <- asks theRoot
230+
a <- getAtom "_NET_ACTIVE_WINDOW"
231+
io $ changeProperty32 dpy r a wINDOW propModeReplace [fi w]

‎xmonad-contrib.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -170,6 +170,7 @@ library
170170
XMonad.Hooks.DynamicIcons
171171
XMonad.Hooks.DynamicLog
172172
XMonad.Hooks.DynamicProperty
173+
XMonad.Hooks.EWMH.Desktops
173174
XMonad.Hooks.EwmhDesktops
174175
XMonad.Hooks.FadeInactive
175176
XMonad.Hooks.FadeWindows

0 commit comments

Comments
 (0)