From c07be09e17963144551a0c0914ca367522f6c9d4 Mon Sep 17 00:00:00 2001 From: sgf Date: Fri, 16 Dec 2016 16:02:53 +0300 Subject: [PATCH] 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. --- CHANGES.md | 12 +++ XMonad/Hooks/EwmhDesktops.hs | 54 +++++++++- XMonad/Hooks/Focus.hs | 193 +++++++---------------------------- 3 files changed, 103 insertions(+), 156 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 56213950..d2c07743 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -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` diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 2508b7ed..17ef4f82 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -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 diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index f20edc36..bf93f37f 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -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