xmonad ewmhExtra: switch to desktop greedily

1 files changed, 20 insertions, 2 deletions

diff --git a/pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs b/pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
index bf84314..7a8947f 100644
--- a/pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
+++ b/pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
@@ -9,11 +9,12 @@ import Data.Maybe (fromMaybe)
 import Data.Monoid (All)
 import Data.Tuple.Extra (both)
 import Graphics.X11.EWMH (getDesktopNames, setDesktopNames)
-import Graphics.X11.EWMH.Atom (_NET_DESKTOP_NAMES)
+import Graphics.X11.EWMH.Atom (_NET_CURRENT_DESKTOP, _NET_DESKTOP_NAMES)
 import Graphics.X11.Xlib.Display.Extra (withDefaultDisplay)
 import XMonad hiding (workspaces)
+import XMonad.Prelude ((!?)) -- this is part of >=base-4.19's Data.List
 import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace, removeEmptyWorkspaceByTag)
-import XMonad.StackSet (mapWorkspace, tag, workspaces)
+import XMonad.StackSet (currentTag, greedyView, mapWorkspace, tag, workspaces)
 import XMonad.Util.WorkspaceCompare (getSortByIndex)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -44,6 +45,23 @@ ewmhExtra c = do
 
 ewmhDesktopsExtraEventHook :: Event -> X All
 ewmhDesktopsExtraEventHook = \case
+
+    -- Replace default non-greedy implementation of
+    -- XMonad.Hooks.EwmhDesktops.ewmhDesktopsEventHook'
+    ClientMessageEvent{ev_window, ev_message_type, ev_data = n : _}
+          | ev_message_type == _NET_CURRENT_DESKTOP-> do
+      r <- asks theRoot
+      when (ev_window == r) $
+        withWindowSet $ \s -> do
+          sort <- getSortByIndex
+          case (map tag . sort . workspaces $ s) !? fromIntegral n of
+            Just t ->
+              when (currentTag s /= t) $
+                windows $ greedyView t
+            _ ->
+              trace $ "Bad _NET_CURRENT_DESKTOP with data=" <> show n
+      mempty
+
     PropertyEvent{ev_window, ev_atom} -> do
       r <- asks theRoot
       when (ev_window == r && ev_atom == _NET_DESKTOP_NAMES) $