From 3dbdc5115863cdf383c60a3b9980b9766de88e5b Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sun, 17 Oct 2021 22:01:26 +0100 Subject: [PATCH 01/10] X.U.ExtensibleConf: Perform 'add' before modifying in once(M) This better matches the documentation. It is still, however, considered bad practice to rely on the order of these operations. `f` isn't meant to touch any extensible configuration. If it happens to do so anyway, it no longer loops. :-) --- XMonad/Util/ExtensibleConf.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/XMonad/Util/ExtensibleConf.hs b/XMonad/Util/ExtensibleConf.hs index e51b9c478c..e64832e080 100644 --- a/XMonad/Util/ExtensibleConf.hs +++ b/XMonad/Util/ExtensibleConf.hs @@ -117,7 +117,7 @@ once :: forall a l. (Semigroup a, Typeable a) => (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once -> a -- ^ configuration to add -> XConfig l -> XConfig l -once f x c = add x $ maybe f (const id) (lookup @a c) c +once f x c = maybe f (const id) (lookup @a c) $ add x c -- | Config-time: Applicative (monadic) variant of 'once', useful if the -- 'XConfig' modification needs to do some 'IO' (e.g. create an @@ -126,4 +126,4 @@ onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a) => (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once -> a -- ^ configuration to add -> XConfig l -> m (XConfig l) -onceM f x c = add x <$> maybe f (const pure) (lookup @a c) c +onceM f x c = maybe f (const pure) (lookup @a c) $ add x c From 3a72dd5355d89359048d5b10d407529e04d453cc Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sun, 17 Oct 2021 22:47:58 +0100 Subject: [PATCH 02/10] X.U.ExtensibleConf: Add high-level idioms for non-Semigroup, but Default types For configuration values that don't compose well using a Semigroup instance, provide a high-level API allowing arbitrary modification of the value, taking its Default if absent. This API is only usable for separate configuration data and cannot be used to guard addition of hook using `once`. --- XMonad/Util/ExtensibleConf.hs | 58 +++++++++++++++++++++++++++++++++-- tests/ExtensibleConf.hs | 20 +++++++++--- 2 files changed, 70 insertions(+), 8 deletions(-) diff --git a/XMonad/Util/ExtensibleConf.hs b/XMonad/Util/ExtensibleConf.hs index e64832e080..56c57c2207 100644 --- a/XMonad/Util/ExtensibleConf.hs +++ b/XMonad/Util/ExtensibleConf.hs @@ -21,20 +21,27 @@ module XMonad.Util.ExtensibleConf ( -- * Usage -- $usage - -- * High-level idioms + -- * High-level idioms based on Semigroup with, add, once, onceM, + -- * High-level idioms based on Default + withDef, + modifyDef, + modifyDefM, + -- * Low-level primitivies ask, lookup, alter, + alterF, ) where import Prelude hiding (lookup) -import XMonad hiding (ask) +import XMonad hiding (ask, modify, trace) +import XMonad.Prelude ((<|>), (<&>), fromMaybe) import Data.Typeable import qualified Data.Map as M @@ -85,6 +92,15 @@ alter f = mapEC $ M.alter (mapConfExt f) (typeRep (Proxy @a)) where mapEC g c = c{ extensibleConf = g (extensibleConf c) } +-- | Config-time: Functor variant of 'alter', useful if the configuration +-- modifications needs to do some 'IO'. +alterF :: forall a l f. (Typeable a, Functor f) + => (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l) +alterF f = mapEC $ M.alterF (mapConfExtF f) (typeRep (Proxy @a)) + where + mapEC g c = g (extensibleConf c) <&> \ec -> c{ extensibleConf = ec } + + fromConfExt :: Typeable a => ConfExtension -> Maybe a fromConfExt (ConfExtension val) = cast val @@ -92,9 +108,13 @@ mapConfExt :: Typeable a => (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension mapConfExt f = fmap ConfExtension . f . (>>= fromConfExt) +mapConfExtF :: (Typeable a, Functor f) + => (Maybe a -> f (Maybe a)) -> Maybe ConfExtension -> f (Maybe ConfExtension) +mapConfExtF f = fmap (fmap ConfExtension) . f . (>>= fromConfExt) + -- --------------------------------------------------------------------- --- High-level idioms +-- High-level idioms based on Semigroup -- | Run-time: Run a monadic action with the value of the custom -- configuration, if set. @@ -113,6 +133,9 @@ add x = alter (<> Just x) -- -- This can be used to implement a composable interface for modules that must -- only hook into xmonad core once. +-- +-- (The piece of custom configuration is the last argument as it's expected to +-- come from the user.) once :: forall a l. (Semigroup a, Typeable a) => (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once -> a -- ^ configuration to add @@ -127,3 +150,32 @@ onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a) -> a -- ^ configuration to add -> XConfig l -> m (XConfig l) onceM f x c = maybe f (const pure) (lookup @a c) $ add x c + + +-- --------------------------------------------------------------------- +-- High-level idioms based on Default + +-- | Run-time: Run a monadic action with the value of the custom +-- configuration, or the 'Default' value thereof, if absent. +withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b +withDef a = ask >>= a . fromMaybe def + +-- | Config-time: Modify a configuration value in 'XConfig', initializing it +-- to its 'Default' value first if absent. This is an alternative to 'add' for +-- when a 'Semigroup' instance is unavailable or unsuitable. +-- +-- Note that this must /not/ be used together with any variant of 'once'! +modifyDef :: forall a l. (Default a, Typeable a) + => (a -> a) -- ^ modification of configuration + -> XConfig l -> XConfig l +modifyDef f = alter ((f <$>) . (<|> Just def)) + +-- | Config-time: Applicative (monadic) variant of 'modifyDef', useful if the +-- configuration value modification needs to do some 'IO' (e.g. create an +-- 'Data.IORef.IORef'). +-- +-- Note that this must /not/ be used together with any variant of 'once'! +modifyDefM :: forall a l m. (Applicative m, Default a, Typeable a) + => (a -> m a) -- ^ modification of configuration + -> XConfig l -> m (XConfig l) +modifyDefM f = alterF (traverse f . (<|> Just def)) diff --git a/tests/ExtensibleConf.hs b/tests/ExtensibleConf.hs index bfb55560c8..e3bb906216 100644 --- a/tests/ExtensibleConf.hs +++ b/tests/ExtensibleConf.hs @@ -21,11 +21,21 @@ spec = do specify "lookup @() . add @String . add @[Int]" $ XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` (Nothing :: Maybe ()) - specify "once" $ - borderWidth (XC.once incBorderWidth "a" def) `shouldBe` succ (borderWidth def) - specify "once . once" $ - borderWidth (XC.once incBorderWidth "b" (XC.once incBorderWidth "a" def)) - `shouldBe` succ (borderWidth def) + specify "once" $ do + let c = XC.once incBorderWidth "a" def + borderWidth c `shouldBe` succ (borderWidth def) + XC.lookup c `shouldBe` Just "a" + specify "once . once" $ do + let c = XC.once incBorderWidth "b" (XC.once incBorderWidth "a" def) + borderWidth c `shouldBe` succ (borderWidth def) + XC.lookup c `shouldBe` Just "ab" + + specify "modifyDef" $ do + let c = XC.modifyDef (<> "a") def + XC.lookup c `shouldBe` Just "a" + specify "modifyDef . modifyDef" $ do + let c = XC.modifyDef (<> "b") (XC.modifyDef (<> "a") def) + XC.lookup c `shouldBe` Just "ab" incBorderWidth :: XConfig l -> XConfig l incBorderWidth c = c{ borderWidth = succ (borderWidth c) } From 63586830588508c1d2343b12f38386cbf7c92edb Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 6 Nov 2020 20:37:17 +0000 Subject: [PATCH 03/10] X.H.UrgencyHook: Add askUrgent and doAskUrgent These are useful when one blocks some _NET_ACTIVE_WINDOW requests but still wants to somehow show that a window requested focus. Related: https://github.com/xmonad/xmonad-contrib/pull/110 Related: https://github.com/xmonad/xmonad-contrib/pull/128 Related: https://github.com/xmonad/xmonad-contrib/pull/192 --- CHANGES.md | 4 ++++ XMonad/Hooks/UrgencyHook.hs | 28 +++++++++++++++++++++++++++- 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index e2768242ea..2f0cae11e5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -637,6 +637,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 diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs index cc9b0e7bae..ff0c0ad505 100644 --- a/XMonad/Hooks/UrgencyHook.hs +++ b/XMonad/Hooks/UrgencyHook.hs @@ -60,6 +60,7 @@ module XMonad.Hooks.UrgencyHook ( FocusHook(..), filterUrgencyHook, filterUrgencyHook', minutes, seconds, + askUrgent, doAskUrgent, -- * Stuff for developers: readUrgents, withUrgents, clearUrgents', StdoutUrgencyHook(..), @@ -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) @@ -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) >> mempty From 6b9520b03b9ed7a0d41cbb055dd32275f34dc377 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 18 Oct 2021 18:06:37 +0100 Subject: [PATCH 04/10] X.H.EwmhDesktops: Mostly cosmetic, mostly docs cleanups --- XMonad/Hooks/EwmhDesktops.hs | 143 +++++++++++++---------------------- 1 file changed, 53 insertions(+), 90 deletions(-) diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 295850348c..2e77ca3671 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.EwmhDesktops --- Description : Make xmonad use the extended window manager hints (EWMH). +-- Description : Make xmonad use the extended window manager hints (EWMH). -- Copyright : (c) 2007, 2008 Joachim Breitner -- License : BSD -- @@ -12,25 +12,29 @@ -- Stability : unstable -- Portability : unportable -- --- Makes xmonad use the EWMH hints to tell panel applications about its --- workspaces and the windows therein. It also allows the user to interact --- with xmonad by clicking on panels and window lists. +-- Makes xmonad use the +-- +-- hints to tell panel applications about its workspaces and the windows +-- therein. It also allows the user to interact with xmonad by clicking on +-- panels and window lists. ----------------------------------------------------------------------------- module XMonad.Hooks.EwmhDesktops ( -- * Usage -- $usage ewmh, - ewmhDesktopsStartup, - ewmhDesktopsLogHook, - ewmhDesktopsLogHookCustom, + ewmhFullscreen, NetActivated (..), activated, activateLogHook, + + -- * Standalone hooks (to be deprecated) + ewmhDesktopsStartup, + ewmhDesktopsLogHook, + ewmhDesktopsLogHookCustom, ewmhDesktopsEventHook, ewmhDesktopsEventHookCustom, - ewmhFullscreen, fullscreenEventHook, - fullscreenStartup + fullscreenStartup, ) where import Codec.Binary.UTF8.String (encode) @@ -42,7 +46,6 @@ import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Hooks.SetWMName -import qualified XMonad.Util.ExtensibleState as E import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32) import qualified XMonad.Util.ExtensibleState as XS @@ -59,7 +62,10 @@ import qualified XMonad.Util.ExtensibleState as XS -- -- > main = xmonad $ … . ewmh . … $ def{…} -- --- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks". +-- You may also be interested in 'XMonad.Hooks.ManageDocks.docks' and +-- 'XMonad.Hooks.UrgencyHook.withUrgencyHook', which provide support for other +-- parts of the +-- . -- -- __/NOTE:/__ 'ewmh' function will call 'logHook' for handling activated -- window. @@ -89,85 +95,52 @@ import qualified XMonad.Util.ExtensibleState as XS -- > } -- > xmonad xcf --- | Add EWMH functionality to the given config. See above for an example. +-- | Add EWMH support for workspaces (virtual desktops) to the given +-- 'XConfig'. See above for an example. ewmh :: XConfig a -> XConfig a ewmh c = c { startupHook = ewmhDesktopsStartup <+> startupHook c , handleEventHook = ewmhDesktopsEventHook <+> handleEventHook c , logHook = ewmhDesktopsLogHook <+> logHook c } --- | --- Initializes EwmhDesktops and advertises EWMH support to the X --- server +-- | Initializes EwmhDesktops and advertises EWMH support to the X server. ewmhDesktopsStartup :: X () ewmhDesktopsStartup = setSupported --- | --- Notifies pagers and window lists, such as those in the gnome-panel --- of the current state of workspaces and windows. +-- | Notifies pagers and window lists, such as those in the gnome-panel of the +-- current state of workspaces and windows. ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id --- | --- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and --- @_NET_DESKTOP_NAMES@). -newtype DesktopNames = DesktopNames [String] - deriving Eq - -instance ExtensionClass DesktopNames where - initialValue = DesktopNames [] - --- | --- Cached client list (e.g. @_NET_CLIENT_LIST@). -newtype ClientList = ClientList [Window] - deriving Eq - -instance ExtensionClass ClientList where - initialValue = ClientList [none] +-- | Cached @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@ +newtype DesktopNames = DesktopNames [String] deriving Eq +instance ExtensionClass DesktopNames where initialValue = DesktopNames [] --- | --- Cached stacking client list (e.g. @_NET_CLIENT_LIST_STACKING@). -newtype ClientListStacking = ClientListStacking [Window] - deriving Eq +-- | Cached @_NET_CLIENT_LIST@ +newtype ClientList = ClientList [Window] deriving Eq +instance ExtensionClass ClientList where initialValue = ClientList [none] -instance ExtensionClass ClientListStacking where - initialValue = ClientListStacking [none] - --- | --- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@). -newtype CurrentDesktop = CurrentDesktop Int - deriving Eq - -instance ExtensionClass CurrentDesktop where - initialValue = CurrentDesktop (-1) - --- | --- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@). -newtype WindowDesktops = WindowDesktops (M.Map Window Int) - deriving Eq +-- | Cached @_NET_CLIENT_LIST_STACKING@ +newtype ClientListStacking = ClientListStacking [Window] deriving Eq +instance ExtensionClass ClientListStacking where initialValue = ClientListStacking [none] -instance ExtensionClass WindowDesktops where - initialValue = WindowDesktops (M.singleton none (-1)) +-- | Cached @_NET_CURRENT_DESKTOP@ +newtype CurrentDesktop = CurrentDesktop Int deriving Eq +instance ExtensionClass CurrentDesktop where initialValue = CurrentDesktop (complement 0) --- | --- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property --- updates. -newtype ActiveWindow = ActiveWindow Window - deriving Eq +-- | Cached @_NET_WM_DESKTOP@ +newtype WindowDesktops = WindowDesktops (M.Map Window Int) deriving Eq +instance ExtensionClass WindowDesktops where initialValue = WindowDesktops (M.singleton none (complement 0)) -instance ExtensionClass ActiveWindow where - initialValue = ActiveWindow (complement none) +-- | Cached @_NET_ACTIVE_WINDOW@ +newtype ActiveWindow = ActiveWindow Window deriving Eq +instance ExtensionClass ActiveWindow where initialValue = ActiveWindow (complement none) -- | Compare the given value against the value in the extensible state. Run the -- action if it has changed. whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X () -whenChanged v action = do - v0 <- E.get - unless (v == v0) $ do - action - E.put v +whenChanged = whenX . XS.modified . const --- | --- Generalized version of ewmhDesktopsLogHook that allows an arbitrary +-- | Generalized version of ewmhDesktopsLogHook that allows an arbitrary -- user-specified function to transform the workspace list (post-sorting) ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X () ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do @@ -208,8 +181,8 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do let activeWindow' = fromMaybe none (W.peek s) whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow' --- | --- Intercepts messages from pagers and similar applications and reacts on them. +-- | Intercepts messages from pagers and similar applications and reacts on them. +-- -- Currently supports: -- -- * _NET_CURRENT_DESKTOP (switching desktops) @@ -222,8 +195,7 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do ewmhDesktopsEventHook :: Event -> X All ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id --- | --- Generalized version of ewmhDesktopsEventHook that allows an arbitrary +-- | Generalized version of ewmhDesktopsEventHook that allows an arbitrary -- user-specified function to transform the workspace list (post-sorting) ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All ewmhDesktopsEventHookCustom f e = handle f e >> return (All True) @@ -298,14 +270,6 @@ handle f ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} = handle _ _ = return () -- | Add EWMH fullscreen functionality to the given config. --- --- This must be applied after 'ewmh', like so: --- --- > main = xmonad $ ewmhFullscreen $ ewmh def --- --- NOT: --- --- > main = xmonad $ ewmh $ ewmhFullscreen def ewmhFullscreen :: XConfig a -> XConfig a ewmhFullscreen c = c { startupHook = startupHook c <+> fullscreenStartup , handleEventHook = handleEventHook c <+> fullscreenEventHook } @@ -314,9 +278,8 @@ ewmhFullscreen c = c { startupHook = startupHook c <+> fullscreenStartup fullscreenStartup :: X () fullscreenStartup = setFullscreenSupported --- | --- An event hook to handle applications that wish to fullscreen using the --- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() +-- | An event hook to handle applications that wish to fullscreen using the +-- @_NET_WM_STATE@ protocol. This includes users of the @gtk_window_fullscreen()@ -- function, such as Totem, Evince and OpenOffice.org. -- -- Note this is not included in 'ewmh'. @@ -385,6 +348,12 @@ setWindowDesktop win i = withDisplay $ \dpy -> do a <- getAtom "_NET_WM_DESKTOP" io $ changeProperty32 dpy win a cARDINAL propModeReplace [fromIntegral i] +setActiveWindow :: Window -> X () +setActiveWindow w = withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_ACTIVE_WINDOW" + io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w] + setSupported :: X () setSupported = withDisplay $ \dpy -> do r <- asks theRoot @@ -416,9 +385,3 @@ addSupported props = withDisplay $ \dpy -> do setFullscreenSupported :: X () setFullscreenSupported = addSupported ["_NET_WM_STATE", "_NET_WM_STATE_FULLSCREEN"] - -setActiveWindow :: Window -> X () -setActiveWindow w = withDisplay $ \dpy -> do - r <- asks theRoot - a <- getAtom "_NET_ACTIVE_WINDOW" - io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w] From fe933c370726dc70ed54b66c9c12cb6102a3e159 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 18 Oct 2021 16:30:00 +0100 Subject: [PATCH 05/10] X.H.EwmhDesktops: Improve interface for custom workspace sorting, filtering and renaming Now that we have `XMonad.Util.ExtensibleConf`, users can comfortably use the `ewmh` combinator and still customize workspace ordering, filter out scratchpads and expose altered workspace names. To make this all work nicely, we introduce not one, but two configuration options: a sort/filter function and a rename function. This is because renaming and sorting in one go makes it hard (perhaps even impossible) to decide which workspace to switch to upon receipt of a _NET_CURRENT_DESKTOP request from a pager or wmctrl/xdotool. (The only reason this wasn't a problem before is because one could pass the renaming function to `ewmhDesktopsLogHookCustom` only, not `ewmhDesktopsEventHookCustom`, which is a confusing hack as can be seen in the related closed pull requests.) Related: https://github.com/xmonad/xmonad-contrib/pull/238 Related: https://github.com/xmonad/xmonad-contrib/pull/105 Related: https://github.com/xmonad/xmonad-contrib/pull/122 --- CHANGES.md | 7 ++ XMonad/Hooks/EwmhDesktops.hs | 191 ++++++++++++++++++++++++++++------- 2 files changed, 162 insertions(+), 36 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 2f0cae11e5..1857bafcc4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -40,6 +40,13 @@ `XMonad.Layout.Fullscreen.fullscreenSupport` now advertises it as well, and no configuration changes are required in this case. + - Deprecated `ewmhDesktopsLogHookCustom` and `ewmhDesktopsEventHookCustom`; + these are now replaced by a composable `XMonad.Util.ExtensibleConf`-based + interface. Users are advised to just use the `ewmh` XConfig combinator + and customize behaviour using the provided `addEwmhWorkspaceSort`, + `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 by default window activation will do nothing. diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 2e77ca3671..146ff0813a 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- @@ -23,6 +24,19 @@ module XMonad.Hooks.EwmhDesktops ( -- $usage ewmh, ewmhFullscreen, + + -- * Customization + -- $customization + + -- ** Sorting/filtering of workspaces + -- $customSort + addEwmhWorkspaceSort, setEwmhWorkspaceSort, + + -- ** Renaming of workspaces + -- $customRename + addEwmhWorkspaceRename, setEwmhWorkspaceRename, + + -- ** Window activation NetActivated (..), activated, activateLogHook, @@ -48,6 +62,7 @@ import qualified XMonad.StackSet as W import XMonad.Hooks.SetWMName import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32) +import qualified XMonad.Util.ExtensibleConf as XC import qualified XMonad.Util.ExtensibleState as XS -- $usage @@ -102,6 +117,99 @@ ewmh c = c { startupHook = ewmhDesktopsStartup <+> startupHook c , handleEventHook = ewmhDesktopsEventHook <+> handleEventHook c , logHook = ewmhDesktopsLogHook <+> logHook c } + +-- $customization +-- It's possible to customize the behaviour of 'ewmh' in several ways: + +-- | Customizable configuration for EwmhDesktops +data EwmhDesktopsConfig = + EwmhDesktopsConfig + { workspaceSort :: X WorkspaceSort + -- ^ configurable workspace sorting/filtering + , workspaceRename :: X (String -> WindowSpace -> String) + -- ^ configurable workspace rename (see 'XMonad.Hooks.StatusBar.PP.ppRename') + } + +instance Default EwmhDesktopsConfig where + def = EwmhDesktopsConfig + { workspaceSort = getSortByIndex + , workspaceRename = pure pure + } + + +-- $customSort +-- The list of workspaces exposed to EWMH pagers (like +-- and +-- ) and clients (such as +-- and +-- ) may be sorted and/or +-- filtered via a user-defined function. +-- +-- To show visible workspaces first, one may switch to a Xinerama-aware +-- sorting function: +-- +-- > import XMonad.Util.WorkspaceCompare +-- > +-- > mySort = getSortByXineramaRule +-- > main = xmonad $ … . setEwmhWorkspaceSort mySort . ewmh . … $ def{…} +-- +-- Another useful example is not exposing the hidden scratchpad workspace: +-- +-- > import XMonad.Util.NamedScratchpad +-- > import XMonad.Util.WorkspaceCompare +-- > +-- > myFilter = filterOutWs [scratchpadWorkspaceTag] +-- > main = xmonad $ … . addEwmhWorkspaceSort (pure myFilter) . ewmh . … $ def{…} + +-- | Add (compose after) an arbitrary user-specified function to sort/filter +-- the workspace list. The default/initial function is 'getSortByIndex'. This +-- can be used to e.g. filter out scratchpad workspaces. Workspaces /must not/ +-- be renamed here. +addEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l +addEwmhWorkspaceSort f = XC.modifyDef $ \c -> c{ workspaceSort = liftA2 (.) f (workspaceSort c) } + +-- | Like 'addEwmhWorkspaceSort', but replace it instead of adding/composing. +setEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l +setEwmhWorkspaceSort f = XC.modifyDef $ \c -> c{ workspaceSort = f } + + +-- $customRename +-- The workspace names exposed to EWMH pagers and other clients (e.g. +-- ) may be altered using a similar +-- interface to 'XMonad.Hooks.StatusBar.PP.ppRename'. To configure workspace +-- renaming, use 'addEwmhWorkspaceRename'. +-- +-- As an example, to expose workspaces uppercased: +-- +-- > import Data.Char +-- > +-- > myRename :: String -> WindowSpace -> String +-- > myRename s _w = map toUpper s +-- > +-- > main = xmonad $ … . addEwmhWorkspaceRename (pure myRename) . ewmh . … $ def{…} +-- +-- Some modules like "XMonad.Actions.WorkspaceNames" provide ready-made +-- integrations: +-- +-- > import XMonad.Actions.WorkspaceNames +-- > +-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…} +-- +-- The above ensures workspace names are exposed through EWMH. + +-- | Add (compose after) an arbitrary user-specified function to rename each +-- workspace. This works just like 'XMonad.Hooks.StatusBar.PP.ppRename': the +-- @WindowSpace -> …@ acts as a Reader monad. Useful with +-- "XMonad.Actions.WorkspaceNames", "XMonad.Layout.IndependentScreens", +-- "XMonad.Hooks.DynamicIcons". +addEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l +addEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = liftA2 (<=<) f (workspaceRename c) } + +-- | Like 'addEwmhWorkspaceRename', but replace it instead of adding/composing. +setEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l +setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f } + + -- | Initializes EwmhDesktops and advertises EWMH support to the X server. ewmhDesktopsStartup :: X () ewmhDesktopsStartup = setSupported @@ -109,7 +217,35 @@ ewmhDesktopsStartup = setSupported -- | Notifies pagers and window lists, such as those in the gnome-panel of the -- current state of workspaces and windows. ewmhDesktopsLogHook :: X () -ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id +ewmhDesktopsLogHook = XC.withDef ewmhDesktopsLogHook' + +-- | Generalized version of ewmhDesktopsLogHook that allows an arbitrary +-- user-specified function to sort/filter the workspace list (post-sorting). +{-# DEPRECATED ewmhDesktopsLogHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-} +ewmhDesktopsLogHookCustom :: WorkspaceSort -> X () +ewmhDesktopsLogHookCustom f = + ewmhDesktopsLogHook' def{ workspaceSort = (f .) <$> workspaceSort def } + +-- | Intercepts messages from pagers and similar applications and reacts on them. +-- +-- Currently supports: +-- +-- * _NET_CURRENT_DESKTOP (switching desktops) +-- +-- * _NET_WM_DESKTOP (move windows to other desktops) +-- +-- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) +-- +-- * _NET_CLOSE_WINDOW (close window) +ewmhDesktopsEventHook :: Event -> X All +ewmhDesktopsEventHook = XC.withDef . ewmhDesktopsEventHook' + +-- | Generalized version of ewmhDesktopsEventHook that allows an arbitrary +-- user-specified function to sort/filter the workspace list (post-sorting). +{-# DEPRECATED ewmhDesktopsEventHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-} +ewmhDesktopsEventHookCustom :: WorkspaceSort -> Event -> X All +ewmhDesktopsEventHookCustom f e = + ewmhDesktopsEventHook' e def{ workspaceSort = (f .) <$> workspaceSort def } -- | Cached @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@ newtype DesktopNames = DesktopNames [String] deriving Eq @@ -140,15 +276,14 @@ instance ExtensionClass ActiveWindow where initialValue = ActiveWindow (compleme whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X () whenChanged = whenX . XS.modified . const --- | Generalized version of ewmhDesktopsLogHook that allows an arbitrary --- user-specified function to transform the workspace list (post-sorting) -ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X () -ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = t $ sort' $ W.workspaces s +ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X () +ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename} = withWindowSet $ \s -> do + sort' <- workspaceSort + let ws = sort' $ W.workspaces s -- Set number of workspaces and names thereof - let desktopNames = map W.tag ws + rename <- workspaceRename + let desktopNames = [ rename (W.tag w) w | w <- ws ] whenChanged (DesktopNames desktopNames) $ do setNumberOfDesktops (length desktopNames) setDesktopNames desktopNames @@ -164,9 +299,8 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do let clientListStacking = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws whenChanged (ClientListStacking clientListStacking) $ setClientListStacking clientListStacking - -- Remap the current workspace to handle any renames that f might be doing. - let maybeCurrent' = W.tag <$> listToMaybe (t [W.workspace $ W.current s]) - current = flip elemIndex (map W.tag ws) =<< maybeCurrent' + -- Set current desktop number + let current = W.currentTag s `elemIndex` map W.tag ws whenChanged (CurrentDesktop $ fromMaybe 0 current) $ mapM_ setCurrentDesktop current @@ -181,25 +315,6 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do let activeWindow' = fromMaybe none (W.peek s) whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow' --- | Intercepts messages from pagers and similar applications and reacts on them. --- --- Currently supports: --- --- * _NET_CURRENT_DESKTOP (switching desktops) --- --- * _NET_WM_DESKTOP (move windows to other desktops) --- --- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) --- --- * _NET_CLOSE_WINDOW (close window) -ewmhDesktopsEventHook :: Event -> X All -ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id - --- | Generalized version of ewmhDesktopsEventHook that allows an arbitrary --- user-specified function to transform the workspace list (post-sorting) -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 'logHook' for handling activated -- windows and i need a way to tell 'logHook' what window is activated. @@ -234,11 +349,13 @@ activateLogHook mh = XS.get >>= maybe (return ()) go . netActivated XS.put NetActivated{netActivated = Nothing} windows (appEndo f) -handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X () -handle f ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} = +ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All +ewmhDesktopsEventHook' + ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} + EwmhDesktopsConfig{workspaceSort} = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = f $ sort' $ W.workspaces s + sort' <- workspaceSort + let ws = sort' $ W.workspaces s a_cd <- getAtom "_NET_CURRENT_DESKTOP" a_d <- getAtom "_NET_WM_DESKTOP" @@ -266,8 +383,10 @@ handle f ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} = | otherwise -> -- The Message is unknown to us, but that is ok, not all are meant -- to be handled by the window manager - return () -handle _ _ = return () + mempty + + mempty +ewmhDesktopsEventHook' _ _ = mempty -- | Add EWMH fullscreen functionality to the given config. ewmhFullscreen :: XConfig a -> XConfig a From 3175f276bec602ef5494e2937b44f51cf097dc7e Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 18 Oct 2021 16:39:22 +0100 Subject: [PATCH 06/10] X.A.WorkspaceNames: Adapt EwmhDesktops integration to the new interface Related: https://github.com/xmonad/xmonad-contrib/pull/105 Related: https://github.com/xmonad/xmonad-contrib/pull/122 Related: f271d59c345e ("X.A.WorkspaceNames: Provide workspaceListTransform for EwmhDesktops") --- CHANGES.md | 4 ++-- XMonad/Actions/WorkspaceNames.hs | 35 ++++++++++++++++---------------- 2 files changed, 20 insertions(+), 19 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 1857bafcc4..2a0f8f040f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -545,8 +545,8 @@ * `XMonad.Actions.WorkspaceNames` - - Added `workspaceNamesListTransform` which makes workspace names visible - to external pagers. + - Added `workspaceNamesEwmh` which makes workspace names visible to + external pagers. * `XMonad.Util.PureX` diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs index 1f25002581..13e5b28099 100644 --- a/XMonad/Actions/WorkspaceNames.hs +++ b/XMonad/Actions/WorkspaceNames.hs @@ -22,7 +22,6 @@ module XMonad.Actions.WorkspaceNames ( -- * Workspace naming renameWorkspace, - workspaceNamesPP, getWorkspaceNames', getWorkspaceNames, getWorkspaceName, @@ -38,8 +37,9 @@ module XMonad.Actions.WorkspaceNames ( -- * Workspace prompt workspaceNamePrompt, - -- * EwmhDesktops integration - workspaceNamesListTransform + -- * StatusBar, EwmhDesktops integration + workspaceNamesPP, + workspaceNamesEwmh, ) where import XMonad @@ -50,6 +50,7 @@ import qualified XMonad.Util.ExtensibleState as XS import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS) import qualified XMonad.Actions.SwapWorkspaces as Swap import XMonad.Hooks.StatusBar.PP (PP(..)) +import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename) import XMonad.Prompt (mkXPrompt, XPConfig) import XMonad.Prompt.Workspace (Wor(Wor)) import XMonad.Util.WorkspaceCompare (getSortByIndex) @@ -72,6 +73,11 @@ import qualified Data.Map as M -- Check "XMonad.Hooks.StatusBar" for more information on how to incorprate -- this into your status bar. -- +-- To expose workspace names to pagers and other EWMH clients, integrate this +-- with "XMonad.Hooks.EwmhDesktops": +-- +-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…} +-- -- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s -- functionality, which may be used this way: -- @@ -135,11 +141,6 @@ renameWorkspace conf = mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName where pr = Wor "Workspace name: " --- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show --- workspace names as well. -workspaceNamesPP :: PP -> X PP -workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren } - -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names. swapTo :: Direction1D -> X () swapTo dir = swapTo' dir anyWS @@ -177,12 +178,12 @@ workspaceNamePrompt conf job = do contains completions input = return $ filter (isInfixOf input) completions --- | Workspace list transformation for --- 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsLogHookCustom' that exposes --- workspace names to pagers and other EWMH-aware clients. --- --- Usage: --- > logHook = (workspaceNamesListTransform >>= ewmhDesktopsLogHookCustom) <+> … -workspaceNamesListTransform :: X ([WindowSpace] -> [WindowSpace]) -workspaceNamesListTransform = - getWorkspaceNames ":" <&> \names -> map $ \ws -> ws{ W.tag = names (W.tag ws) ws } +-- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show +-- workspace names as well. +workspaceNamesPP :: PP -> X PP +workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren } + +-- | Tell "XMonad.Hooks.EwmhDesktops" to append workspace names to desktop +-- names. +workspaceNamesEwmh :: XConfig l -> XConfig l +workspaceNamesEwmh = addEwmhWorkspaceRename $ getWorkspaceNames ":" From 08ec79eec1dd1cd5d571ee6b241a9c9673e3da80 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Tue, 19 Oct 2021 01:39:19 +0100 Subject: [PATCH 07/10] X.H.EwmhDesktops: Improve interface for hooking window activation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 | 12 ++-- XMonad/Config/Desktop.hs | 7 -- XMonad/Hooks/EwmhDesktops.hs | 125 +++++++++++++++------------------- XMonad/Hooks/Focus.hs | 12 ++-- XMonad/Hooks/ManageHelpers.hs | 7 +- XMonad/Hooks/UrgencyHook.hs | 4 +- 6 files changed, 71 insertions(+), 96 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 2a0f8f040f..19ca312878 100644 --- a/CHANGES.md +++ b/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 - by default window activation will do nothing. - - You can use regular `ManageHook` combinators for changing window - activation behavior and then add resulting `ManageHook` using - `activateLogHook` to your `logHook`. Also, module `X.H.Focus` provides - additional combinators. + This interface now additionally allows customization of what happens + when clients request window activation. This can be used to ignore + activation of annoying applications, to mark windows as urgent instead + of focusing them, and more. There's also a new `XMonad.Hooks.Focus` + module extending the ManageHook EDSL with useful 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 diff --git a/XMonad/Config/Desktop.hs b/XMonad/Config/Desktop.hs index f94552f398..e6db6b86e3 100644 --- a/XMonad/Config/Desktop.hs +++ b/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) diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 146ff0813a..d5872ae8a7 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -37,9 +37,8 @@ module XMonad.Hooks.EwmhDesktops ( addEwmhWorkspaceRename, setEwmhWorkspaceRename, -- ** Window activation - NetActivated (..), - activated, - activateLogHook, + -- $customActivate + setEwmhActivateHook, -- * 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 -- . --- --- __/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'. +-- +-- 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 - | mt == a_aw, W.peek s /= Just w -> do - lh <- asks (logHook . config) - XS.put (NetActivated (Just w)) - lh + if W.peek s == Just w then mempty else windows $ W.focusWindow w + | mt == a_aw -> do + if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w | mt == a_cw -> killWindow w | otherwise -> diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index c9660550db..d8ee959f8a 100644 --- a/XMonad/Hooks/Focus.hs +++ b/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 --> - switchWorkspace <+> switchFocus) +activateSwitchWs = manageFocus (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) - <+> activateOnCurrent' +activateOnCurrentWs = manageFocus (newOnCur --> switchFocus) <+> activateOnCurrent' -- | Move activated window to current workspace, but keep focus unchanged. activateOnCurrentKeepFocus :: ManageHook -activateOnCurrentKeepFocus = manageFocus (liftQuery activated <&&> newOnCur --> keepFocus) - <+> activateOnCurrent' +activateOnCurrentKeepFocus = manageFocus (newOnCur --> keepFocus) <+> activateOnCurrent' diff --git a/XMonad/Hooks/ManageHelpers.hs b/XMonad/Hooks/ManageHelpers.hs index 7f09c6b143..bbd392b18c 100644 --- a/XMonad/Hooks/ManageHelpers.hs +++ b/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 diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs index ff0c0ad505..e2012c68b1 100644 --- a/XMonad/Hooks/UrgencyHook.hs +++ b/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.InsertPosition", "XMonad.Hooks.Focus". +-- 'XMonad.Hooks.EwmhDesktops.setEwmhActivateHook' and also in combination +-- with "XMonad.Hooks.InsertPosition", "XMonad.Hooks.Focus". doAskUrgent :: ManageHook doAskUrgent = ask >>= \w -> liftX (askUrgent w) >> mempty From 79b130b9d626414d02c8980f86e0b9ccf09e6af5 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 20 Oct 2021 10:37:02 +0100 Subject: [PATCH 08/10] Add some docs references for workspace filtering --- XMonad/Util/NamedScratchpad.hs | 12 +++++++----- XMonad/Util/Scratchpad.hs | 4 +++- XMonad/Util/WorkspaceCompare.hs | 4 +++- 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs index 9aecbdcb98..12d6629304 100644 --- a/XMonad/Util/NamedScratchpad.hs +++ b/XMonad/Util/NamedScratchpad.hs @@ -90,11 +90,13 @@ import qualified XMonad.StackSet as W -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings" -- --- For some applications (like displaying your workspaces in a status bar) it is --- convenient to filter out the @NSP@ workspace when looking at all workspaces. --- For this, you can use functions 'XMonad.Hooks.StatusBar.PP.filterOutWsPP' and --- 'XMonad.Util.WorkspaceCompare.filterOutWs'. See the documentation of these --- functions for examples. +-- For some applications (like displaying your workspaces in a status bar) it +-- is convenient to filter out the @NSP@ workspace when looking at all +-- workspaces. For this, you can use 'XMonad.Hooks.StatusBar.PP.filterOutWsPP', +-- or 'XMonad.Util.WorkspaceCompare.filterOutWs' together with +-- 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort' if your status bar gets +-- the list of workspaces from EWMH. See the documentation of these functions +-- for examples. -- -- Further, there is also a @logHook@ that you can use to hide -- scratchpads when they lose focus; this is functionality akin to what diff --git a/XMonad/Util/Scratchpad.hs b/XMonad/Util/Scratchpad.hs index ca62a9c6ce..281835ec63 100644 --- a/XMonad/Util/Scratchpad.hs +++ b/XMonad/Util/Scratchpad.hs @@ -111,7 +111,9 @@ scratchpadManageHook rect = namedScratchpadManageHook [NS "" "" scratchpadQuery -- | Transforms a workspace list containing the SP workspace into one that --- doesn't contain it. Intended for use with logHooks. +-- doesn't contain it. Intended for use with 'logHook's (see +-- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops" +-- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort'). scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] scratchpadFilterOutWorkspace = filterOutWs [scratchpadWorkspaceTag] diff --git a/XMonad/Util/WorkspaceCompare.hs b/XMonad/Util/WorkspaceCompare.hs index 1290d1daaf..facc09940a 100644 --- a/XMonad/Util/WorkspaceCompare.hs +++ b/XMonad/Util/WorkspaceCompare.hs @@ -33,7 +33,9 @@ type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering type WorkspaceSort = [WindowSpace] -> [WindowSpace] -- | Transforms a workspace list by filtering out the workspaces that --- correspond to the given 'tag's. Intended for use with logHooks. +-- correspond to the given 'tag's. Intended for use with 'logHook's (see +-- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops" +-- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort'). filterOutWs :: [WorkspaceId] -> WorkspaceSort filterOutWs ws = filter (\S.Workspace{ S.tag = tag } -> tag `notElem` ws) From 860f80a6d3dee97c1bcd85e7911b339c30f70c67 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 20 Oct 2021 11:33:52 +0100 Subject: [PATCH 09/10] X.H.Focus: Adapt docs to the new activation interface Fixes: https://github.com/xmonad/xmonad-contrib/issues/396 Related: https://github.com/xmonad/xmonad-contrib/pull/192 Related: https://github.com/xmonad/xmonad-contrib/pull/128 --- XMonad/Hooks/Focus.hs | 107 +++++++++++++++++++----------------------- 1 file changed, 48 insertions(+), 59 deletions(-) diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs index d8ee959f8a..808d1e5479 100644 --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -4,10 +4,13 @@ -- | -- Module: XMonad.Hooks.Focus --- Description: Provide additional information about a new window. +-- Description: Extends ManageHook EDSL to work on focused windows and current workspace. -- Copyright: sgf-dma, 2016 -- Maintainer: sgf.dma@gmail.com -- +-- Extends "XMonad.ManageHook" EDSL to work on focused windows and current +-- workspace. +-- module XMonad.Hooks.Focus ( @@ -95,8 +98,8 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- -- I may use one of predefined configurations. -- --- 1. Default window activation behavior is to switch to workspace with --- activated window and switch focus to it: +-- 1. The default window activation behavior (switch to workspace with +-- activated window and switch focus to it) expressed using this module: -- -- > import XMonad -- > @@ -105,44 +108,42 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- > -- > main :: IO () -- > main = do --- > let mh :: ManageHook --- > mh = activateSwitchWs --- > xcf = ewmh $ def --- > { modMask = mod4Mask --- > , logHook = activateLogHook mh <+> logHook def --- > } +-- > let ah :: ManageHook +-- > ah = activateSwitchWs +-- > xcf = setEwmhActivateHook ah +-- > . ewmh $ def{ modMask = mod4Mask } -- > xmonad xcf -- -- 2. Or i may move activated window to current workspace and switch focus to -- it: -- --- > let mh :: ManageHook --- > mh = activateOnCurrentWs +-- > let ah :: ManageHook +-- > ah = activateOnCurrentWs -- -- 3. Or move activated window to current workspace, but keep focus unchanged: -- --- > let mh :: ManageHook --- > mh = activateOnCurrentKeepFocus +-- > let ah :: ManageHook +-- > ah = activateOnCurrentKeepFocus -- -- 4. I may use regular 'ManageHook' combinators for filtering, which windows -- may activate. E.g. activate all windows, except firefox: -- --- > let mh :: ManageHook --- > mh = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") +-- > let ah :: ManageHook +-- > ah = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") -- > --> activateSwitchWs -- -- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless -- xterm is focused on /current/ workspace: -- --- > let mh :: ManageHook --- > mh = manageFocus (not <$> focusedCur (className =? "XTerm") +-- > let ah :: ManageHook +-- > ah = manageFocus (not <$> focusedCur (className =? "XTerm") -- > --> liftQuery activateSwitchWs) -- -- or activate all windows, unless focused window on the workspace, -- /where activated window is/, is not a xterm: -- --- > let mh :: ManageHook --- > mh = manageFocus (not <$> focused (className =? "XTerm") +-- > let ah :: ManageHook +-- > ah = manageFocus (not <$> focused (className =? "XTerm") -- > --> liftQuery activateSwitchWs) -- -- == Defining FocusHook. @@ -197,11 +198,11 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- > main = do -- > let newFh :: ManageHook -- > newFh = manageFocus newFocusHook --- > acFh :: X () --- > acFh = activateLogHook (manageFocus activateFocusHook) --- > xcf = ewmh $ def +-- > acFh :: ManageHook +-- > acFh = manageFocus activateFocusHook +-- > xcf = setEwmhActivateHook acFh +-- > . ewmh $ def -- > { manageHook = newFh <+> manageHook def --- > , logHook = acFh <+> logHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] @@ -214,30 +215,23 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window -- activation. -- - 'FocusHook' in 'manageHook' will be called /only/ for new windows. --- - 'FocusHook' in 'logHook' will be called /only/ for activated windows. +-- - 'FocusHook' in 'setEwmhActivateHook' will be called /only/ for activated windows. -- -- Alternatively, i may construct a single 'FocusHook' for both new and --- activated windows and then just add it to both 'manageHook' and 'logHook': --- --- > let fh :: ManageHook --- > fh = manageFocus $ (composeOne --- > [ liftQuery activated -?> activateFocusHook --- > , Just <$> newFocusHook --- > ]) --- > xcf = ewmh $ def --- > { manageHook = fh <+> manageHook def --- > , logHook = activateLogHook fh <+> logHook def +-- activated windows and then just add it to both 'manageHook' and 'setEwmhActivateHook': +-- +-- > let fh :: Bool -> ManageHook +-- > fh activated = manageFocus $ composeOne +-- > [ pure activated -?> activateFocusHook +-- > , pure True -?> newFocusHook +-- > ] +-- > xcf = setEwmhActivateHook (fh True) +-- > . ewmh $ def +-- > { manageHook = fh False <+> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] -- --- Note: --- - Predicate 'activated' will be 'True' for activated window. --- - 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: -- -- - 'FocusHook' will run /many/ times, so it usually should not keep state @@ -264,11 +258,6 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- -- now @FH2@ will see window shift made by @FH1@. -- --- Also, note, that if several 'activateLogHook'-s are sequenced, only --- /first/ one (leftmost) will run. Thus, to make above working, --- 'mappend' all 'ManageHook'-s first, and then run by /single/ --- 'activateLogHook' (see next example). --- -- Another interesting example is moving all activated windows to current -- workspace by default, and applying 'FocusHook' after: -- @@ -281,14 +270,14 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- > -- > main :: IO () -- > main = do --- > let fh :: ManageHook --- > fh = manageFocus $ (composeOne --- > [ liftQuery activated -?> (newOnCur --> keepFocus) --- > , Just <$> newFocusHook --- > ]) --- > xcf = ewmh $ def --- > { manageHook = fh <+> manageHook def --- > , logHook = activateLogHook (fh <+> activateOnCurrentWs) <+> logHook def +-- > let fh :: Bool -> ManageHook +-- > fh activated = manageFocus $ composeOne +-- > [ pure activated -?> (newOnCur --> keepFocus) +-- > , pure True -?> newFocusHook +-- > ] +-- > xcf = setEwmhActivateHook (fh True <+> activateOnCurrentWs) +-- > . ewmh $ def +-- > { manageHook = fh False <+> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] @@ -319,11 +308,10 @@ import XMonad.Hooks.ManageHelpers (currentWs) -- -- - i keep focus, when activated window appears on current workspace, in -- this example. --- - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated +-- - when @pure 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 before applying -- @activateOnCurrentWs@ 'FocusHook'. --- - i 'mappend' all 'ManageHook'-s and run 'activateLogHook' only once. -- FocusQuery. @@ -552,21 +540,22 @@ when' b mx -- $examples -- | Default EWMH window activation behavior: switch to workspace with --- activated window and switch focus to it. +-- activated window and switch focus to it. Not to be used in a 'manageHook'. activateSwitchWs :: ManageHook activateSwitchWs = manageFocus (switchWorkspace <+> switchFocus) --- | Move activated window to current workspace. +-- | Move activated window to current workspace. Not to be used in a 'manageHook'. activateOnCurrent' :: ManageHook 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. +-- switched. Not to be used in a 'manageHook'. activateOnCurrentWs :: ManageHook activateOnCurrentWs = manageFocus (newOnCur --> switchFocus) <+> activateOnCurrent' -- | Move activated window to current workspace, but keep focus unchanged. +-- Not to be used in a 'manageHook'. activateOnCurrentKeepFocus :: ManageHook activateOnCurrentKeepFocus = manageFocus (newOnCur --> keepFocus) <+> activateOnCurrent' From f666cf4e4e0e433ecb067d2a7466eee1a39c7acf Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 20 Oct 2021 14:16:13 +0100 Subject: [PATCH 10/10] X.H.EwmhDesktops: Deprecate standalone hooks We should get rid of this error-prone interface ASAP, so mark it as deprecated to give people some time to adapt their configs. --- XMonad/Config/Bluetile.hs | 8 +++----- XMonad/Hooks/EwmhDesktops.hs | 7 ++++++- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs index 6a7a13d29e..f7eaa46b2b 100644 --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -197,15 +197,13 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l bluetileConfig = - docks $ + docks . ewmhFullscreen . ewmh $ def { modMask = mod4Mask, -- logo key manageHook = bluetileManageHook, layoutHook = bluetileLayoutHook, - logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook, - handleEventHook = ewmhDesktopsEventHook - `mappend` fullscreenEventHook - `mappend` minimizeEventHook + logHook = currentWorkspaceOnTop, + handleEventHook = minimizeEventHook `mappend` serverModeEventHook' bluetileCommands `mappend` positionStoreEventHook, workspaces = bluetileWorkspaces, diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index d5872ae8a7..f6dd58ec30 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -40,7 +40,7 @@ module XMonad.Hooks.EwmhDesktops ( -- $customActivate setEwmhActivateHook, - -- * Standalone hooks (to be deprecated) + -- * Standalone hooks (deprecated) ewmhDesktopsStartup, ewmhDesktopsLogHook, ewmhDesktopsLogHookCustom, @@ -230,11 +230,13 @@ setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h } -- | Initializes EwmhDesktops and advertises EWMH support to the X server. +{-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-} ewmhDesktopsStartup :: X () ewmhDesktopsStartup = setSupported -- | Notifies pagers and window lists, such as those in the gnome-panel of the -- current state of workspaces and windows. +{-# DEPRECATED ewmhDesktopsLogHook "Use ewmh instead." #-} ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook = XC.withDef ewmhDesktopsLogHook' @@ -256,6 +258,7 @@ ewmhDesktopsLogHookCustom f = -- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) -- -- * _NET_CLOSE_WINDOW (close window) +{-# DEPRECATED ewmhDesktopsEventHook "Use ewmh instead." #-} ewmhDesktopsEventHook :: Event -> X All ewmhDesktopsEventHook = XC.withDef . ewmhDesktopsEventHook' @@ -377,6 +380,7 @@ ewmhFullscreen c = c { startupHook = startupHook c <+> fullscreenStartup , handleEventHook = handleEventHook c <+> fullscreenEventHook } -- | Advertises EWMH fullscreen support to the X server. +{-# DEPRECATED fullscreenStartup "Use ewmhFullscreen instead." #-} fullscreenStartup :: X () fullscreenStartup = setFullscreenSupported @@ -385,6 +389,7 @@ fullscreenStartup = setFullscreenSupported -- function, such as Totem, Evince and OpenOffice.org. -- -- Note this is not included in 'ewmh'. +{-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-} fullscreenEventHook :: Event -> X All fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do managed <- isClient win