X.H.EwmhDesktops: Improve interface for hooking window activation

https://github.com/xmonad/xmonad-contrib/pull/192 introduced a breaking change:

  * `XMonad.Hooks.EwmhDesktops`

    `ewmh` function will use `logHook` for handling activated window. And now
    by default window activation will do nothing.

This breaking change can be avoided if we designed that a bit
differently. #192 changed `ewmhDesktopsEventHook` to invoke `logHook`
instead of focusing the window that requested activation and now
`logHook` is supposed to invoke a `ManageHook` through `activateLogHook`
which consults a global `NetActivated` extensible state to tell if it's
being invoked from `ewmhDesktopsEventHook`. This seems convoluted to me.

A better design, in my opinion, is to invoke the `ManageHook` directly
from `ewmhDesktopsEventHook`, and we just need a way to configure the
hook. Luckily, we now have `X.U.ExtensibleConf` which makes this
straightforward. So we now have a `setEwmhActivateHook`, and the
activation hook defaults to focusing the window, undoing the breaking
change.

Fixes: https://github.com/xmonad/xmonad-contrib/issues/396
Related: https://github.com/xmonad/xmonad-contrib/pull/110
Related: https://github.com/xmonad/xmonad-contrib/pull/192
Related: https://github.com/xmonad/xmonad-contrib/pull/128

CHANGES.md

@@ -47,13 +47,11 @@
       `addEwmhWorkspaceRename` functions, or better still, use integrations
       provided by modules such as `XMonad.Actions.WorkspaceNames`.
 
-    - `ewmh` function will use `logHook` for handling activated window. And now
+      This interface now additionally allows customization of what happens
-      by default window activation will do nothing.
+      when clients request window activation. This can be used to ignore
-
+      activation of annoying applications, to mark windows as urgent instead
-      You can use regular `ManageHook` combinators for changing window
+      of focusing them, and more. There's also a new `XMonad.Hooks.Focus`
-      activation behavior and then add resulting `ManageHook` using
+      module extending the ManageHook EDSL with useful combinators.
-      `activateLogHook` to your `logHook`. Also, module `X.H.Focus` provides
-      additional combinators.
 
     - Ordering of windows that are set to `_NET_CLIENT_LIST` and `_NET_CLIENT_LIST_STACKING`
       was changed to be closer to the spec. From now these two lists will have

XMonad/Config/Desktop.hs

@@ -60,7 +60,6 @@ import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Layout.LayoutModifier (ModifiedLayout)
 import XMonad.Util.Cursor
-import qualified XMonad.StackSet as W
 
 import qualified Data.Map as M
 
@@ -172,7 +171,6 @@ desktopConfig :: XConfig (ModifiedLayout AvoidStruts
 desktopConfig = docks $ ewmh def
     { startupHook     = setDefaultCursor xC_left_ptr <+> startupHook def
     , layoutHook      = desktopLayoutModifiers $ layoutHook def
-    , logHook         = desktopLogHook <+> logHook def
     , keys            = desktopKeys <+> keys def }
 
 desktopKeys :: XConfig l -> M.Map (KeyMask, KeySym) (X ())
@@ -181,8 +179,3 @@ desktopKeys XConfig{modMask = modm} = M.fromList
 
 desktopLayoutModifiers :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
 desktopLayoutModifiers = avoidStruts
-
--- | 'logHook' preserving old 'ewmh' behavior to switch workspace and focus to
--- activated window.
-desktopLogHook :: X ()
-desktopLogHook      = activateLogHook (reader W.focusWindow >>= doF)

XMonad/Hooks/EwmhDesktops.hs

@@ -37,9 +37,8 @@ module XMonad.Hooks.EwmhDesktops (
     addEwmhWorkspaceRename, setEwmhWorkspaceRename,
 
     -- ** Window activation
-    NetActivated (..),
+    -- $customActivate
-    activated,
+    setEwmhActivateHook,
-    activateLogHook,
 
     -- * Standalone hooks (to be deprecated)
     ewmhDesktopsStartup,
@@ -59,6 +58,7 @@ import XMonad
 import XMonad.Prelude
 import qualified XMonad.StackSet as W
 
+import XMonad.Hooks.ManageHelpers
 import XMonad.Hooks.SetWMName
 import XMonad.Util.WorkspaceCompare
 import XMonad.Util.WindowProperties (getProp32)
@@ -81,34 +81,6 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- 'XMonad.Hooks.UrgencyHook.withUrgencyHook', which provide support for other
 -- parts of the
 -- <https://specifications.freedesktop.org/wm-spec/latest/ EWMH specification>.
---
--- __/NOTE:/__ 'ewmh' function will call 'logHook' for handling activated
--- window.
---
--- And now by default window activation will do nothing: neither switch
--- workspace, nor focus. You can use regular 'ManageHook' combinators for
--- changing window activation behavior and then add resulting 'ManageHook'
--- using 'activateLogHook' to your 'logHook'. Also, you may be interested in
--- "XMonad.Hooks.Focus", which provides additional predicates for using in
--- 'ManageHook'.
---
--- To get back old 'ewmh' window activation behavior (switch workspace and
--- focus to activated window) you may use:
---
--- > import XMonad
--- >
--- > import XMonad.Hooks.EwmhDesktops
--- > import qualified XMonad.StackSet as W
--- >
--- > main :: IO ()
--- > main = do
--- >         let acMh :: ManageHook
--- >             acMh = reader W.focusWindow >>= doF
--- >             xcf = ewmh $ def
--- >                    { modMask = mod4Mask
--- >                    , logHook = activateLogHook acMh <+> logHook def
--- >                    }
--- >         xmonad xcf
 
 -- | Add EWMH support for workspaces (virtual desktops) to the given
 -- 'XConfig'.  See above for an example.
@@ -128,12 +100,15 @@ data EwmhDesktopsConfig =
             -- ^ configurable workspace sorting/filtering
         , workspaceRename :: X (String -> WindowSpace -> String)
             -- ^ configurable workspace rename (see 'XMonad.Hooks.StatusBar.PP.ppRename')
+        , activateHook :: ManageHook
+            -- ^ configurable handling of window activation requests
         }
 
 instance Default EwmhDesktopsConfig where
     def = EwmhDesktopsConfig
         { workspaceSort = getSortByIndex
         , workspaceRename = pure pure
+        , activateHook = doFocus
         }
 
 
@@ -210,6 +185,50 @@ setEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XC
 setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f }
 
 
