X.H.EwmhDesktops: use manageHook for handling activated window.

Move EWMH code from `X.H.Focus` to `X.H.EwmhDesktops`. Thus:

- I'll use `manageHook` for handling activated window.
- By default window activation do nothing (assuming default `ManageHook`).
- I can use `activated` predicate for changing window activation behavior.
- I may use additional combinators from `X.H.Focus` for more complex
  focus/workspace switch strategies.
This commit is contained in:
sgf 2016-12-16 16:02:53 +03:00
parent 8e5931272c
commit c07be09e17
3 changed files with 103 additions and 156 deletions

View File

@ -11,6 +11,18 @@
* New constructor `CenteredAt Rational Rational` added for
`XMonad.Prompt.XPPosition`.
* `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling
activated window. That means, actions, which you don't want to happen on
activated windows, should be guarded by
not <$> activated
predicate. By default, with empty `ManageHook`, window activation will do
nothing.
Also, you can use regular 'ManageHook' combinators for changing window
activation behavior.
### New Modules
* `XMonad.Layout.SortedLayout`

View File

@ -1,3 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.EwmhDesktops
@ -19,6 +21,8 @@ module XMonad.Hooks.EwmhDesktops (
ewmhDesktopsStartup,
ewmhDesktopsLogHook,
ewmhDesktopsLogHookCustom,
NetActivated (..),
activated,
ewmhDesktopsEventHook,
ewmhDesktopsEventHookCustom,
fullscreenEventHook
@ -37,6 +41,7 @@ import XMonad.Hooks.SetWMName
import XMonad.Util.XUtils (fi)
import XMonad.Util.WorkspaceCompare
import XMonad.Util.WindowProperties (getProp32)
import qualified XMonad.Util.ExtensibleState as XS
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@ -48,7 +53,36 @@ import XMonad.Util.WindowProperties (getProp32)
-- > handleEventHook def <+> fullscreenEventHook }
--
-- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".
--
-- __/WARNING!/__ 'ewmh' function will use 'manageHook' for handling activated
-- window. That means, actions, which you don't want to happen on activated
-- windows, should be guarded by
--
-- > not <$> activated
--
-- predicate.
--
-- 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. 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 XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let fh :: ManageHook
-- > fh = manageFocus (liftQuery activated --> switchWorkspace <+> switchFocus)
-- > xcf = ewmh $ def {modMask = mod4Mask, manageHook = fh}
-- > xmonad xcf
-- | Add EWMH functionality to the given config. See above for an example.
ewmh :: XConfig a -> XConfig a
@ -128,6 +162,19 @@ ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id
ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
-- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep
-- this value in global state, because i use 'ManageHook' for handling
-- activated windows and i need a way to tell 'manageHook', that now a window
-- is activated.
newtype NetActivated = NetActivated {netActivated :: Bool}
deriving (Show, Typeable)
instance ExtensionClass NetActivated where
initialValue = NetActivated False
-- | Was new window @_NET_ACTIVE_WINDOW@ activated?
activated :: Query Bool
activated = fmap netActivated (liftX XS.get)
handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
handle f (ClientMessageEvent {
ev_window = w,
@ -153,7 +200,10 @@ handle f (ClientMessageEvent {
windows $ W.shiftWin (W.tag (ws !! fi n)) w
else trace $ "Bad _NET_DESKTOP with data[0]="++show n
else if mt == a_aw then do
windows $ W.focusWindow w
mh <- asks (manageHook . config)
XS.put (NetActivated True)
runQuery mh w >>= windows . appEndo
XS.put (NetActivated False)
else if mt == a_cw then do
killWindow w
else if mt `elem` a_ignore then do

View File

@ -20,7 +20,6 @@ module XMonad.Hooks.Focus
Focus (..)
, FocusLock (..)
, toggleLock
, NetActivated (..)
, FocusQuery
, runFocusQuery
, FocusHook
@ -38,7 +37,6 @@ module XMonad.Hooks.Focus
, focusedCur'
, newOn
, newOnCur
, activated
, unlessFocusLock
-- * Commonly used actions for modifying focus.
@ -53,9 +51,6 @@ module XMonad.Hooks.Focus
--
-- $running
, manageFocus
, activateEventHook
, activateStartupHook
, handleFocusQuery
)
where
@ -70,8 +65,6 @@ import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Hooks.ManageHelpers (currentWs)
import XMonad.Hooks.SetWMName
import XMonad.Util.EZConfig
-- $main
@ -83,33 +76,16 @@ import XMonad.Util.EZConfig
-- - focused window on workspace, where new window will appear;
-- - current workspace;
--
-- And two properties in extensible state:
-- And a property in extensible state:
--
-- - is focus lock enabled? Focus lock instructs all library's 'FocusHook'
-- functions to not move focus.
-- - is new window @_NET_ACTIVE_WINDOW@ activated? It is not really new in
-- that case, but i may work with it in the same way.
-- functions to not move focus or switch workspace.
--
-- Lifting operations for standard 'ManageHook' EDSL combinators into
-- 'FocusQuery' monad allowing to run these combinators on focused window and
-- common actions for keeping focus and\/or workspace, switching focus and\/or
-- workspace are also provided.
--
-- __/WARNING!/__ 'activateEventHook' (which handles window activation) will
-- use 'manageHook' for handling activated window. That means, actions, which
-- you don't want to happen on activated windows, should be guarded by
--
-- > not <$> activated
--
-- predicate. This requires to lift them into 'FocusHook' and then convert
-- back into 'ManageHook' using 'manageFocus'.
--
-- __/WARNING!/__ Since this module enables and handles window activation on
-- its own, it is /not/ compatible with 'XMonad.Hooks.EwmhDesktops.ewmh'
-- function from 'XMonad.Hooks.EwmhDesktops' module. Well, it will compile and
-- work, but window activation handling according to 'FocusHook' won't work,
-- because 'XMonad.Hooks.EwmhDesktops.ewmh' handler will overwrite it.
--
-- I may define 'FocusHook' like:
--
-- > activateFocusHook :: FocusHook
@ -148,29 +124,34 @@ import XMonad.Util.EZConfig
-- And then use it (paste definition of 'FocusHook' above there too) like:
--
-- > import XMonad
-- > import XMonad.Util.EZConfig
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let xcf = handleFocusQuery (Just (mod4Mask, xK_v)) (composeOne
-- > [ activated -?> activateFocusHook
-- > , Just <$> newFocusHook
-- > ])
-- > $ def
-- > let fh :: ManageHook
-- > fh = manageFocus $ (composeOne
-- > [ liftQuery activated -?> activateFocusHook
-- > , Just <$> newFocusHook
-- > ])
-- > xcf = ewmh $ def {manageHook = fh}
-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- > xmonad xcf
--
-- Note:
--
-- - /mod4Mask+v/ key toggles focus lock (when enabled, focus will not be
-- switched to new window).
-- - 'handleFocusQuery' will enable window activation.
-- - The order, when constructing final 'FocusHook' in 'handleFocusQuery'
-- call: 'FocusHook' without 'activated' predicate will match to activated
-- windows too, thus i should place it after one with 'activated' (so the
-- latter will have a chance to handle activated window first).
--
-- - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor
-- workspace won't be switched).
-- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window
-- activation. It will call 'manageHook' for activated window and predicate
-- 'activated' will be 'True' in this case.
-- - The order, when constructing final 'FocusHook': 'FocusHook' without
-- 'activated' predicate will match to activated windows too, thus i should
-- place it after one with 'activated' (so the latter will have a chance to
-- handle activated window first).
--
-- And more technical notes:
--
@ -178,10 +159,10 @@ import XMonad.Util.EZConfig
-- or save results. Precisely, it may do anything, but it must be idempotent
-- to operate properly.
-- - 'FocusHook' will see new window at workspace, where functions on the
-- /right/ from 'handleFocusQuery' in 'ManageHook' monoid place it. In other
-- words, in @(Endo WindowSet)@ monoid i may see changes only from functions
-- applied /before/ (more to the right in function composition). Thus, it's
-- better to apply 'handleFocusQuery' the last.
-- /right/ from it in 'ManageHook' monoid place it. In other words, in
-- @(Endo WindowSet)@ monoid i may see changes only from functions applied
-- /before/ (more to the right in function composition). Thus, it's better to
-- add 'FocusHook' the last.
-- - 'FocusHook' functions won't see window shift to another workspace made
-- by function from 'FocusHook' itself: new window workspace is determined
-- /before/ running 'FocusHook' and even if later one of 'FocusHook'
@ -198,36 +179,30 @@ import XMonad.Util.EZConfig
--
-- now @FH2@ will see window shift made by @FH1@.
--
-- - I may define my own 'handleFocusQuery', all required functions are
-- exported. I may redefine handling of activated windows too, but note:
-- 'handleEventHook' handling window activation should correctly set\/unset
-- 'NetActivated' in extensible state, like 'activateEventHook' does, and
-- usually there should be only one 'handleEventHook' processing activated
-- windows.
--
-- Another interesting example is moving all activated windows to current
-- workspace by default, and applying 'FocusHook' after:
--
-- > import XMonad
-- > import XMonad.Util.EZConfig
-- > import qualified XMonad.StackSet as W
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let xcf = handleFocusQuery (Just (mod4Mask, xK_v)) (composeOne
-- > [ activated -?> (newOnCur --> keepFocus)
-- > , Just <$> newFocusHook
-- > ])
-- > $ def
-- > { manageHook = manageFocus activateOnCurrentWs
-- > }
-- > let fh :: ManageHook
-- > fh = manageFocus $ (composeOne
-- > [ liftQuery activated -?> (newOnCur --> keepFocus)
-- > , Just <$> newFocusHook
-- > ])
-- > xcf = ewmh $ def {manageHook = fh <+> activateOnCurrentWs}
-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- > xmonad xcf
-- >
-- > activateOnCurrentWs :: FocusHook
-- > activateOnCurrentWs = activated --> asks currentWorkspace >>=
-- > new . unlessFocusLock . doShift
-- > activateOnCurrentWs :: ManageHook
-- > activateOnCurrentWs = activated --> currentWs >>= unlessFocusLock . doShift
-- >
-- > newFocusHook :: FocusHook
-- > newFocusHook = composeOne
@ -254,10 +229,10 @@ import XMonad.Util.EZConfig
--
-- - i keep focus, when activated window appears on current workspace, in
-- this example.
-- - when @activated -?> (newOnCur --> keepFocus)@ runs, activated window
-- will be /already/ on current workspace, thus, if i do not want to move
-- some activated windows, i should filter them out in @activateOnCurrentWs@
-- FocusHook.
-- - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated
-- window will be /already/ on current workspace, thus, if i do not want to
-- move some activated windows, i should filter them out in
-- @activateOnCurrentWs@ FocusHook.
-- FocusQuery.
@ -290,15 +265,6 @@ instance ExtensionClass FocusLock where
toggleLock :: X ()
toggleLock = XS.modify (\(FocusLock b) -> FocusLock (not b))
-- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep
-- this value in global state, because i use 'ManageHook' for handling
-- activated windows and i need a way to tell 'manageHook', that now a window
-- is activated.
newtype NetActivated = NetActivated {netActivated :: Bool}
deriving (Show, Typeable)
instance ExtensionClass NetActivated where
initialValue = NetActivated False
-- | Monad on top of Query providing additional information about new window.
newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)
instance Functor FocusQuery where
@ -377,10 +343,6 @@ newOn i = (i ==) <$> asks newWorkspace
newOnCur :: FocusQuery Bool
newOnCur = asks currentWorkspace >>= newOn
-- | Does new window @_NET_ACTIVE_WINDOW@ activated?
activated :: FocusQuery Bool
activated = fmap netActivated (liftQuery (liftX XS.get))
-- | Execute Query, unless focus is locked.
unlessFocusLock :: Monoid a => Query a -> Query a
unlessFocusLock m = do
@ -480,83 +442,6 @@ manageFocus m = do
f <- lookup i cfs
return (appEndo f ws)
-- | 'handleEventHook' for handling activated windows according to
-- 'FocusHook'.
activateEventHook :: ManageHook -> Event -> X All
activateEventHook x ClientMessageEvent {
ev_window = w,
ev_message_type = mt
} = do
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
-- 'NetActivated' state handling is done solely and completely here!
when (mt == a_aw) $ do
XS.put (NetActivated True)
runQuery x w >>= windows . appEndo
XS.put (NetActivated False)
return (All True)
activateEventHook _ _ = return (All True)
-- | 'startupHook' for announcing @_NET_ACTIVE_WINDOW@ in @_NET_SUPPORTED@ and
-- settings @_NET_WM_NAME@.
-- 'setWMName' creates support window (don't know why), sets its _NET_WM_NAME
-- to specified value, sets '_NET_SUPPORTING_WM_CHECK' atom of support window
-- and root window to support window id and and adds two atoms
-- '_NET_SUPPORTING_WM_CHECK' and '_NET_WM_NAME' to '_NET_SUPPORTED' atom of
-- root window (removing any duplicates). And this is required (apart from
-- adding '_NET_ACTIVE_WINDOW' to '_NET_SUPPORTED') for making
-- window activation work. Also, 'setWMName' checks window pointed by
-- '_NET_SUPPORTING_WM_CHECK' before creating support window, so it's safe to
-- call it many times - only window name in '_NET_WM_NAME' may change.
activateStartupHook :: X ()
activateStartupHook = do
wn <- getWMName
when (isNothing wn) (setWMName "xmonad")
getAtom "_NET_ACTIVE_WINDOW" >>= addNETSupported
-- | Enable 'FocusHook' handling and set key for toggling focus lock. This is
-- recommended way for using 'FocusHook'.
handleFocusQuery :: Maybe (ButtonMask, KeySym) -- ^ Key to toggle focus lock.
-> FocusHook
-> XConfig l -> XConfig l
handleFocusQuery mt x cf = addLockKey $ cf
-- Note, the order: i want to apply FocusHook after user's changes, which
-- may change new/activated window workspace. Thus, in 'manageHook', which
-- is function composition, i should add in Monoid to the left, but in
-- 'handleEventHook', which runs actions from left to right, to the right!
{ manageHook = mh
, handleEventHook = handleEventHook cf `mappend` activateEventHook mh
-- Note, the order: i make my changes after user's changes here too.
, startupHook = startupHook cf >> activateStartupHook
}
where
-- Note, 'manageHook' should /not/ touch 'NetActivated' state value at
-- all! Because 'manageHook' may be called either on its own (from
-- 'manage' in X.Operations.hs) or from 'activateEventHook' (from here),
-- the only one who knows was window activated or not is the caller. And
-- it should set and unset 'NetActivated' state properly. Here this is
-- done solely and completely by 'activateEventHook'.
mh :: ManageHook
mh = manageFocus x `mappend` manageHook cf
addLockKey :: XConfig l -> XConfig l
addLockKey = additionalKeys <*> mt `maybeKey` toggleLock
-- $internal
--
addNETSupported :: Atom -> X ()
addNETSupported x = withDisplay $ \dpy -> do
r <- asks theRoot
a_NET_SUPPORTED <- getAtom "_NET_SUPPORTED"
a <- getAtom "ATOM"
liftIO $ do
sup <- (join . maybeToList) <$> getWindowProperty32 dpy a_NET_SUPPORTED r
when (fromIntegral x `notElem` sup) $
changeProperty32 dpy r a_NET_SUPPORTED a propModeAppend [fromIntegral x]
maybeKey :: Maybe (ButtonMask, KeySym) -> X () -> XConfig l -> [((ButtonMask, KeySym), X ())]
maybeKey mk x = pure . maybeToList $ (mk >>= \k -> return (k, x))
when' :: (Monad m, Monoid a) => Bool -> m a -> m a
when' b mx
| b = mx