Merge pull request #911 from liskin/rescreen

X.H.Rescreen, X.A.PhysicalScreens: Add facilities to avoid (some) workspace reshuffling

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
@@ -430,7 +443,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 +465,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 +539,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 +634,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 +674,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 +2199,8 @@
 
   * `XMonad.Prompt.Pass`
 
-    This module provides 3 `XMonad.Prompt`s to ease passwords
+    This module provides 3 `XMonad.Prompt`s to ease passwords manipulation
-    manipulation (generate, read, remove) via [pass][].
+    (generate, read, remove) via [pass](http://www.passwordstore.org/).
 
   * `XMonad.Util.RemoteWindows`
 
@@ -2265,5 +2276,3 @@
 ## See Also
 
 <https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
-
-[pass]: http://www.passwordstore.org/

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 Data.List.NonEmpty (nonEmpty)
-import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
+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.

XMonad/Hooks/Rescreen.hs

@@ -15,10 +15,13 @@ module XMonad.Hooks.Rescreen (
     -- $usage
     addAfterRescreenHook,
     addRandrChangeHook,
+    setRescreenWorkspacesHook,
+    setRescreenDelay,
     RescreenConfig(..),
     rescreenHook,
     ) where
 
+import Control.Concurrent (threadDelay)
 import Graphics.X11.Xrandr
 import XMonad
 import XMonad.Prelude
@@ -59,16 +62,21 @@ 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'
+    , rescreenDelay :: Last Int -- ^ delay (in microseconds) to wait for events to settle
     }
 
 instance Default RescreenConfig where
     def = RescreenConfig
         { afterRescreenHook = mempty
         , randrChangeHook = mempty
+        , rescreenWorkspacesHook = mempty
+        , rescreenDelay = mempty
         }
 
 instance Semigroup RescreenConfig where
-    RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch')
+    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
@@ -89,20 +97,45 @@ 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.
+--
+-- '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, 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
+rescreenHook = XC.once hook . catchUserCode
-    { startupHook = startupHook c <> rescreenStartupHook
+  where
-    , handleEventHook = handleEventHook c <> rescreenEventHook }
+    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 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 ()
@@ -126,13 +159,14 @@ 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
     -- 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,