X.H.Rescreen: Allow overriding rescreen itself

The primary motivation is to fix `rescreen` messing up the
workspaces/screens order when making small changes to the layout of
multiple screens — such as resizing virtual monitors via `xrandr
--setmonitor`.
This commit is contained in:
Tomas Janousek 2024-10-16 13:50:56 +01:00
parent 1c5261d65a
commit 5680205c72

View File

@ -15,6 +15,7 @@ module XMonad.Hooks.Rescreen (
-- $usage -- $usage
addAfterRescreenHook, addAfterRescreenHook,
addRandrChangeHook, addRandrChangeHook,
setRescreenWorkspacesHook,
RescreenConfig(..), RescreenConfig(..),
rescreenHook, rescreenHook,
) where ) where
@ -59,16 +60,18 @@ import qualified XMonad.Util.ExtensibleConf as XC
data RescreenConfig = RescreenConfig data RescreenConfig = RescreenConfig
{ afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen' { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen'
, randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects
, rescreenWorkspacesHook :: Last (X ()) -- ^ hook to invoke instead of 'rescreen'
} }
instance Default RescreenConfig where instance Default RescreenConfig where
def = RescreenConfig def = RescreenConfig
{ afterRescreenHook = mempty { afterRescreenHook = mempty
, randrChangeHook = mempty , randrChangeHook = mempty
, rescreenWorkspacesHook = mempty
} }
instance Semigroup RescreenConfig where instance Semigroup RescreenConfig where
RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch') RescreenConfig arh rch rwh <> RescreenConfig arh' rch' rwh' = RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh')
instance Monoid RescreenConfig where instance Monoid RescreenConfig where
mempty = def mempty = def
@ -89,8 +92,14 @@ instance Monoid RescreenConfig where
-- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps -- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps
-- autorandr) when outputs are (dis)connected. -- autorandr) when outputs are (dis)connected.
-- --
-- 'rescreenWorkspacesHook' allows tweaking the 'rescreen' implementation,
-- to change the order workspaces are assigned to physical screens for
-- example.
--
-- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still -- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still
-- done just once and hooks are invoked in sequence, also just once. -- done just once and hooks are invoked in sequence (except
-- 'rescreenWorkspacesHook', which has a replace rather than sequence
-- semantics), also just once.
rescreenHook :: RescreenConfig -> XConfig l -> XConfig l rescreenHook :: RescreenConfig -> XConfig l -> XConfig l
rescreenHook = XC.once $ \c -> c rescreenHook = XC.once $ \c -> c
{ startupHook = startupHook c <> rescreenStartupHook { startupHook = startupHook c <> rescreenStartupHook
@ -104,6 +113,10 @@ addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h
addRandrChangeHook :: X () -> XConfig l -> XConfig l addRandrChangeHook :: X () -> XConfig l -> XConfig l
addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h } addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h }
-- | Shortcut for 'rescreenHook'.
setRescreenWorkspacesHook :: X () -> XConfig l -> XConfig l
setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure (catchX h rescreen) }
-- | Startup hook to listen for @RRScreenChangeNotify@ events. -- | Startup hook to listen for @RRScreenChangeNotify@ events.
rescreenStartupHook :: X () rescreenStartupHook :: X ()
rescreenStartupHook = do rescreenStartupHook = do
@ -132,7 +145,7 @@ handleEvent e = XC.with $ \RescreenConfig{..} -> do
-- configuration change, so rescreen and fire rescreenHook. Otherwise, -- configuration change, so rescreen and fire rescreenHook. Otherwise,
-- this is just a connect/disconnect, fire randrChangeHook. -- this is just a connect/disconnect, fire randrChangeHook.
if ev_event_type e == configureNotify || moreConfigureEvents if ev_event_type e == configureNotify || moreConfigureEvents
then rescreen >> afterRescreenHook then fromMaybe rescreen (getLast rescreenWorkspacesHook) >> afterRescreenHook
else randrChangeHook else randrChangeHook
-- | Remove all X events of a given window and type from the event queue, -- | Remove all X events of a given window and type from the event queue,