Skip to content

Commit

Permalink
X.H.UrgencyHook: Add askUrgent and doAskUrgent
Browse files Browse the repository at this point in the history
These are useful when one blocks some _NET_ACTIVE_WINDOW requests but
still wants to somehow show that a window requested focus.

Related: #110
Related: #128
Related: #192
  • Loading branch information
liskin committed Oct 18, 2021
1 parent e72e663 commit 8df5bd9
Show file tree
Hide file tree
Showing 2 changed files with 31 additions and 1 deletion.
4 changes: 4 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -634,6 +634,10 @@
- Added a variant of `filterUrgencyHook` that takes a generic `Query Bool`
to select which windows should never be marked urgent.

- Added `askUrgent` and a `doAskUrgent` manage hook helper for marking
windows as urgent from inside of xmonad. This can be used as a less
intrusive action for windows requesting focus.

* `XMonad.Hooks.ServerMode`

- To make it easier to use, the `xmonadctl` client is now included in
Expand Down
28 changes: 27 additions & 1 deletion XMonad/Hooks/UrgencyHook.hs
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,7 @@ module XMonad.Hooks.UrgencyHook (
FocusHook(..),
filterUrgencyHook, filterUrgencyHook',
minutes, seconds,
askUrgent, doAskUrgent,
-- * Stuff for developers:
readUrgents, withUrgents, clearUrgents',
StdoutUrgencyHook(..),
Expand All @@ -70,7 +71,7 @@ module XMonad.Hooks.UrgencyHook (
) where

import XMonad
import XMonad.Prelude (delete, fromMaybe, listToMaybe, maybeToList, when, (\\))
import XMonad.Prelude (fi, delete, fromMaybe, listToMaybe, maybeToList, when, (\\))
import qualified XMonad.StackSet as W

import XMonad.Hooks.ManageHelpers (windowTag)
Expand Down Expand Up @@ -542,3 +543,28 @@ filterUrgencyHook skips = filterUrgencyHook' $ maybe False (`elem` skips) <$> wi
-- should never be marked urgent.
filterUrgencyHook' :: Query Bool -> Window -> X ()
filterUrgencyHook' q w = whenX (runQuery q w) (clearUrgents' [w])

-- | Mark the given window urgent.
--
-- (The implementation is a bit hacky: send a _NET_WM_STATE ClientMessage to
-- ourselves. This is so that we respect the 'SuppressWhen' of the configured
-- urgency hooks. If this module if ever migrated to the ExtensibleConf
-- infrastrcture, we'll then invoke markUrgent directly.)
askUrgent :: Window -> X ()
askUrgent w = withDisplay $ \dpy -> do
rw <- asks theRoot
a_wmstate <- getAtom "_NET_WM_STATE"
a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
let state_add = 1
let source_pager = 2
io $ allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e w a_wmstate 32 [state_add, fi a_da, 0, source_pager]
sendEvent dpy rw False (substructureRedirectMask .|. substructureNotifyMask) e

-- | 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.InsertPosition", "XMonad.Hooks.Focus".
doAskUrgent :: ManageHook
doAskUrgent = ask >>= \w -> liftX (askUrgent w) >> return mempty

0 comments on commit 8df5bd9

Please sign in to comment.