From b153adcb8cd88d94f5019566011894873f630566 Mon Sep 17 00:00:00 2001 From: Ivan Malison Date: Fri, 1 May 2026 22:18:32 -0700 Subject: [PATCH] river-xmonad: expand window management support --- docs/tiling-wm-experience.md | 10 + dotfiles/config/river-xmonad/Main.hs | 519 ++++++++++++++++-- .../river-xmonad/imalison-river-xmonad.cabal | 2 +- nixos/river-xmonad.nix | 252 +++++++-- 4 files changed, 703 insertions(+), 80 deletions(-) diff --git a/docs/tiling-wm-experience.md b/docs/tiling-wm-experience.md index 8f828411..70066681 100644 --- a/docs/tiling-wm-experience.md +++ b/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: diff --git a/dotfiles/config/river-xmonad/Main.hs b/dotfiles/config/river-xmonad/Main.hs index ce0d26ca..6c4a451a 100644 --- a/dotfiles/config/river-xmonad/Main.hs +++ b/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 "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 + renamed "Columns" EqualColumns ||| 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) <- - [ (W.greedyView, noMods) - , (W.shift, shift) - , (\workspaceId stackSet -> W.greedyView workspaceId (W.shift workspaceId stackSet), ctrl) + , (command, mods, action) <- + [ (W.greedyView, noMods, stackAction) + , (W.shift, shift, stackAction) + , (\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 = - stackAction $ - case direction of - DirectionUp -> W.swapUp - DirectionLeft -> W.swapUp - DirectionDown -> W.swapDown - DirectionRight -> W.swapDown +directionalSwap direction state@RiverWMState{riverWMStackSet} = + pure $ modifyRiverWMStackSet swapTarget state + where + target = directionalTargetAmong (W.index riverWMStackSet) direction state + swapTarget stackSet = + maybe (fallbackDirectionalSwap direction stackSet) (`swapFocusedWithWindow` stackSet) target + +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 diff --git a/dotfiles/config/river-xmonad/imalison-river-xmonad.cabal b/dotfiles/config/river-xmonad/imalison-river-xmonad.cabal index 103e5a48..b868054f 100644 --- a/dotfiles/config/river-xmonad/imalison-river-xmonad.cabal +++ b/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 diff --git a/nixos/river-xmonad.nix b/nixos/river-xmonad.nix index ca5cb783..dcd149ed 100644 --- a/nixos/river-xmonad.nix +++ b/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" - exec ${riverXmonadPackage}/bin/imalison-river-xmonad + echo "$$" > "$log_dir/runner.pid" + 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 { - 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 - ]; + riverRestart = pkgs.writeShellScriptBin "river-xmonad-restart" '' + set -u - 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" ]; - }; - }; + wm_bin="''${1:-${riverXmonadPackage}/bin/imalison-river-xmonad}" + log_dir="''${XDG_STATE_HOME:-$HOME/.local/state}/river-xmonad" + log_file="$log_dir/session.log" + mkdir -p "$log_dir" + + if [ ! -x "$wm_bin" ]; then + echo "river-xmonad-restart: WM binary is not executable: $wm_bin" >&2 + exit 1 + fi + + 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; [ - brightnessctl - river - riverDiagnostics - riverXmonadPackage - wl-clipboard - wtype - ]; -} + export XDG_RUNTIME_DIR="''${XDG_RUNTIME_DIR:-/run/user/$(${pkgs.coreutils}/bin/id -u)}" + systemd_wayland_display="$(env_value WAYLAND_DISPLAY)" + if [ -n "$systemd_wayland_display" ]; then + export WAYLAND_DISPLAY="$systemd_wayland_display" + else + export WAYLAND_DISPLAY="''${WAYLAND_DISPLAY:-}" + 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 + ]; + }