+-- $customActivate
+-- When a client sends a @_NET_ACTIVE_WINDOW@ request to activate a window, by
+-- default that window is activated by invoking the 'doFocus' 'ManageHook'.
+-- <https://specifications.freedesktop.org/wm-spec/1.5/ar01s03.html#idm45623294083744 The EWMH specification suggests>
+-- that a window manager may instead just mark the window as urgent, and this
+-- can be achieved using the following:
+--
+-- > import XMonad.Hooks.UrgencyHook
+-- >
+-- > main = xmonad $ … . setEwmhActivateHook doAskUrgent . ewmh . … $ def{…}
+--
+-- One may also wish to ignore activation requests from certain applications
+-- entirely:
+--
+-- > import XMonad.Hooks.ManageHelpers
+-- >
+-- > myActivateHook :: ManageHook
+-- > myActivateHook =
+-- >   className /=? "Google-chrome" <&&> className /=? "google-chrome" --> doFocus
+-- >
+-- > main = xmonad $ … . setEwmhActivateHook myActivateHook . ewmh . … $ def{…}
+--
+-- Arbitrarily complex hooks can be used. This last example marks Chrome
+-- windows as urgent and focuses everything else:
+--
+-- > myActivateHook :: ManageHook
+-- > myActivateHook = composeOne
+-- >   [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent
+-- >   , pure True -?> doFocus ]
+--
+-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus"
+-- for functions that can be useful here.
+
+-- | Set (replace) the hook which is invoked when a client sends a
+-- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus'
+-- which focuses the window immediately, switching workspace if necessary.
+-- 'XMonad.Hooks.UrgencyHook.doAskUrgent' is a less intrusive alternative.
+--
+-- More complex hooks can be constructed using combinators from
+-- "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus".
+setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l
+setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h }
+
+
 -- | Initializes EwmhDesktops and advertises EWMH support to the X server.
 ewmhDesktopsStartup :: X ()
 ewmhDesktopsStartup = setSupported
@@ -315,44 +334,10 @@ ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename} = withWi
     let activeWindow' = fromMaybe none (W.peek s)
     whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow'
 
--- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep
--- this value in global state, because i use 'logHook' for handling activated
--- windows and i need a way to tell 'logHook' what window is activated.
-newtype NetActivated    = NetActivated {netActivated :: Maybe Window}
-  deriving Show
-instance ExtensionClass NetActivated where
-    initialValue        = NetActivated Nothing
-
--- | Was new window @_NET_ACTIVE_WINDOW@ activated?
-activated :: Query Bool
-activated           = fmap (isJust . netActivated) (liftX XS.get)
-
--- | Run supplied 'ManageHook' for activated windows /only/. If you want to
--- run this 'ManageHook' for new windows too, add it to 'manageHook'.
---
--- __/NOTE:/__ 'activateLogHook' will work only _once_. I.e. if several
--- 'activateLogHook'-s was used, only first one will actually run (because it
--- resets 'NetActivated' at the end and others won't know, that window is
--- activated).
-activateLogHook :: ManageHook -> X ()
-activateLogHook mh  = XS.get >>= maybe (return ()) go . netActivated
-  where
-    go :: Window -> X ()
-    go w            = do
-        f <- runQuery mh w
-        -- I should reset 'NetActivated' here, because:
-        --  * 'windows' calls 'logHook' and i shouldn't go here the second
-        --  time for one window.
-        --  * if i reset 'NetActivated' before running 'logHook' once,
-        --  then 'activated' predicate won't match.
-        -- Thus, here is the /only/ correct place.
-        XS.put NetActivated{netActivated = Nothing}
-        windows (appEndo f)
-
 ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All
 ewmhDesktopsEventHook'
         ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d}
