From bbd972012e74e4bbcd936feb02893e94bc0aaff9 Mon Sep 17 00:00:00 2001 From: 4caraml <86114387+4caraml@users.noreply.github.com> Date: Fri, 18 Jun 2021 23:31:51 +0200 Subject: [PATCH] X.H.WindowSwallowing: Implement SubLayout window "swallowing" This implements window swallowing on top of SubLayouts; the matched windows are simply tabbed together instead of one actually being swallowed. This provides an improved experience for people using SubLayouts, as the parent window is still accessible. Done as part of ZuriHac 2021. Related: https://github.com/xmonad/xmonad-contrib/issues/416#issuecomment-777400194 --- CHANGES.md | 2 +- XMonad/Doc/Extending.hs | 2 +- XMonad/Hooks/WindowSwallowing.hs | 100 +++++++++++++++++++------------ 3 files changed, 63 insertions(+), 41 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index a3199ea5a6..370984f608 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -192,7 +192,7 @@ * `XMonad.Hooks.WindowSwallowing` - A handleEventHook that implements window swallowing: + HandleEventHooks that implement window swallowing or sublayouting: Hide parent windows like terminals when opening other programs (like image viewers) from within them, restoring them once the child application closes. diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 1a9b12b596..1bda5e61b7 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -598,7 +598,7 @@ Here is a list of the modules found in @XMonad.Hooks@: Keeps track of workspace viewing order. * "XMonad.Hooks.WindowSwallowing" - A handleEventHook that implements window swallowing: + handleEventHooks that implement window swallowing or sublayouting: Hide parent windows like terminals when opening other programs (like image viewers) from within them, restoring them once the child application closes. diff --git a/XMonad/Hooks/WindowSwallowing.hs b/XMonad/Hooks/WindowSwallowing.hs index 0567d1c9ab..45ae99be5a 100644 --- a/XMonad/Hooks/WindowSwallowing.hs +++ b/XMonad/Hooks/WindowSwallowing.hs @@ -40,12 +40,13 @@ module XMonad.Hooks.WindowSwallowing ( -- * Usage -- $usage - swallowEventHook + swallowEventHook, swallowEventHookSub ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W +import XMonad.Layout.SubLayouts import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.WindowProperties import XMonad.Util.Run ( runProcessWithInput ) @@ -60,9 +61,57 @@ import qualified Data.Map.Strict as M -- -- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True) -- +-- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layouts.SubLayouts" is used; +-- instead of swallowing the window it will merge the child window with the parent. (this does not work with floating windows) +-- -- For more information on editing your handleEventHook and key bindings, -- see "XMonad.Doc.Extending". +-- | Run @action@ iff both parent- and child queries match and the child +-- is a child by PID. +-- +-- A 'MapRequestEvent' is called right before a window gets opened. We +-- intercept that call to possibly open the window ourselves, swapping +-- out it's parent processes window for the new window in the stack. +handleMapRequestEvent :: Query Bool -> Query Bool -> Window -> (Window -> X ()) -> X () +handleMapRequestEvent parentQ childQ childWindow action = + -- For a window to be opened from within another window, that other window + -- must be focused. Thus the parent window that would be swallowed has to be + -- the currently focused window. + withFocused $ \parentWindow -> do + -- First verify that both windows match the given queries + parentMatches <- runQuery parentQ parentWindow + childMatches <- runQuery childQ childWindow + when (parentMatches && childMatches) $ do + -- read the windows _NET_WM_PID properties + childWindowPid <- getProp32s "_NET_WM_PID" childWindow + parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow + case (parentWindowPid, childWindowPid) of + (Just (parentPid : _), Just (childPid : _)) -> do + -- check if the new window is a child process of the last focused window + -- using the process ids. + isChild <- liftIO $ fi childPid `isChildOf` fi parentPid + when isChild $ do + action parentWindow + _ -> return () + return () + +-- | handleEventHook that will merge child windows via +-- "XMonad.Layouts.SubLayouts" when they are opened from another window. +swallowEventHookSub + :: Query Bool -- ^ query the parent window has to match for window swallowing to occur. + -- Set this to @return True@ to run swallowing for every parent. + -> Query Bool -- ^ query the child window has to match for window swallowing to occur. + -- Set this to @return True@ to run swallowing for every child + -> Event -- ^ The event to handle. + -> X All +swallowEventHookSub parentQ childQ event = + All True <$ case event of + MapRequestEvent{ev_window=childWindow} -> + handleMapRequestEvent parentQ childQ childWindow $ \parentWindow -> do + manage childWindow + sendMessage (Merge parentWindow childWindow) + _ -> pure () -- | handleEventHook that will swallow child windows when they are -- opened from another window. @@ -73,41 +122,18 @@ swallowEventHook -- Set this to @return True@ to run swallowing for every child -> Event -- ^ The event to handle. -> X All -swallowEventHook parentQueries childQueries event = do +swallowEventHook parentQ childQ event = do case event of - -- This is called right before a window gets opened. We intercept that - -- call to possibly open the window ourselves, swapping out - -- it's parent processes window for the new window in the stack. - MapRequestEvent { ev_window = childWindow } -> - -- For a window to be opened from within another window, that other window - -- must be focused. Thus the parent window that would be swallowed has to be - -- the currently focused window. - withFocused $ \parentWindow -> do - -- First verify that both windows match the given queries - parentMatches <- runQuery parentQueries parentWindow - childMatches <- runQuery childQueries childWindow - when (parentMatches && childMatches) $ do - -- read the windows _NET_WM_PID properties - childWindowPid <- getProp32s "_NET_WM_PID" childWindow - parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow - case (parentWindowPid, childWindowPid) of - (Just (parentPid : _), Just (childPid : _)) -> do - -- check if the new window is a child process of the last focused window - -- using the process ids. - isChild <- liftIO $ fi childPid `isChildOf` fi parentPid - when isChild $ do - -- We set the newly opened window as the focused window, replacing the parent window. - -- If the parent window was floating, we transfer that data to the child, - -- such that it shows up at the same position, with the same dimensions. - - windows - ( W.modify' (\x -> x { W.focus = childWindow }) - . moveFloatingState parentWindow childWindow - ) - XS.modify (addSwallowedParent parentWindow childWindow) - _ -> return () - return () - + MapRequestEvent{ev_window=childWindow} -> + handleMapRequestEvent parentQ childQ childWindow $ \parentWindow -> do + -- We set the newly opened window as the focused window, replacing the parent window. + -- If the parent window was floating, we transfer that data to the child, + -- such that it shows up at the same position, with the same dimensions. + windows + ( W.modify' (\x -> x { W.focus = childWindow }) + . moveFloatingState parentWindow childWindow + ) + XS.modify (addSwallowedParent parentWindow childWindow) -- This is called in many circumstances, most notably for us: -- right before a window gets closed. We store the current @@ -159,14 +185,12 @@ swallowEventHook parentQueries childQueries event = do _ -> return () return $ All True - -- | insert a window as focused into the current stack, moving the previously focused window down the stack insertIntoStack :: a -> W.StackSet i l a sid sd -> W.StackSet i l a sid sd insertIntoStack win = W.modify (Just $ W.Stack win [] []) (\s -> Just $ s { W.focus = win, W.down = W.focus s : W.down s }) - -- | run a pure transformation on the Stack of the currently focused workspace. updateCurrentStack :: (Maybe (W.Stack a) -> Maybe (W.Stack a)) @@ -191,7 +215,6 @@ moveFloatingState from to ws = ws (M.lookup from (W.floating ws)) } - -- | check if a given process is a child of another process. This depends on "pstree" being in the PATH -- NOTE: this does not work if the child process does any kind of process-sharing. isChildOf @@ -202,7 +225,6 @@ isChildOf child parent = do output <- runProcessWithInput "pstree" ["-T", "-p", show parent] "" return $ any (show child `isInfixOf`) $ lines output - data SwallowingState = SwallowingState { currentlySwallowed :: M.Map Window Window -- ^ mapping from child window window to the currently swallowed parent window