river-xmonad: expand window management support

docs/tiling-wm-experience.md

@@ -114,6 +114,16 @@ Important behavior:
 - Keyboard resize remains available, but it should not displace the directional
   move-to-monitor binding.
 
+## Pointer Focus
+
+Required behavior:
+
+- Focus-follows-mouse, or an equivalent pointer-driven focus model, is enabled.
+- Moving the pointer over a managed window focuses that window without requiring
+  a click.
+- Mouse-follows-focus is also enabled: keyboard or programmatic focus changes
+  move the pointer into the newly focused window.
+
 ## Layouts
 
 Required behavior:

dotfiles/config/river-xmonad/Main.hs

@@ -1,23 +1,26 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 
 module Main where
 
 import Control.Concurrent (forkIO)
 import Data.Bits ((.&.), complement)
+import Data.Char (toLower)
 import Data.Function (on)
-import Data.List (minimumBy)
+import Data.List (find, foldl', isInfixOf, isPrefixOf, minimumBy)
 import qualified Data.Map.Strict as M
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Typeable (Typeable)
+import Data.Word (Word32)
 import Graphics.X11.ExtraTypes.XF86
+import System.Exit (ExitCode(..))
 import System.IO (hFlush, stdout)
-import System.Process (spawnCommand, waitForProcess)
+import System.Process (readCreateProcessWithExitCode, shell, spawnCommand, waitForProcess)
 import XMonad
-import XMonad.Layout.Accordion
-import XMonad.Layout.Cross
-import XMonad.Layout.Grid
-import XMonad.Layout.MultiColumns
 import qualified XMonad.Layout.Renamed as RN
 import XMonad.River.WindowManager
 import XMonad.River.WindowManager.Wayland
@@ -26,11 +29,21 @@ import qualified XMonad.StackSet as W
 data Direction = DirectionUp | DirectionDown | DirectionLeft | DirectionRight
   deriving (Eq, Show)
 
+data EqualColumns a = EqualColumns
+  deriving (Read, Show, Typeable)
+
+instance LayoutClass EqualColumns a where
+  description _ = "Columns"
+  pureLayout _ rect stack =
+    zip windows (equalColumnRects rect (length windows))
+    where
+      windows = W.integrate stack
+
 main :: IO ()
 main = do
   let bindings = keyBindings
   configLog $ "starting imalison-river-xmonad with keybindings=" ++ show (length bindings)
-  initialState <- initialRiverWMState (defaultRiverWMConfig riverLayouts)
+  initialState <- initialRiverWMState riverConfig
   runRiverWMWaylandConfig
     RiverWMWaylandConfig
       { riverWMWaylandInitialState = initialState
@@ -38,18 +51,26 @@ main = do
       }
 
 riverLayouts =
-  renamed "4 Columns" (multiCol [1, 1, 1] 2 0.0 (-0.5))
+  renamed "Columns" EqualColumns
-  ||| renamed "3 Columns" (multiCol [1, 1] 2 0.01 (-0.5))
-  ||| renamed "Grid" Grid
-  ||| renamed "Large Main" (Tall 1 (3 / 100) (3 / 4))
-  ||| renamed "2 Columns" (Tall 1 (3 / 100) (1 / 2))
-  ||| renamed "Mirror 2 Columns" (Mirror (Tall 1 (3 / 100) (1 / 2)))
-  ||| renamed "Accordion" Accordion
-  ||| renamed "Cross" simpleCross
   ||| Full
   where
     renamed name = RN.renamed [RN.Replace name]
 
+riverConfig =
+  (defaultRiverWMConfig riverLayouts)
+    { riverWMWorkspaces = ordinaryWorkspaces ++ specialWorkspaces
+    , riverWMMouseFollowsFocus = True
+    , riverWMBorderWidth = 2
+    , riverWMFocusedBorderColor = rgba8 0xed 0xb4 0x43 0xee
+    , riverWMUnfocusedBorderColor = rgba8 0x59 0x59 0x59 0xaa
+    }
+
+rgba8 :: Word32 -> Word32 -> Word32 -> Word32 -> RiverWMColor
+rgba8 red green blue alpha =
+  RiverWMColor (wide red) (wide green) (wide blue) (wide alpha)
+  where
+    wide component = component * 0x01010101
+
 keyBindings
   :: (LayoutClass l Window, Read (l Window))
   => [RiverWMWaylandKeyBinding l]
@@ -58,6 +79,10 @@ keyBindings =
     concat
       [ directionalBindings super directionalFocus
       , directionalBindings (super .|. shift) directionalSwap
+      , directionalBindings (super .|. ctrl) (shiftFocusedToDirectionalScreen False)
+      , directionalBindings (super .|. ctrl .|. shift) shiftFocusedToEmptyWorkspaceOnDirectionalScreen
+      , directionalBindings hyper focusDirectionalScreen
+      , directionalBindings (hyper .|. shift) (shiftFocusedToDirectionalScreen True)
       , workspaceBindings
       , layoutBindings
       , spawnBindings
@@ -78,12 +103,12 @@ directionalBindings mods command =
 workspaceBindings
   :: [RiverWMWaylandKeyBinding l]
 workspaceBindings =
-  [ key (mods .|. super) keysym (stackAction $ command workspace)
+  [ key (mods .|. super) keysym (action $ command workspace)
   | (workspace, keysym) <- zip (map show [(1 :: Int) .. 9]) [xK_1 .. xK_9]
-  , (command, mods) <-
+  , (command, mods, action) <-
-      [ (W.greedyView, noMods)
+      [ (W.greedyView, noMods, stackAction)
-      , (W.shift, shift)
+      , (W.shift, shift, stackAction)
-      , (\workspaceId stackSet -> W.greedyView workspaceId (W.shift workspaceId stackSet), ctrl)
+      , (\workspaceId stackSet -> W.greedyView workspaceId (W.shift workspaceId stackSet), ctrl, stackActionWarpPointer)
       ]
   ]
 
@@ -92,6 +117,8 @@ layoutBindings
   => [RiverWMWaylandKeyBinding l]
 layoutBindings =
   [ key super xK_space (layoutAction NextLayout)
+  , key (super .|. shift) xK_space (layoutAction (JumpToLayout "Columns"))
+  , key (super .|. ctrl) xK_space (layoutAction (JumpToLayout "Full"))
   , key super xK_bracketleft (layoutAction Shrink)
   , key super xK_bracketright (layoutAction Expand)
   , key super xK_comma (layoutAction (IncMasterN 1))
@@ -102,15 +129,35 @@ spawnBindings
   :: [RiverWMWaylandKeyBinding l]
 spawnBindings =
   [ key super xK_Return (spawnAction "ghostty --gtk-single-instance=false")
+  , key (super .|. shift) xK_Return (spawnAction "ghostty --gtk-single-instance=false")
   , key super xK_p (spawnAction "rofi -show drun -show-icons")
   , key (super .|. shift) xK_p (spawnAction "rofi -show run")
+  , key super xK_Tab (selectWindowAction "windows" focusSelectedWindow)
+  , key super xK_g (selectWindowAction "go to window" focusSelectedWindow)
+  , key super xK_b (selectWindowAction "bring window" bringSelectedWindow)
+  , key (super .|. shift) xK_b (selectWindowAction "replace window" replaceSelectedWindow)
+  , key super xK_m minimizeFocusedWindow
+  , key (super .|. shift) xK_m restoreLastMinimizedWindow
+  , key super xK_q (spawnAction "river-xmonad-restart")
+  , key (super .|. shift) xK_c closeFocusedWindow
+  , key (super .|. shift) xK_q (spawnAction "riverctl exit")
+  , key (super .|. alt) xK_e (toggleScratchpad "element")
+  , key (super .|. alt) xK_h (toggleScratchpad "htop")
+  , key (super .|. alt) xK_k (toggleScratchpad "slack")
+  , key (super .|. alt) xK_s (toggleScratchpad "spotify")
+  , key (super .|. alt) xK_t (toggleScratchpad "transmission")
+  , key (super .|. alt) xK_v (toggleScratchpad "volume")
   , key (super .|. alt) xK_c (spawnAction "google-chrome-stable")
   , key super xK_e (spawnAction "emacsclient --eval '(emacs-everywhere)'")
+  , key (super .|. ctrl) xK_e (shiftFocusedToNextEmptyWorkspace False)
+  , key (super .|. shift) xK_e (shiftFocusedToNextEmptyWorkspace True)
   , key super xK_v (spawnAction "wl-paste | wtype -")
+  , key hyper xK_e viewNextEmptyWorkspace
   , key hyper xK_v (spawnAction "rofi -modi 'clipboard:greenclip print' -show clipboard")
   , key hyper xK_p (spawnAction "rofi-pass")
   , key hyper xK_h (spawnAction "rofi_shutter")
   , key hyper xK_c (spawnAction "shell_command.sh")
+  , key hyper xK_g gatherFocusedAppId
   , key hyper xK_x (spawnAction "rofi_command.sh")
   , key (hyper .|. shift) xK_l (spawnAction "loginctl lock-session")
   , key hyper xK_k (spawnAction "rofi_kill_process.sh")
@@ -120,7 +167,8 @@ spawnBindings =
   , key hyper xK_backslash (spawnAction "$HOME/dotfiles/dotfiles/lib/functions/mpg341cx_input toggle")
   , key hyper xK_i (spawnAction "rofi_select_input.hs")
   , key hyper xK_o (spawnAction "rofi_paswitch")
-  , key hyper xK_w (spawnAction "rofi_wallpaper.sh")
+  , key hyper xK_comma (spawnAction "rofi_wallpaper.sh")
+  , key hyper xK_slash (spawnAction "toggle_taffybar")
   , key hyper xK_y (spawnAction "rofi_agentic_skill")
   ]
 
@@ -204,25 +252,391 @@ stackAction
 stackAction f state =
   pure $ modifyRiverWMStackSet f state
 
+stackActionWarpPointer
+  :: (W.StackSet WorkspaceId (l Window) Window RiverWMOutputId ScreenDetail
+      -> W.StackSet WorkspaceId (l Window) Window RiverWMOutputId ScreenDetail)
+  -> RiverWMWaylandAction l
+stackActionWarpPointer f state =
+  pure $ modifyRiverWMStackSetAndWarpPointer f state
+
+data ScratchpadDefinition = ScratchpadDefinition
+  { scratchpadName :: !String
+  , scratchpadCommand :: !String
+  , scratchpadMatches :: !(RiverWMWindowState -> Bool)
+  }
+
+ordinaryWorkspaces :: [WorkspaceId]
+ordinaryWorkspaces = map show [(1 :: Int) .. 9]
+
+minimizedWorkspace :: WorkspaceId
+minimizedWorkspace = "__minimized"
+
+specialWorkspaces :: [WorkspaceId]
+specialWorkspaces =
+  minimizedWorkspace : map (scratchpadWorkspace . scratchpadName) scratchpadDefinitions
+
+scratchpadWorkspace :: String -> WorkspaceId
+scratchpadWorkspace name = "__scratchpad:" ++ name
+
+isSpecialWorkspace :: WorkspaceId -> Bool
+isSpecialWorkspace workspace =
+  workspace == minimizedWorkspace || "__scratchpad:" `isPrefixOf` workspace
+
+scratchpadDefinitions :: [ScratchpadDefinition]
+scratchpadDefinitions =
+  [ ScratchpadDefinition "element" "element-desktop" $
+      anyMatcher [appIdMatches "Element", appIdMatches "element"]
+  , ScratchpadDefinition "htop" "ghostty --title=htop -e htop" $
+      titleContains "htop"
+  , ScratchpadDefinition "slack" "slack" $
+      anyMatcher [appIdMatches "Slack", appIdMatches "slack"]
+  , ScratchpadDefinition "spotify" "spotify" $
+      anyMatcher [appIdMatches "Spotify", appIdMatches "spotify"]
+  , ScratchpadDefinition "transmission" "transmission-gtk" $
+      anyMatcher [titleContains "Transmission", appIdContains "transmission"]
+  , ScratchpadDefinition "volume" "pavucontrol" $
+      anyMatcher [appIdMatches "Pavucontrol", appIdContains "pavucontrol"]
+  ]
+
+anyMatcher :: [RiverWMWindowState -> Bool] -> RiverWMWindowState -> Bool
+anyMatcher matchers windowState =
+  any ($ windowState) matchers
+
+appIdMatches :: String -> RiverWMWindowState -> Bool
+appIdMatches expected windowState =
+  lower expected == maybe "" lower (riverWMWindowAppId windowState)
+
+appIdContains :: String -> RiverWMWindowState -> Bool
+appIdContains needle windowState =
+  lower needle `isInfixOf` maybe "" lower (riverWMWindowAppId windowState)
+
+titleContains :: String -> RiverWMWindowState -> Bool
+titleContains needle windowState =
+  lower needle `isInfixOf` maybe "" lower (riverWMWindowTitle windowState)
+
+lower :: String -> String
+lower = map toLower
+
+closeFocusedWindow :: RiverWMWaylandAction l
+closeFocusedWindow state@RiverWMState{riverWMStackSet, riverWMWindowIds} =
+  pure
+    ( maybe [] ((: []) . RiverWMCloseWindow) $
+        W.peek riverWMStackSet >>= (`M.lookup` riverWMWindowIds)
+    , state
+    )
+
+minimizeFocusedWindow :: RiverWMWaylandAction l
+minimizeFocusedWindow =
+  stackAction $ W.shift minimizedWorkspace
+
+restoreLastMinimizedWindow :: RiverWMWaylandAction l
+restoreLastMinimizedWindow =
+  stackActionWarpPointer $ \stackSet ->
+    case workspaceFocusedWindow minimizedWorkspace stackSet of
+      Nothing -> stackSet
+      Just window ->
+        let currentTag = W.currentTag stackSet
+        in W.focusWindow window (W.shiftWin currentTag window stackSet)
+
+toggleScratchpad :: String -> RiverWMWaylandAction l
+toggleScratchpad name state@RiverWMState{riverWMStackSet} =
+  case find ((== name) . scratchpadName) scratchpadDefinitions of
+    Nothing ->
+      pure ([], state)
+    Just scratchpad ->
+      case W.peek riverWMStackSet of
+        Just focused | focused `elem` matchingWindows ->
+          pure $ modifyRiverWMStackSet (W.shift $ scratchpadWorkspace name) state
+        _ ->
+          case matchingWindows of
+            window : _ ->
+              pure $ modifyRiverWMStackSetAndWarpPointer (showScratchpadWindow window) state
+            [] ->
+              spawnAction (scratchpadCommand scratchpad) state
+      where
+        matchingWindows = scratchpadWindows scratchpad state
+        showScratchpadWindow window stackSet =
+          let currentTag = W.currentTag stackSet
+          in W.float window nearFullScratchpadRect $
+            W.focusWindow window (W.shiftWin currentTag window stackSet)
+
+nearFullScratchpadRect :: W.RationalRect
+nearFullScratchpadRect =
+  W.RationalRect left top width height
+  where
+    width = 0.9
+    height = 0.9
+    left = 0.95 - width
+    top = 0.95 - height
+
+scratchpadWindows :: ScratchpadDefinition -> RiverWMState l -> [Window]
+scratchpadWindows ScratchpadDefinition{scratchpadMatches} RiverWMState{riverWMWindows} =
+  [ riverWMWindowXWindow windowState
+  | windowState <- M.elems riverWMWindows
+  , scratchpadMatches windowState
+  ]
+
+selectWindowAction
+  :: String
+  -> (Window -> RiverWMState l -> ([RiverWMRequest], RiverWMState l))
+  -> RiverWMWaylandAction l
+selectWindowAction prompt action state = do
+  selected <- rofiSelectWindow prompt state
+  pure $ maybe ([], state) (`action` state) selected
+
+focusSelectedWindow :: Window -> RiverWMState l -> ([RiverWMRequest], RiverWMState l)
+focusSelectedWindow window state =
+  modifyRiverWMStackSetAndWarpPointer (focusWindowEverywhere window) state
+
+bringSelectedWindow :: Window -> RiverWMState l -> ([RiverWMRequest], RiverWMState l)
+bringSelectedWindow window state =
+  modifyRiverWMStackSetAndWarpPointer (bringWindowToCurrentWorkspace window) state
+
+replaceSelectedWindow :: Window -> RiverWMState l -> ([RiverWMRequest], RiverWMState l)
+replaceSelectedWindow selected state =
+  modifyRiverWMStackSetAndWarpPointer replaceWindow state
+  where
+    replaceWindow stackSet =
+      case (W.peek stackSet, W.findTag selected stackSet) of
+        (Just focused, Just selectedWorkspace)
+          | focused /= selected ->
+              W.focusWindow selected $
+                W.shiftWin selectedWorkspace focused $
+                  W.shiftWin (W.currentTag stackSet) selected stackSet
+        _ -> stackSet
+
+gatherFocusedAppId :: RiverWMWaylandAction l
+gatherFocusedAppId state@RiverWMState{riverWMStackSet, riverWMWindowIds, riverWMWindows} =
+  pure $ modifyRiverWMStackSet gatherMatching state
+  where
+    focusedAppId = do
+      focused <- W.peek riverWMStackSet
+      windowId <- M.lookup focused riverWMWindowIds
+      riverWMWindowAppId =<< M.lookup windowId riverWMWindows
+
+    matchingWindows =
+      [ riverWMWindowXWindow windowState
+      | windowState <- M.elems riverWMWindows
+      , riverWMWindowAppId windowState == focusedAppId
+      ]
+
+    gatherMatching stackSet =
+      case focusedAppId of
+        Nothing -> stackSet
+        Just _ ->
+          foldl' (\acc window -> W.shiftWin (W.currentTag acc) window acc) stackSet matchingWindows
+
+rofiSelectWindow :: String -> RiverWMState l -> IO (Maybe Window)
+rofiSelectWindow prompt state =
+  case windowEntries state of
+    [] ->
+      pure Nothing
+    entries -> do
+      (exitCode, selected, _stderr) <-
+        readCreateProcessWithExitCode
+          (shell $ "rofi -dmenu -i -show-icons -p " ++ shellQuote prompt)
+          (concatMap formatWindowEntry entries)
+      pure $ case exitCode of
+        ExitSuccess -> parseSelectedWindow selected
+        _ -> Nothing
+
+data WindowEntry = WindowEntry
+  { windowEntryWindow :: !Window
+  , windowEntryWorkspace :: !WorkspaceId
+  , windowEntryAppId :: !String
+  , windowEntryTitle :: !String
+  }
+
+windowEntries :: RiverWMState l -> [WindowEntry]
+windowEntries RiverWMState{riverWMStackSet, riverWMWindowIds, riverWMWindows} =
+  [ WindowEntry window (W.tag workspace) appId title
+  | workspace <- W.workspaces riverWMStackSet
+  , not (isSpecialWorkspace $ W.tag workspace)
+  , window <- W.integrate' (W.stack workspace)
+  , let windowId = M.lookup window riverWMWindowIds
+  , Just windowState <- [windowId >>= (`M.lookup` riverWMWindows)]
+  , let appId = fromMaybe "window" (riverWMWindowAppId windowState)
+        title = fromMaybe "" (riverWMWindowTitle windowState)
+  ]
+
+formatWindowEntry :: WindowEntry -> String
+formatWindowEntry WindowEntry{..} =
+  visibleLabel ++ "\0icon\x1f" ++ iconName ++ "\n"
+  where
+    visibleLabel =
+      show windowEntryWindow
+        ++ "\t["
+        ++ windowEntryWorkspace
+        ++ "] "
+        ++ if null windowEntryTitle
+          then windowEntryAppId
+          else windowEntryAppId ++ " - " ++ windowEntryTitle
+    iconName = if null windowEntryAppId then "application-x-executable" else windowEntryAppId
+
+parseSelectedWindow :: String -> Maybe Window
+parseSelectedWindow selected =
+  case reads (takeWhile (/= '\t') $ takeWhile (/= '\0') selected) of
+    (window, _) : _ -> Just window
+    [] -> Nothing
+
+focusWindowEverywhere
+  :: Eq sid
+  => Window
+  -> W.StackSet WorkspaceId l Window sid sd
+  -> W.StackSet WorkspaceId l Window sid sd
+focusWindowEverywhere window stackSet =
+  maybe stackSet (\workspace -> W.focusWindow window (W.greedyView workspace stackSet)) $
+    W.findTag window stackSet
+
+bringWindowToCurrentWorkspace
+  :: Eq sid
+  => Window
+  -> W.StackSet WorkspaceId l Window sid sd
+  -> W.StackSet WorkspaceId l Window sid sd
+bringWindowToCurrentWorkspace window stackSet =
+  W.focusWindow window (W.shiftWin (W.currentTag stackSet) window stackSet)
+
+workspaceFocusedWindow :: WorkspaceId -> W.StackSet WorkspaceId l Window sid sd -> Maybe Window
+workspaceFocusedWindow workspace stackSet =
+  W.focus <$> (W.stack =<< find ((== workspace) . W.tag) (W.workspaces stackSet))
+
+shellQuote :: String -> String
+shellQuote value =
+  "'" ++ concatMap quoteChar value ++ "'"
+  where
+    quoteChar '\'' = "'\\''"
+    quoteChar char = [char]
+
+viewNextEmptyWorkspace :: RiverWMWaylandAction l
+viewNextEmptyWorkspace =
+  stackAction $ \stackSet ->
+    maybe stackSet (`W.greedyView` stackSet) (nextEmptyWorkspace stackSet)
+
+shiftFocusedToNextEmptyWorkspace :: Bool -> RiverWMWaylandAction l
+shiftFocusedToNextEmptyWorkspace follow =
+  (if follow then stackActionWarpPointer else stackAction) $ \stackSet ->
+    maybe stackSet (`shiftFocusedToWorkspace` stackSet) (nextEmptyWorkspace stackSet)
+  where
+    shiftFocusedToWorkspace workspace stackSet =
+      let shifted = W.shift workspace stackSet
+      in if follow then W.greedyView workspace shifted else shifted
+
+nextEmptyWorkspace
+  :: W.StackSet WorkspaceId l Window sid sd
+  -> Maybe WorkspaceId
+nextEmptyWorkspace stackSet =
+  find (`workspaceIsEmpty` stackSet) candidates
+  where
+    currentTag = W.currentTag stackSet
+    candidates =
+      case break (== currentTag) ordinaryWorkspaces of
+        (_before, []) -> ordinaryWorkspaces
+        (before, _current : after) -> after ++ before
+
+workspaceIsEmpty
+  :: WorkspaceId
+  -> W.StackSet WorkspaceId l Window sid sd
+  -> Bool
+workspaceIsEmpty workspace stackSet =
+  maybe False (null . W.integrate' . W.stack) $
+    find ((== workspace) . W.tag) (W.workspaces stackSet)
+
 directionalSwap :: Direction -> RiverWMWaylandAction l
-directionalSwap direction =
+directionalSwap direction state@RiverWMState{riverWMStackSet} =
-  stackAction $
+  pure $ modifyRiverWMStackSet swapTarget state
-    case direction of
+  where
-      DirectionUp -> W.swapUp
+    target = directionalTargetAmong (W.index riverWMStackSet) direction state
-      DirectionLeft -> W.swapUp
+    swapTarget stackSet =
-      DirectionDown -> W.swapDown
+      maybe (fallbackDirectionalSwap direction stackSet) (`swapFocusedWithWindow` stackSet) target
-      DirectionRight -> W.swapDown
+
+fallbackDirectionalSwap
+  :: Direction
+  -> W.StackSet WorkspaceId l Window sid sd
+  -> W.StackSet WorkspaceId l Window sid sd
+fallbackDirectionalSwap DirectionUp = W.swapUp
+fallbackDirectionalSwap DirectionLeft = W.swapUp
+fallbackDirectionalSwap DirectionDown = W.swapDown
+fallbackDirectionalSwap DirectionRight = W.swapDown
+
+swapFocusedWithWindow
+  :: Window
+  -> W.StackSet WorkspaceId l Window sid sd
+  -> W.StackSet WorkspaceId l Window sid sd
+swapFocusedWithWindow target stackSet =
+  case W.peek stackSet of
+    Just focused | focused /= target ->
+      W.modify' (swapStackOrder focused target) stackSet
+    _ -> stackSet
+
+swapStackOrder :: Eq a => a -> a -> W.Stack a -> W.Stack a
+swapStackOrder focused target stack =
+  stackFromListFocused stack focused $
+    map swapWindow (W.integrate stack)
+  where
+    swapWindow window
+      | window == focused = target
+      | window == target = focused
+      | otherwise = window
+
+stackFromListFocused :: Eq a => W.Stack a -> a -> [a] -> W.Stack a
+stackFromListFocused fallback focused windows =
+  case break (== focused) windows of
+    (before, _focused : after) -> W.Stack focused (reverse before) after
+    _ -> fallback
+
+focusDirectionalScreen :: Direction -> RiverWMWaylandAction l
+focusDirectionalScreen direction =
+  stackAction $ \stackSet ->
+    maybe stackSet ((`W.view` stackSet) . W.tag . W.workspace) $
+      directionalScreenTarget direction stackSet
+
+shiftFocusedToDirectionalScreen :: Bool -> Direction -> RiverWMWaylandAction l
+shiftFocusedToDirectionalScreen follow direction =
+  (if follow then stackActionWarpPointer else stackAction) $ \stackSet ->
+    maybe stackSet (shiftToScreen stackSet) $
+      directionalScreenTarget direction stackSet
+  where
+    shiftToScreen stackSet screen =
+      let workspace = W.tag (W.workspace screen)
+          shifted = W.shift workspace stackSet
+      in if follow then W.view workspace shifted else shifted
+
+shiftFocusedToEmptyWorkspaceOnDirectionalScreen :: Direction -> RiverWMWaylandAction l
+shiftFocusedToEmptyWorkspaceOnDirectionalScreen direction =
+  stackActionWarpPointer $ \stackSet ->
+    maybe stackSet (shiftToEmptyWorkspaceOnScreen stackSet) $
+      directionalScreenTarget direction stackSet
+  where
+    shiftToEmptyWorkspaceOnScreen stackSet screen =
+      let workspace = W.tag (W.workspace screen)
+          onDestination = W.view workspace (W.shift workspace stackSet)
+      in maybe onDestination
+        (\emptyWorkspace -> W.greedyView emptyWorkspace (W.shift emptyWorkspace onDestination))
+        (nextEmptyWorkspace onDestination)
 
 directionalFocus :: Direction -> RiverWMWaylandAction l
 directionalFocus direction state =
   pure $ modifyRiverWMStackSet focusDirectionalWindow state
   where
     focusDirectionalWindow stackSet =
-      maybe stackSet (`W.focusWindow` stackSet) $
+      maybe (fallbackDirectionalFocus direction stackSet) (`W.focusWindow` stackSet) $
         directionalTarget direction state
 
+fallbackDirectionalFocus
+  :: Direction
+  -> W.StackSet WorkspaceId l Window sid sd
+  -> W.StackSet WorkspaceId l Window sid sd
+fallbackDirectionalFocus DirectionUp = W.focusUp
+fallbackDirectionalFocus DirectionLeft = W.focusUp
+fallbackDirectionalFocus DirectionDown = W.focusDown
+fallbackDirectionalFocus DirectionRight = W.focusDown
+
 directionalTarget :: Direction -> RiverWMState l -> Maybe Window
-directionalTarget direction RiverWMState{riverWMStackSet, riverWMWindows, riverWMWindowIds} = do
+directionalTarget direction state@RiverWMState{riverWMStackSet} =
+  directionalTargetAmong (W.index riverWMStackSet) direction state
+
+directionalTargetAmong :: [Window] -> Direction -> RiverWMState l -> Maybe Window
+directionalTargetAmong allowed direction RiverWMState{riverWMStackSet, riverWMWindows, riverWMWindowIds} = do
   focused <- W.peek riverWMStackSet
   focusedId <- M.lookup focused riverWMWindowIds
   focusedRect <- riverWMWindowDesired =<< M.lookup focusedId riverWMWindows
@@ -232,10 +646,53 @@ directionalTarget direction RiverWMState{riverWMStackSet, riverWMWindows, riverW
         | (windowId, RiverWMWindowState{riverWMWindowXWindow = window, riverWMWindowDesired = Just rect}) <-
             M.toList riverWMWindows
         , windowId /= focusedId
+        , window `elem` allowed
         ]
       viable = mapMaybe sequenceCandidate candidates
   fst <$> minimumMaybeBy (compare `on` snd) viable
 
+directionalScreenTarget
+  :: Direction
+  -> W.StackSet WorkspaceId l Window sid ScreenDetail
+  -> Maybe (W.Screen WorkspaceId l Window sid ScreenDetail)
+directionalScreenTarget direction stackSet =
+  fst <$> minimumMaybeBy (compare `on` snd) viable
+  where
+    focusedCenter = screenCenter (W.current stackSet)
+    candidates =
+      [ (screen, directionScore direction focusedCenter (screenCenter screen))
+      | screen <- W.visible stackSet
+      ]
+    viable = mapMaybe sequenceCandidate candidates
+
+screenCenter :: W.Screen WorkspaceId l Window sid ScreenDetail -> (Double, Double)
+screenCenter = rectCenter . screenRect . W.screenDetail
+
+equalColumnRects :: Rectangle -> Int -> [Rectangle]
+equalColumnRects _ count | count <= 0 = []
+equalColumnRects rect 1 = [rect]
+equalColumnRects (Rectangle x y width height) count =
+  [ Rectangle
+      (x + fromIntegral riverOuterGap + fromIntegral (columnOffset index))
+      (y + fromIntegral riverOuterGap)
+      (fromIntegral (columnWidth index))
+      contentHeight
+  | index <- [0 .. count - 1]
+  ]
+  where
+    totalWidth = max 0 (fromIntegral width - 2 * riverOuterGap - riverInnerGap * (count - 1))
+    contentHeight = fromIntegral (max 1 (fromIntegral height - 2 * riverOuterGap :: Int))
+    baseWidth = totalWidth `div` count
+    extraPixels = totalWidth `mod` count
+    columnWidth index = baseWidth + if index < extraPixels then 1 else 0
+    columnOffset index = index * baseWidth + min index extraPixels + index * riverInnerGap
+
+riverOuterGap :: Int
+riverOuterGap = 10
+
+riverInnerGap :: Int
+riverInnerGap = 5
+
 sequenceCandidate :: (a, Maybe b) -> Maybe (a, b)
 sequenceCandidate (value, Just score) = Just (value, score)
 sequenceCandidate (_, Nothing) = Nothing

dotfiles/config/river-xmonad/imalison-river-xmonad.cabal

@@ -14,5 +14,5 @@ executable imalison-river-xmonad
                   , X11
                   , xmonad
                   , xmonad-contrib
-  ghc-options:      -Wall -Wno-unused-do-bind -Wno-deprecations -Wno-missing-signatures -Wno-name-shadowing
+  ghc-options:      -threaded -Wall -Wno-unused-do-bind -Wno-deprecations -Wno-missing-signatures -Wno-name-shadowing
   default-language: Haskell2010

nixos/river-xmonad.nix

@@ -5,8 +5,7 @@
   makeEnable,
   pkgs,
   ...
-}:
+}: let
-let
   session = import ./session-variables.nix;
 
   riverXmonadPkgs = pkgs.extend (
@@ -23,12 +22,36 @@ let
     exec ${pkgs.rofi}/bin/rofi -normal-window "$@"
   '';
 
+  cleanupStaleGraphicalSession = ''
+    if ! ${pkgs.procps}/bin/pgrep -u "$(${pkgs.coreutils}/bin/id -u)" -f '(^|/)(Hyprland|\.Hyprland-wrapped|river|kwin_wayland)( |$)' >/dev/null 2>&1; then
+      systemctl --user stop \
+        hyprland-session.target \
+        river-xmonad-session.target \
+        graphical-session.target \
+        graphical-session-pre.target \
+        tray.target \
+        2>/dev/null || true
+      systemctl --user unset-environment \
+        WAYLAND_DISPLAY \
+        DISPLAY \
+        XAUTHORITY \
+        HYPRLAND_INSTANCE_SIGNATURE \
+        XDG_CURRENT_DESKTOP \
+        XDG_SESSION_DESKTOP \
+        XDG_SESSION_TYPE \
+        ${session.sessionType} \
+        ${session.windowManager} \
+        2>/dev/null || true
+      systemctl --user reset-failed 2>/dev/null || true
+    fi
+  '';
+
   riverInit = pkgs.writeShellScript "river-xmonad-init" ''
     log_dir="''${XDG_STATE_HOME:-$HOME/.local/state}/river-xmonad"
     mkdir -p "$log_dir"
     echo "[$(${pkgs.coreutils}/bin/date --iso-8601=seconds)] river init start"
 
-    export PATH=${lib.makeBinPath [ riverRofi ]}:$PATH
+    export PATH=${lib.makeBinPath [riverRofi]}:$PATH
     export XDG_CURRENT_DESKTOP=river
     export XDG_SESSION_DESKTOP=river-xmonad
     export XDG_SESSION_TYPE=wayland
@@ -57,8 +80,30 @@ let
       ${session.sessionType} ${session.windowManager} DBUS_SESSION_BUS_ADDRESS PATH || true
     systemctl --user start river-xmonad-session.target || true
 
-    echo "[$(${pkgs.coreutils}/bin/date --iso-8601=seconds)] exec imalison-river-xmonad"
+    echo "$$" > "$log_dir/runner.pid"
-    exec ${riverXmonadPackage}/bin/imalison-river-xmonad
+    while true; do
+      wm_bin="${riverXmonadPackage}/bin/imalison-river-xmonad"
+      if [ -f "$log_dir/wm-bin" ]; then
+        configured_wm_bin="$(${pkgs.coreutils}/bin/cat "$log_dir/wm-bin" || true)"
+        if [ -n "$configured_wm_bin" ] && [ -x "$configured_wm_bin" ]; then
+          wm_bin="$configured_wm_bin"
+        else
+          echo "[$(${pkgs.coreutils}/bin/date --iso-8601=seconds)] ignoring invalid wm-bin: $configured_wm_bin"
+        fi
+      fi
+
+      echo "[$(${pkgs.coreutils}/bin/date --iso-8601=seconds)] exec imalison-river-xmonad: $wm_bin"
+      "$wm_bin"
+      status=$?
+      echo "[$(${pkgs.coreutils}/bin/date --iso-8601=seconds)] imalison-river-xmonad exited with status $status"
+
+      if [ -e "$log_dir/stop-runner" ]; then
+        echo "[$(${pkgs.coreutils}/bin/date --iso-8601=seconds)] stop-runner present, exiting runner"
+        exit "$status"
+      fi
+
+      ${pkgs.coreutils}/bin/sleep 0.25
+    done
   '';
 
   riverSession = pkgs.writeShellScriptBin "river-xmonad-session" ''
@@ -75,18 +120,20 @@ let
     export XDG_SESSION_TYPE=wayland
     export ${session.sessionType}=wayland
     export ${session.windowManager}=river-xmonad
-    export PATH=${lib.makeBinPath [ riverRofi ]}:$PATH
+    export PATH=${lib.makeBinPath [riverRofi]}:$PATH
 
     echo "river-xmonad: environment before river"
     env | ${pkgs.coreutils}/bin/sort
 
+    ${cleanupStaleGraphicalSession}
     systemctl --user stop hyprland-session.target || true
     systemctl --user unset-environment HYPRLAND_INSTANCE_SIGNATURE || true
 
     ${pkgs.river}/bin/river -c ${lib.escapeShellArg "${riverInit}"}
     status=$?
     echo "river-xmonad: river exited with status $status at $(${pkgs.coreutils}/bin/date --iso-8601=seconds)"
-    systemctl --user stop river-xmonad-session.target || true
+    systemctl --user stop river-xmonad-session.target graphical-session.target graphical-session-pre.target tray.target || true
+    systemctl --user unset-environment WAYLAND_DISPLAY DISPLAY XAUTHORITY HYPRLAND_INSTANCE_SIGNATURE XDG_CURRENT_DESKTOP XDG_SESSION_DESKTOP XDG_SESSION_TYPE ${session.sessionType} ${session.windowManager} || true
     exit "$status"
   '';
 
@@ -123,47 +170,156 @@ let
     fi
   '';
 
-  riverSessionPackage = (pkgs.writeTextFile {
+  riverRestart = pkgs.writeShellScriptBin "river-xmonad-restart" ''
-    name = "river-xmonad-session";
+    set -u
-    destination = "/share/wayland-sessions/river-xmonad.desktop";
-    text = ''
-      [Desktop Entry]
-      Name=river-xmonad
-      Comment=river with xmonad as its external window manager
-      Exec=${riverSession}/bin/river-xmonad-session
-      Type=Application
-      DesktopNames=river
-    '';
-  }).overrideAttrs (_old: {
-    passthru.providedSessions = [ "river-xmonad" ];
-  });
-in
-makeEnable config "myModules.riverXmonad" false {
-  services.displayManager.sessionPackages = [
-    riverSessionPackage
-  ];
 
-  home-manager.sharedModules = [
+    wm_bin="''${1:-${riverXmonadPackage}/bin/imalison-river-xmonad}"
-    {
+    log_dir="''${XDG_STATE_HOME:-$HOME/.local/state}/river-xmonad"
-      systemd.user.targets.river-xmonad-session = {
+    log_file="$log_dir/session.log"
-        Unit = {
+    mkdir -p "$log_dir"
-          Description = "river-xmonad session";
+
-          ConditionEnvironment = session.riverXmonad;
+    if [ ! -x "$wm_bin" ]; then
-          BindsTo = [ "graphical-session.target" ];
+      echo "river-xmonad-restart: WM binary is not executable: $wm_bin" >&2
-          Wants = [ "graphical-session-pre.target" ];
+      exit 1
-          After = [ "graphical-session-pre.target" ];
+    fi
-          Before = [ "graphical-session.target" ];
+
-        };
+    if ! ${pkgs.procps}/bin/pgrep -x river >/dev/null 2>&1; then
-      };
+      echo "river-xmonad-restart: river is not running" >&2
+      exit 1
+    fi
+
+    systemd_env="$(systemctl --user show-environment 2>/dev/null || true)"
+    env_value() {
+      printf '%s\n' "$systemd_env" | ${pkgs.gnused}/bin/sed -n "s/^$1=//p" | ${pkgs.coreutils}/bin/head -n 1
     }
-  ];
 
-  environment.systemPackages = with pkgs; [
+    export XDG_RUNTIME_DIR="''${XDG_RUNTIME_DIR:-/run/user/$(${pkgs.coreutils}/bin/id -u)}"
-    brightnessctl
+    systemd_wayland_display="$(env_value WAYLAND_DISPLAY)"
-    river
+    if [ -n "$systemd_wayland_display" ]; then
-    riverDiagnostics
+      export WAYLAND_DISPLAY="$systemd_wayland_display"
-    riverXmonadPackage
+    else
-    wl-clipboard
+      export WAYLAND_DISPLAY="''${WAYLAND_DISPLAY:-}"
-    wtype
+    fi
-  ];
+    if [ -z "''${WAYLAND_DISPLAY:-}" ]; then
-}
+      for socket in "$XDG_RUNTIME_DIR"/wayland-*; do
+        [ -S "$socket" ] || continue
+        export WAYLAND_DISPLAY="$(${pkgs.coreutils}/bin/basename "$socket")"
+        break
+      done
+    fi
+    export WAYLAND_DISPLAY="''${WAYLAND_DISPLAY:-wayland-1}"
+    systemd_display="$(env_value DISPLAY)"
+    if [ -n "$systemd_display" ]; then
+      export DISPLAY="$systemd_display"
+    else
+      export DISPLAY="''${DISPLAY:-}"
+    fi
+    export DBUS_SESSION_BUS_ADDRESS="''${DBUS_SESSION_BUS_ADDRESS:-$(env_value DBUS_SESSION_BUS_ADDRESS)}"
+    export XDG_CURRENT_DESKTOP=river
+    export XDG_SESSION_DESKTOP=river-xmonad
+    export XDG_SESSION_TYPE=wayland
+    export ${session.sessionType}=wayland
+    export ${session.windowManager}=river-xmonad
+    export PATH=${lib.makeBinPath [riverRofi]}:$PATH
+
+    wm_process_pattern='[b]in/imalison-river-xmonad($| )'
+    old_pids="$(${pkgs.procps}/bin/pgrep -f "$wm_process_pattern" || true)"
+    runner_pid="$(${pkgs.coreutils}/bin/cat "$log_dir/runner.pid" 2>/dev/null || true)"
+
+    if [ -z "$runner_pid" ] || ! ${pkgs.coreutils}/bin/kill -0 "$runner_pid" 2>/dev/null; then
+      echo "river-xmonad-restart: river-xmonad runner is not active; restart the river-xmonad session once to enable dynamic WM restarts" >&2
+      exit 2
+    fi
+
+    {
+      echo
+      echo "===== river-xmonad restart: $(${pkgs.coreutils}/bin/date --iso-8601=seconds) ====="
+      echo "river-xmonad-restart: binary=$wm_bin"
+      echo "$wm_bin" > "$log_dir/wm-bin"
+      echo "river-xmonad-restart: WAYLAND_DISPLAY=$WAYLAND_DISPLAY DISPLAY=''${DISPLAY:-}"
+      echo "river-xmonad-restart: runner pid: $runner_pid"
+      if [ -n "$old_pids" ]; then
+        echo "river-xmonad-restart: stopping old pids: $old_pids"
+      else
+        echo "river-xmonad-restart: no old imalison-river-xmonad process found; runner should start $wm_bin if idle"
+      fi
+    } >>"$log_file"
+
+    if [ -n "$old_pids" ]; then
+      for pid in $old_pids; do
+        ${pkgs.coreutils}/bin/kill -TERM "$pid" 2>/dev/null || true
+      done
+
+      i=0
+      while ${pkgs.procps}/bin/pgrep -f "$wm_process_pattern" >/dev/null 2>&1 && [ "$i" -lt 30 ]; do
+        ${pkgs.coreutils}/bin/sleep 0.1
+        i=$((i + 1))
+      done
+
+      if ${pkgs.procps}/bin/pgrep -f "$wm_process_pattern" >/dev/null 2>&1; then
+        ${pkgs.procps}/bin/pkill -KILL -f "$wm_process_pattern" || true
+      fi
+    fi
+
+    i=0
+    while [ "$i" -lt 50 ]; do
+      new_pids="$(${pkgs.procps}/bin/pgrep -f "$wm_process_pattern" || true)"
+      if [ -n "$new_pids" ] && [ "$new_pids" != "$old_pids" ]; then
+        echo "$new_pids" | ${pkgs.coreutils}/bin/head -n 1 > "$log_dir/wm.pid"
+        echo "river-xmonad-restart: active pid(s): $new_pids"
+        exit 0
+      fi
+      ${pkgs.coreutils}/bin/sleep 0.1
+      i=$((i + 1))
+    done
+
+    echo "river-xmonad-restart: timed out waiting for runner to start $wm_bin" >&2
+    exit 1
+  '';
+
+  riverSessionPackage =
+    (pkgs.writeTextFile {
+      name = "river-xmonad-session";
+      destination = "/share/wayland-sessions/river-xmonad.desktop";
+      text = ''
+        [Desktop Entry]
+        Name=river-xmonad
+        Comment=river with xmonad as its external window manager
+        Exec=${riverSession}/bin/river-xmonad-session
+        Type=Application
+        DesktopNames=river
+      '';
+    }).overrideAttrs (_old: {
+      passthru.providedSessions = ["river-xmonad"];
+    });
+in
+  makeEnable config "myModules.riverXmonad" false {
+    services.displayManager.sessionPackages = [
+      riverSessionPackage
+    ];
+
+    home-manager.sharedModules = [
+      {
+        systemd.user.targets.river-xmonad-session = {
+          Unit = {
+            Description = "river-xmonad session";
+            ConditionEnvironment = session.riverXmonad;
+            BindsTo = ["graphical-session.target"];
+            Wants = ["graphical-session-pre.target"];
+            After = ["graphical-session-pre.target"];
+            Before = ["graphical-session.target"];
+          };
+        };
+      }
+    ];
+
+    environment.systemPackages = with pkgs; [
+      brightnessctl
+      river
+      riverDiagnostics
+      riverRestart
+      riverXmonadPackage
+      wl-clipboard
+      wtype
+    ];
+  }