From 5680205c722d24ea824eeb09ecee5ca0ef9475a3 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 16 Oct 2024 13:50:56 +0100 Subject: [PATCH 1/6] X.H.Rescreen: Allow overriding rescreen itself MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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`. --- XMonad/Hooks/Rescreen.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/XMonad/Hooks/Rescreen.hs b/XMonad/Hooks/Rescreen.hs index 85216390f..4a33657bd 100644 --- a/XMonad/Hooks/Rescreen.hs +++ b/XMonad/Hooks/Rescreen.hs @@ -15,6 +15,7 @@ module XMonad.Hooks.Rescreen ( -- $usage addAfterRescreenHook, addRandrChangeHook, + setRescreenWorkspacesHook, RescreenConfig(..), rescreenHook, ) where @@ -59,16 +60,18 @@ import qualified XMonad.Util.ExtensibleConf as XC data RescreenConfig = RescreenConfig { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen' , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects + , rescreenWorkspacesHook :: Last (X ()) -- ^ hook to invoke instead of 'rescreen' } instance Default RescreenConfig where def = RescreenConfig { afterRescreenHook = mempty , randrChangeHook = mempty + , rescreenWorkspacesHook = mempty } 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 mempty = def @@ -89,8 +92,14 @@ instance Monoid RescreenConfig where -- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps -- 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 --- 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 = XC.once $ \c -> c { startupHook = startupHook c <> rescreenStartupHook @@ -104,6 +113,10 @@ addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h addRandrChangeHook :: X () -> XConfig l -> XConfig l 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. rescreenStartupHook :: X () rescreenStartupHook = do @@ -132,7 +145,7 @@ handleEvent e = XC.with $ \RescreenConfig{..} -> do -- 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 + then fromMaybe rescreen (getLast rescreenWorkspacesHook) >> afterRescreenHook else randrChangeHook -- | Remove all X events of a given window and type from the event queue, From b454f1e0be143353b76b0c69fc3736b9cdaa3f0f Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 16 Oct 2024 13:59:12 +0100 Subject: [PATCH 2/6] X.H.Rescreen: Move error handling to rescreenHook This handles errors in hooks set using `rescreenHook` as well, not just those set using the individual adders/setters. Fixes: 2e3254a9080c ("X.H.Rescreen: Catch exceptions in user-provided hooks in add*Hook") --- XMonad/Hooks/Rescreen.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/XMonad/Hooks/Rescreen.hs b/XMonad/Hooks/Rescreen.hs index 4a33657bd..594e101b7 100644 --- a/XMonad/Hooks/Rescreen.hs +++ b/XMonad/Hooks/Rescreen.hs @@ -101,21 +101,28 @@ instance Monoid RescreenConfig where -- 'rescreenWorkspacesHook', which has a replace rather than sequence -- semantics), also just once. rescreenHook :: RescreenConfig -> XConfig l -> XConfig l -rescreenHook = XC.once $ \c -> c - { startupHook = startupHook c <> rescreenStartupHook - , handleEventHook = handleEventHook c <> rescreenEventHook } +rescreenHook = XC.once hook . catchUserCode + where + hook c = c + { startupHook = startupHook c <> rescreenStartupHook + , handleEventHook = handleEventHook c <> rescreenEventHook } + catchUserCode rc@RescreenConfig{..} = rc + { afterRescreenHook = userCodeDef () afterRescreenHook + , randrChangeHook = userCodeDef () randrChangeHook + , rescreenWorkspacesHook = flip catchX rescreen <$> rescreenWorkspacesHook + } -- | Shortcut for 'rescreenHook'. addAfterRescreenHook :: X () -> XConfig l -> XConfig l -addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h } +addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h } -- | Shortcut for 'rescreenHook'. addRandrChangeHook :: X () -> XConfig l -> XConfig l -addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h } +addRandrChangeHook h = rescreenHook def{ randrChangeHook = h } -- | Shortcut for 'rescreenHook'. setRescreenWorkspacesHook :: X () -> XConfig l -> XConfig l -setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure (catchX h rescreen) } +setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure h } -- | Startup hook to listen for @RRScreenChangeNotify@ events. rescreenStartupHook :: X () From 2f42d2e7b4be41978435fdae37361fc5d1fe0d69 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 16 Oct 2024 19:25:41 +0100 Subject: [PATCH 3/6] X.H.Rescreen: Configurable wait/delay for events to settle --- XMonad/Hooks/Rescreen.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/XMonad/Hooks/Rescreen.hs b/XMonad/Hooks/Rescreen.hs index 594e101b7..e43ab0bf9 100644 --- a/XMonad/Hooks/Rescreen.hs +++ b/XMonad/Hooks/Rescreen.hs @@ -16,10 +16,12 @@ module XMonad.Hooks.Rescreen ( addAfterRescreenHook, addRandrChangeHook, setRescreenWorkspacesHook, + setRescreenDelay, RescreenConfig(..), rescreenHook, ) where +import Control.Concurrent (threadDelay) import Graphics.X11.Xrandr import XMonad import XMonad.Prelude @@ -61,6 +63,7 @@ data RescreenConfig = RescreenConfig { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen' , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects , rescreenWorkspacesHook :: Last (X ()) -- ^ hook to invoke instead of 'rescreen' + , rescreenDelay :: Last Int -- ^ delay (in microseconds) to wait for events to settle } instance Default RescreenConfig where @@ -68,10 +71,12 @@ instance Default RescreenConfig where { afterRescreenHook = mempty , randrChangeHook = mempty , rescreenWorkspacesHook = mempty + , rescreenDelay = mempty } instance Semigroup RescreenConfig where - RescreenConfig arh rch rwh <> RescreenConfig arh' rch' rwh' = RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh') + RescreenConfig arh rch rwh rd <> RescreenConfig arh' rch' rwh' rd' = + RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh') (rd <> rd') instance Monoid RescreenConfig where mempty = def @@ -96,6 +101,10 @@ instance Monoid RescreenConfig where -- to change the order workspaces are assigned to physical screens for -- example. -- +-- 'rescreenDelay' makes xmonad wait a bit for events to settle (after the +-- first event is received) — useful when multiple @xrandr@ invocations are +-- being used to change the screen layout. +-- -- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still -- done just once and hooks are invoked in sequence (except -- 'rescreenWorkspacesHook', which has a replace rather than sequence @@ -124,6 +133,10 @@ addRandrChangeHook h = rescreenHook def{ randrChangeHook = h } setRescreenWorkspacesHook :: X () -> XConfig l -> XConfig l setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure h } +-- | Shortcut for 'rescreenHook'. +setRescreenDelay :: Int -> XConfig l -> XConfig l +setRescreenDelay d = rescreenHook def{ rescreenDelay = pure d } + -- | Startup hook to listen for @RRScreenChangeNotify@ events. rescreenStartupHook :: X () rescreenStartupHook = do @@ -146,6 +159,7 @@ 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. + whenJust (getLast rescreenDelay) (io . threadDelay) moreConfigureEvents <- clearTypedWindowEvents (ev_window e) configureNotify _ <- clearTypedWindowRREvents (ev_window e) rrScreenChangeNotify -- If there were any ConfigureEvents, this is an actual screen From f97ce867acb28d76fa812627286df818d6a629e1 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Wed, 16 Oct 2024 19:30:57 +0100 Subject: [PATCH 4/6] X.A.PhysicalScreens: Add rescreen alternative to avoid ws reshuffle Probably a very niche use-case: I have an ultra-wide display that I split into two using `xrandr --setmonitor`, and I want the workspaces to stay in place when the split ratio is adjusted. Furthermore, this fixes workspace reshuffling when a virtual monitor is added for screensharing a portion of the screen (https://news.ycombinator.com/item?id=41837204). Can't think of a scenario involving just physical screens where this would be useful. Those are mostly added/removed, so if anything, one might wish to preserve the workspace that is currently being showed, but that would require knowing the output name (only available via RandR, not via Xinerama). If someone physically moves their displays around and then invokes `xrandr` to update the layout, this might very well do the right thing, but I don't think anyone moves their displays around often enough to be annoyed by xmonad reshuffling the workspaces. :-) --- XMonad/Actions/PhysicalScreens.hs | 59 +++++++++++++++++++++++++++++-- 1 file changed, 57 insertions(+), 2 deletions(-) diff --git a/XMonad/Actions/PhysicalScreens.hs b/XMonad/Actions/PhysicalScreens.hs index da93b021e..df61eb8f5 100644 --- a/XMonad/Actions/PhysicalScreens.hs +++ b/XMonad/Actions/PhysicalScreens.hs @@ -1,4 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ParallelListComp #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.PhysicalScreens @@ -28,10 +30,13 @@ module XMonad.Actions.PhysicalScreens ( , getScreenIdAndRectangle , screenComparatorById , screenComparatorByRectangle + , rescreen ) where -import XMonad -import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy) +import Data.List.NonEmpty (nonEmpty) +import XMonad hiding (rescreen) +import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy, NonEmpty((:|))) +import qualified Data.List.NonEmpty as NE import qualified XMonad.StackSet as W {- $usage @@ -146,3 +151,53 @@ onNextNeighbour sc = neighbourWindows sc 1 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter. onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X () onPrevNeighbour sc = neighbourWindows sc (-1) + +-- | An alternative to 'XMonad.Operations.rescreen' that avoids reshuffling +-- the workspaces if the number of screens doesn't change and only their +-- locations do. Useful for users of @xrandr --setmonitor@. +-- +-- See 'XMonad.Hooks.Rescreen.setRescreenWorkspacesHook', which lets you +-- replace the builtin rescreen handler. +rescreen :: ScreenComparator -> X () +rescreen (ScreenComparator cmpScreen) = withDisplay (fmap nonEmpty . getCleanedScreenInfo) >>= \case + Nothing -> trace "getCleanedScreenInfo returned []" + Just xinescs -> windows $ rescreen' xinescs + where + rescreen' :: NonEmpty Rectangle -> WindowSet -> WindowSet + rescreen' xinescs ws + | NE.length xinescs == length (W.visible ws) + 1 = rescreenSameLength xinescs ws + | otherwise = rescreenCore xinescs ws + + -- the 'XMonad.Operations.rescreen' implementation from core as a fallback + rescreenCore :: NonEmpty Rectangle -> WindowSet -> WindowSet + rescreenCore (xinesc :| xinescs) ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } = + let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs) + a = W.Screen (W.workspace v) 0 (SD xinesc) + as = zipWith3 W.Screen xs [1..] $ map SD xinescs + in ws{ W.current = a + , W.visible = as + , W.hidden = ys } + + -- sort both existing screens and the screens we just got from xinerama + -- using cmpScreen, and then replace the rectangles in the WindowSet, + -- keeping the order of current/visible workspaces intact + rescreenSameLength :: NonEmpty Rectangle -> WindowSet -> WindowSet + rescreenSameLength xinescs ws = + ws{ W.current = (W.current ws){ W.screenDetail = SD newCurrentRect } + , W.visible = [ w{ W.screenDetail = SD r } | w <- W.visible ws | r <- newVisibleRects ] + } + where + undoSort = + NE.map fst $ + NE.sortBy (cmpScreen `on` (getScreenIdAndRectangle . snd)) $ + NE.zip ((0 :: Int) :| [1..]) $ -- add indices to undo the sort later + W.current ws :| W.visible ws + newCurrentRect :| newVisibleRects = + NE.map snd $ NE.sortWith fst $ NE.zip undoSort $ -- sort back into current:visible order + NE.map snd $ NE.sortBy cmpScreen $ NE.zip (0 :| [1..]) xinescs + + -- TODO: + -- If number of screens before and after isn't the same, we might still + -- try to match locations and avoid changing the workspace for those that + -- didn't move, while making sure that the current workspace is still + -- visible somewhere. From 60fc830e2e8d74db2f88e20892895f0b1e9c21cb Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Thu, 17 Oct 2024 17:45:23 +0100 Subject: [PATCH 5/6] CHANGES: Inline links MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Seems somewhat likely that "on the website", "this PR" and "priorities" may be used again in a different context… --- CHANGES.md | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index f55fdc091..6393dc6dd 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -430,7 +430,8 @@ * `XMonad.Config.{Arossato,Dmwit,Droundy,Monad,Prime,Saegesser,Sjanssen}` - Deprecated all of these modules. The user-specific configuration - modules may still be found [on the website]. + modules may still be found [on the + website](https://xmonad.org/configurations.html) * `XMonad.Util.NamedScratchpad` @@ -451,8 +452,6 @@ - Deprecated `urgencyConfig`; use `def` from the new `Default` instance of `UrgencyConfig` instead. -[on the website]: https://xmonad.org/configurations.html - ### New Modules * `XMonad.Actions.PerLayoutKeys` @@ -527,7 +526,8 @@ `todo +d 12 02 2024` work. - Added the ability to specify alphabetic (`#A`, `#B`, and `#C`) - [priorities] at the end of the input note. + [priorities](https://orgmode.org/manual/Priorities.html) at the end of + the input note. * `XMonad.Prompt.Unicode` @@ -621,7 +621,8 @@ - Modified `mkAbsolutePath` to support a leading environment variable, so things like `$HOME/NOTES` work. If you want more general environment - variable support, comment on [this PR]. + variable support, comment on [this + PR](https://github.com/xmonad/xmonad-contrib/pull/744) * `XMonad.Util.XUtils` @@ -660,9 +661,6 @@ - Added a `Default` instance for `UrgencyConfig` and `DzenUrgencyHook`. -[this PR]: https://github.com/xmonad/xmonad-contrib/pull/744 -[priorities]: https://orgmode.org/manual/Priorities.html - ### Other changes * Migrated the sample build scripts from the deprecated `xmonad-testing` repo to @@ -2188,8 +2186,8 @@ * `XMonad.Prompt.Pass` - This module provides 3 `XMonad.Prompt`s to ease passwords - manipulation (generate, read, remove) via [pass][]. + This module provides 3 `XMonad.Prompt`s to ease passwords manipulation + (generate, read, remove) via [pass](http://www.passwordstore.org/). * `XMonad.Util.RemoteWindows` @@ -2265,5 +2263,3 @@ ## See Also - -[pass]: http://www.passwordstore.org/ From 61f8b4aa8ea5f2b88fd702c5a5700c014cd8d979 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Thu, 17 Oct 2024 17:52:42 +0100 Subject: [PATCH 6/6] CHANGES: Document the X.H.Rescreen, X.A.PhysicalScreens additions --- CHANGES.md | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 6393dc6dd..1c9d8dfd2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,19 @@ would be deleted when switching to a dynamic project. - Improved documentation on how to close a project. + * `XMonad.Hooks.Rescreen` + + - Allow overriding the `rescreen` operation itself. Additionally, the + `XMonad.Actions.PhysicalScreens` module now provides an alternative + implementation of `rescreen` that avoids reshuffling the workspaces if + the number of screens doesn't change and only their locations do (which + is especially common if one uses `xrandr --setmonitor` to split an + ultra-wide display in two). + + - Added an optional delay when waiting for events to settle. This may be + used to avoid flicker and unnecessary workspace reshuffling if multiple + `xrandr` commands are used to reconfigure the display layout. + ## 0.18.1 (August 20, 2024) ### Breaking Changes