-        EwmhDesktopsConfig{workspaceSort} =
+        EwmhDesktopsConfig{workspaceSort, activateHook} =
     withWindowSet $ \s -> do
         sort' <- workspaceSort
         let ws = sort' $ W.workspaces s
@@ -373,11 +358,9 @@ ewmhDesktopsEventHook'
             | mt == a_aw, 2 : _ <- d ->
                 -- when the request comes from a pager, honor it unconditionally
                 -- https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html#sourceindication
-                windows $ W.focusWindow w
+                if W.peek s == Just w then mempty else windows $ W.focusWindow w
-            | mt == a_aw, W.peek s /= Just w -> do
+            | mt == a_aw -> do
-                lh <- asks (logHook . config)
+                if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w
-                XS.put (NetActivated (Just w))
-                lh
             | mt == a_cw ->
                 killWindow w
             | otherwise ->

XMonad/Hooks/Focus.hs

@@ -70,7 +70,6 @@ import XMonad.Prelude
 import qualified XMonad.StackSet as W
 import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Hooks.ManageHelpers (currentWs)
-import XMonad.Hooks.EwmhDesktops (activated)
 
 
 -- $main
@@ -555,22 +554,19 @@ when' b mx
 -- | Default EWMH window activation behavior: switch to workspace with
 -- activated window and switch focus to it.
 activateSwitchWs :: ManageHook
-activateSwitchWs    = manageFocus (liftQuery activated -->
+activateSwitchWs    = manageFocus (switchWorkspace <+> switchFocus)
-                        switchWorkspace <+> switchFocus)
 
 -- | Move activated window to current workspace.
 activateOnCurrent' :: ManageHook
-activateOnCurrent'  = activated --> currentWs >>= unlessFocusLock . doShift
+activateOnCurrent'  = currentWs >>= unlessFocusLock . doShift
 
 -- | Move activated window to current workspace and switch focus to it. Note,
 -- that i need to explicitly call 'switchFocus' here, because otherwise, when
 -- activated window is /already/ on current workspace, focus won't be
 -- switched.
 activateOnCurrentWs :: ManageHook
-activateOnCurrentWs = manageFocus (liftQuery activated <&&> newOnCur --> switchFocus)
+activateOnCurrentWs = manageFocus (newOnCur --> switchFocus) <+> activateOnCurrent'
-                        <+> activateOnCurrent'
 
 -- | Move activated window to current workspace, but keep focus unchanged.
 activateOnCurrentKeepFocus :: ManageHook
-activateOnCurrentKeepFocus  = manageFocus (liftQuery activated <&&> newOnCur --> keepFocus)
+activateOnCurrentKeepFocus  = manageFocus (newOnCur --> keepFocus) <+> activateOnCurrent'
-                        <+> activateOnCurrent'

XMonad/Hooks/ManageHelpers.hs

@@ -56,6 +56,7 @@ module XMonad.Hooks.ManageHelpers (
     doSink,
     doLower,
     doRaise,
+    doFocus,
     Match,
 ) where
 
@@ -274,7 +275,7 @@ doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w)
 
 -- | Sinks a window
 doSink :: ManageHook
-doSink = reader (Endo . W.sink)
+doSink = doF . W.sink =<< ask
 
 -- | Lower an unmanaged window. Useful together with 'doIgnore' to lower
 -- special windows that for some reason don't do it themselves.
@@ -285,3 +286,7 @@ doLower = ask >>= \w -> liftX $ withDisplay $ \dpy -> io (lowerWindow dpy w) >>
 -- special windows that for some reason don't do it themselves.
 doRaise :: ManageHook
 doRaise = ask >>= \w -> liftX $ withDisplay $ \dpy -> io (raiseWindow dpy w) >> mempty
+
+-- | Focus a window (useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook').
+doFocus :: ManageHook
+doFocus = doF . W.focusWindow =<< ask

XMonad/Hooks/UrgencyHook.hs

@@ -564,7 +564,7 @@ askUrgent w = withDisplay $ \dpy -> do
 
 -- | Helper for 'ManageHook' that marks the window as urgent (unless
 -- suppressed, see 'SuppressWhen'). Useful in
--- 'XMonad.Hooks.EwmhDesktops.activateLogHook' and also in combination with
+-- 'XMonad.Hooks.EwmhDesktops.setEwmhActivateHook' and also in combination
--- "XMonad.Hooks.InsertPosition", "XMonad.Hooks.Focus".
+-- with "XMonad.Hooks.InsertPosition", "XMonad.Hooks.Focus".
 doAskUrgent :: ManageHook
 doAskUrgent = ask >>= \w -> liftX (askUrgent w) >> mempty