diff --git a/CHANGES.md b/CHANGES.md index d5e45c08..47193cc0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -250,6 +250,13 @@ This lets them create custom hooks, ensure they hook into xmonad core only once, and possibly more. + * `XMonad.Hooks.Rescreen` + + Custom hooks for screen (xrandr) configuration changes. These can be used + to restart/reposition status bars or systrays automatically after xrandr, + as well as to actually invoke xrandr or autorandr when an output is + (dis)connected. + ### Bug Fixes and Minor Changes * Add support for GHC 9.0.1. diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 31e6b933..1a9b12b5 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -543,6 +543,12 @@ Here is a list of the modules found in @XMonad.Hooks@: even if it was opened in a tiled layout initially. The EventHook makes sure that windows are deleted from the PositionStore when they are closed. +* "XMonad.Hooks.Rescreen": + Custom hooks for screen (xrandr) configuration changes. These can be used + to restart/reposition status bars or systrays automatically after xrandr, + as well as to actually invoke xrandr or autorandr when an output is + (dis)connected. + * "XMonad.Hooks.RestoreMinimized": (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized windows (see "XMonad.Layout.Minimize") by selecting them on a diff --git a/XMonad/Hooks/Rescreen.hs b/XMonad/Hooks/Rescreen.hs new file mode 100644 index 00000000..8338b84e --- /dev/null +++ b/XMonad/Hooks/Rescreen.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +-- | +-- Module : XMonad.Hooks.Rescreen +-- Copyright : (c) 2021 Tomáš Janoušek +-- License : BSD3 +-- Maintainer : Tomáš Janoušek +-- +-- Custom hooks for screen (xrandr) configuration changes. +-- +module XMonad.Hooks.Rescreen ( + -- * Usage + -- $usage + RescreenConfig(..), + addAfterRescreenHook, + addRandrChangeHook, + rescreenHook, + ) where + +import Control.Monad (void) +import Data.Monoid (All(..)) + +import Graphics.X11.Xrandr +import XMonad +import qualified XMonad.Util.ExtensibleConf as XC + +-- $usage +-- This module provides a replacement for the screen configuration change +-- handling in core that enables attaching custom hooks to screen (xrandr) +-- configuration change events. These can be used to restart/reposition status +-- bars or systrays automatically after xrandr, as well as to actually invoke +-- xrandr or autorandr when an output is (dis)connected. +-- +-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.RescreenHook +-- +-- defining your custom hooks: +-- +-- > myAfterRescreenHook :: X () +-- > myAfterRescreenHook = … +-- +-- > myRandrChangeHook :: X () +-- > myRandrChangeHook = … +-- +-- > rescreenCfg = def{ +-- > afterRescreenHook = myAfterRescreenHook, +-- > randrChangeHook = myRandrChangeHook +-- > } +-- +-- and adding 'rescreenHook' to your 'xmonad' config: +-- +-- > main = xmonad $ … . rescreenHook rescreenCfg . … $ def{…} + +-- | Hook configuration for 'rescreenEventHook'. +data RescreenConfig = RescreenConfig + { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen' + , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects + } + +instance Default RescreenConfig where + def = RescreenConfig + { afterRescreenHook = mempty + , randrChangeHook = mempty + } + +instance Semigroup RescreenConfig where + RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch') + +instance Monoid RescreenConfig where + mempty = def + +-- | Attach custom hooks to screen (xrandr) configuration change events. +-- Replaces the built-in rescreen handling of xmonad core with: +-- +-- 1. listen to 'RRScreenChangeNotifyEvent' in addition to 'ConfigureEvent' on +-- the root window +-- 2. whenever such event is received: +-- 3. clear any other similar events (Xorg server emits them in bunches) +-- 4. if any event was 'ConfigureEvent', 'rescreen' and invoke 'afterRescreenHook' +-- 5. if there was no 'ConfigureEvent', invoke 'randrChangeHook' only +-- +-- 'afterRescreenHook' is useful for restarting/repositioning status bars and +-- systray. +-- +-- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps +-- autorandr) when outputs are (dis)connected. +-- +-- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still +-- done just once and hooks are invoked in sequence, also just once. +rescreenHook :: RescreenConfig -> XConfig a -> XConfig a +rescreenHook = XC.once $ \c -> c + { startupHook = startupHook c <> rescreenStartupHook + , handleEventHook = handleEventHook c <> rescreenEventHook } + +-- | Shortcut for 'rescreenHook'. +addAfterRescreenHook :: X () -> XConfig a -> XConfig a +addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h } + +-- | Shortcut for 'rescreenHook'. +addRandrChangeHook :: X () -> XConfig a -> XConfig a +addRandrChangeHook h = rescreenHook def{ randrChangeHook = h } + +-- | Startup hook to listen for @RRScreenChangeNotify@ events. +rescreenStartupHook :: X () +rescreenStartupHook = do + dpy <- asks display + root <- asks theRoot + io $ xrrSelectInput dpy root rrScreenChangeNotifyMask + +-- | Event hook with custom rescreen/randr hooks. See 'rescreenHook' for more. +rescreenEventHook :: Event -> X All +rescreenEventHook e = do + shouldHandle <- case e of + ConfigureEvent{ ev_window = w } -> isRoot w + RRScreenChangeNotifyEvent{ ev_window = w } -> isRoot w + _ -> pure False + if shouldHandle + then All False <$ handleEvent e + else mempty + +handleEvent :: Event -> X () +handleEvent e = XC.with $ \RescreenConfig{..} -> do + -- Xorg emits several events after every change, clear them to prevent + -- triggering the hook multiple times. + moreConfigureEvents <- clearTypedWindowEvents (ev_window e) configureNotify + _ <- clearTypedWindowRREvents (ev_window e) rrScreenChangeNotify + -- If there were any ConfigureEvents, this is an actual screen + -- configuration change, so rescreen and fire rescreenHook. Otherwise, + -- this is just a connect/disconnect, fire randrChangeHook. + if ev_event_type e == configureNotify || moreConfigureEvents + then rescreen >> afterRescreenHook + else randrChangeHook + +-- | Remove all X events of a given window and type from the event queue, +-- return whether there were any. +clearTypedWindowEvents :: Window -> EventType -> X Bool +clearTypedWindowEvents w t = withDisplay $ \d -> io $ allocaXEvent (go d) + where + go d e' = do + sync d False + gotEvent <- checkTypedWindowEvent d w t e' + e <- if gotEvent then Just <$> getEvent e' else pure Nothing + gotEvent <$ if + | not gotEvent -> mempty + | (ev_window <$> e) == Just w -> void $ go d e' + -- checkTypedWindowEvent checks ev_event instead of ev_window, so + -- we may need to put some events back + | otherwise -> allocaXEvent (go d) >> io (putBackEvent d e') + +clearTypedWindowRREvents :: Window -> EventType -> X Bool +clearTypedWindowRREvents w t = + rrEventBase >>= \case + Just base -> clearTypedWindowEvents w (base + t) + Nothing -> pure False + +rrEventBase :: X (Maybe EventType) +rrEventBase = withDisplay $ \d -> + fmap (fromIntegral . fst) <$> io (xrrQueryExtension d) diff --git a/XMonad/Hooks/StatusBar.hs b/XMonad/Hooks/StatusBar.hs index 9e0faac1..1332cf15 100644 --- a/XMonad/Hooks/StatusBar.hs +++ b/XMonad/Hooks/StatusBar.hs @@ -75,11 +75,10 @@ import qualified XMonad.Util.ExtensibleState as XS import XMonad.Layout.LayoutModifier import XMonad.Hooks.ManageDocks +import XMonad.Hooks.Rescreen import XMonad.Hooks.StatusBar.PP import qualified XMonad.StackSet as W -import Graphics.X11.Xrandr (xrrSelectInput) - -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- @@ -360,7 +359,7 @@ statusBarPipe cmd xpp = do -- > -- > main = xmonad $ withSB (xmobarTop <> xmobarBottom <> xmobar1) myConfig -- --- And here is an example of the related xmobar configuration for the multiple +-- And here is an example of the related xmobar configuration for the multiple -- status bars mentioned above: -- -- > xmobarrc_top @@ -440,13 +439,9 @@ instance ExtensionClass ActiveSBs where -- -- Heavily inspired by "XMonad.Hooks.DynamicBars" dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l -dynamicSBs f conf = conf - { startupHook = startupHook conf - >> setupEventHandler - >> killAllStatusBars - >> updateSBs f - , logHook = logHook conf >> logSBs - , handleEventHook = eventHookSBs f <> handleEventHook conf +dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf + { startupHook = startupHook conf >> killAllStatusBars >> updateSBs f + , logHook = logHook conf >> logSBs } -- | Like 'dynamicSBs', but applies 'docks' to the @@ -475,23 +470,10 @@ updateSBs f = do traverse_ (sbStartupHook . snd) added XS.put (ASB (toKeep ++ added)) --- | Handles 'RRScreenChangeNotifyEvent' by updating the --- status bars. -eventHookSBs :: (ScreenId -> IO StatusBarConfig) -> Event -> X All -eventHookSBs f RRScreenChangeNotifyEvent{} = updateSBs f >> return (All True) -eventHookSBs _ _ = return (All True) - -- | Run 'sbLogHook' for the saved 'StatusBarConfig's logSBs :: X () logSBs = XS.get >>= traverse_ (sbLogHook . snd) . getASBs --- | Subscribe to the 'RRScreenChangeNotifyEvent' -setupEventHandler :: X () -setupEventHandler = do - dpy <- asks display - root <- asks theRoot - io $ xrrSelectInput dpy root rrScreenChangeNotifyMask - -- | Kill the given 'StatusBarConfig's from the given -- list cleanSBs :: [StatusBarConfig] -> X () diff --git a/XMonad/Util/ExtensibleConf.hs b/XMonad/Util/ExtensibleConf.hs index fac7d8ef..a4f214d1 100644 --- a/XMonad/Util/ExtensibleConf.hs +++ b/XMonad/Util/ExtensibleConf.hs @@ -113,16 +113,16 @@ add x = alter (<> Just x) -- This can be used to implement a composable interface for modules that must -- only hook into xmonad core once. once :: forall a l. (Semigroup a, Typeable a) - => a -- ^ configuration to add - -> (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once + => (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once + -> a -- ^ configuration to add -> XConfig l -> XConfig l -once x f c = add x $ maybe f (const id) (lookup @a c) c +once f x c = add x $ maybe f (const id) (lookup @a c) c -- | Config-time: Applicative (monadic) variant of 'once', useful if the -- 'XConfig' modification needs to do some 'IO' (e.g. create an -- 'Data.IORef.IORef'). onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a) - => a -- ^ configuration to add - -> (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once + => (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once + -> a -- ^ configuration to add -> XConfig l -> m (XConfig l) -onceM x f c = add x <$> maybe f (const pure) (lookup @a c) c +onceM f x c = add x <$> maybe f (const pure) (lookup @a c) c diff --git a/tests/ExtensibleConf.hs b/tests/ExtensibleConf.hs index 61404b4c..bfb55560 100644 --- a/tests/ExtensibleConf.hs +++ b/tests/ExtensibleConf.hs @@ -22,9 +22,9 @@ spec = do XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` (Nothing :: Maybe ()) specify "once" $ - borderWidth (XC.once "a" incBorderWidth def) `shouldBe` succ (borderWidth def) + borderWidth (XC.once incBorderWidth "a" def) `shouldBe` succ (borderWidth def) specify "once . once" $ - borderWidth (XC.once "b" incBorderWidth (XC.once "a" incBorderWidth def)) + borderWidth (XC.once incBorderWidth "b" (XC.once incBorderWidth "a" def)) `shouldBe` succ (borderWidth def) incBorderWidth :: XConfig l -> XConfig l diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 8a4bb557..51393503 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -184,6 +184,7 @@ library XMonad.Hooks.Place XMonad.Hooks.PositionStoreHooks XMonad.Hooks.RefocusLast + XMonad.Hooks.Rescreen XMonad.Hooks.RestoreMinimized XMonad.Hooks.ScreenCorners XMonad.Hooks.Script