From ba247afd0a0e3365c788c052b89a271c2d8d9bd9 Mon Sep 17 00:00:00 2001 From: Leon Kowarschick <5300871+elkowar@users.noreply.github.com> Date: Sat, 20 Jun 2020 13:59:17 +0200 Subject: [PATCH] Add XMonad.Hooks.WindowSwallowing --- CHANGES.md | 7 + XMonad/Doc/Extending.hs | 5 + XMonad/Hooks/WindowSwallowing.hs | 230 +++++++++++++++++++++++++++++++ xmonad-contrib.cabal | 1 + 4 files changed, 243 insertions(+) create mode 100644 XMonad/Hooks/WindowSwallowing.hs diff --git a/CHANGES.md b/CHANGES.md index 3a80b2c1..e2848bf4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -22,7 +22,14 @@ ### New Modules + * `XMonad.Hooks.WindowSwallowing` + + A handleEventHook that implements window swallowing: + Hide parent windows like terminals when opening other programs (like image viewers) from within them, + restoring them once the child application closes. + * `XMonad.Actions.TiledWindowDragging` + An action that allows you to change the position of windows by dragging them around. * `XMonad.Layout.ResizableThreeColumns` diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index b7b1b5df..a0afda32 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -572,6 +572,11 @@ Here is a list of the modules found in @XMonad.Hooks@: * "XMonad.Hooks.WorkspaceHistory": Keeps track of workspace viewing order. +* "XMonad.Hooks.WindowSwallowing" + A handleEventHook that implements window swallowing: + Hide parent windows like terminals when opening other programs (like image viewers) from within them, + restoring them once the child application closes. + * "XMonad.Hooks.XPropManage": A ManageHook matching on XProperties. diff --git a/XMonad/Hooks/WindowSwallowing.hs b/XMonad/Hooks/WindowSwallowing.hs new file mode 100644 index 00000000..a2eeb38c --- /dev/null +++ b/XMonad/Hooks/WindowSwallowing.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE NamedFieldPuns #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.WindowSwallowing +-- Copyright : (c) 2020 Leon Kowarschick +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Leon Kowarschick. +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a handleEventHook that implements window swallowing. +-- +-- If you open a GUI-window (i.e. feh) from the terminal, +-- the terminal will normally still be shown on screen, unnecessarily +-- taking up space on the screen. +-- With window swallowing, can detect that you opened a window from within another +-- window, and allows you "swallow" that parent window for the time the new +-- window is running. +-- +-- __NOTE__: This module depends on @pstree@ to analyze the process hierarchy, so make +-- sure that is on your @$PATH@. +-- +-- __NOTE__ that this does not always work perfectly: +-- +-- - Because window swallowing needs to check the process hierarchy, it requires +-- both the child and the parent to be distinct processes. This means that +-- applications which implement instance sharing cannot be supported by window swallowing. +-- Most notably, this excludes some terminal emulators as well as tmux +-- from functioning as the parent process. It also excludes a good amount of +-- child programs, because many graphical applications do implement instance sharing. +-- For example, window swallowing will probably not work with your browser. +-- +-- - To check the process hierarchy, we need to be able to get the process ID +-- by looking at the window. This requires the @_NET_WM_PID@ X-property to be set. +-- If any application you want to use this with does not provide the @_NET_WM_PID@, +-- there is not much you can do except for reaching out to the author of that +-- application and asking them to set that property. +----------------------------------------------------------------------------- +module XMonad.Hooks.WindowSwallowing + ( swallowEventHook + ) +where +import XMonad +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Util.Run ( runProcessWithInput ) +import XMonad.Util.WindowProperties +import Data.Semigroup ( All(..) ) +import qualified Data.Map.Strict as M +import Data.List ( isInfixOf ) +import Control.Monad ( when ) + +-- $usage +-- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@: +-- +-- > import XMonad.Hooks.WindowSwallowing +-- +-- and using 'swallowEventHook' somewhere in your 'handleEventHook', for example: +-- +-- > myHandleEventHook = swallowEventHook [className =? "Alacritty", className =? "Termite"] [return True] +-- +-- For more information on editing your handleEventHook and key bindings, +-- see "XMonad.Doc.Extending". + + +-- | handleEventHook that will swallow child windows when they are +-- opened from another window. +swallowEventHook + :: [Query Bool] -- ^ list of queries, at least one of which has to match + -- the parent process for window swallowing to occur. + -- Set this to @[return True]@ to run swallowing for every parent. + -> [Query Bool] -- ^ list of queries, at least one of which has to match + -- the child process for window swallowing to occur. + -- Set this to @[return True]@ to run swallowing for every child + -> Event -- ^ The event to handle. + -> X All +swallowEventHook parentQueries childQueries 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 <- or <$> mapM (`runQuery` parentWindow) parentQueries + childMatches <- or <$> mapM (`runQuery` childWindow) childQueries + 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 + (updateCurrentStack (fmap (\x -> x { W.focus = childWindow })) + . copyFloatingState parentWindow childWindow + ) + XS.modify (addSwallowedParent parentWindow childWindow) + _ -> return () + return () + + + -- This is called in many circumstances, most notably for us: + -- right before a window gets closed. We store the current + -- state of the window stack here, such that we know where the + -- child window was on the screen when restoring the swallowed parent process. + ConfigureEvent{} -> withWindowSet $ \ws -> do + XS.modify . setStackBeforeWindowClosing . currentStack $ ws + XS.modify . setFloatingBeforeWindowClosing . W.floating $ ws + + -- This is called right after any window closes. + DestroyWindowEvent { ev_event = eventId, ev_window = childWindow } -> + -- Because DestroyWindowEvent is emitted a lot more often then you think, + -- this check verifies that the event is /actually/ about closing a window. + when (eventId == childWindow) $ do + -- we get some data from the extensible state, most notably we ask for + -- the \"parent\" window of the now closed window. + maybeSwallowedParent <- XS.gets (getSwallowedParent childWindow) + maybeOldStack <- XS.gets stackBeforeWindowClosing + oldFloating <- XS.gets floatingBeforeClosing + case (maybeSwallowedParent, maybeOldStack) of + (Just parent, Just oldStack) -> do + -- If there actually is a corresponding swallowed parent window for this window, + -- we will restore and place it where the closed window was. + -- For this, we look at the stack-state that was stored /before/ the window was closed, + -- and replace the focused window with the now restored parent. + -- we do this to make sure the parent is restored in the exact position the child was at. + windows + (\ws -> + updateCurrentStack + (const $ Just $ oldStack { W.focus = parent }) + $ copyFloatingState childWindow parent + $ ws { W.floating = oldFloating } + ) + -- after restoring, we remove the information about the swallowing from the state. + XS.modify $ removeSwallowed childWindow + XS.modify $ setStackBeforeWindowClosing Nothing + _ -> return () + return () + _ -> return () + return $ All True + + +-- | run a pure transformation on the Stack of the currently focused workspace. +updateCurrentStack + :: (Maybe (W.Stack a) -> Maybe (W.Stack a)) + -> W.StackSet i l a sid sd + -> W.StackSet i l a sid sd +updateCurrentStack f ws = ws + { W.current = (W.current ws) + { W.workspace = currentWsp { W.stack = f $ currentStack ws } + } + } + where currentWsp = W.workspace $ W.current ws + +currentStack :: W.StackSet i l a sid sd -> Maybe (W.Stack a) +currentStack = W.stack . W.workspace . W.current + + +-- | copy the floating related state of one window to another window in a StackSet. +copyFloatingState + :: Ord a + => a -- ^ window to copy from + -> a -- ^ window to copy to + -> W.StackSet i l a s sd + -> W.StackSet i l a s sd +copyFloatingState from to ws = ws + { W.floating = maybe (M.delete to (W.floating ws)) + (\r -> M.insert to r (W.floating 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 + :: Int -- ^ child PID + -> Int -- ^ parent PID + -> IO Bool +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 + , stackBeforeWindowClosing :: Maybe (W.Stack Window) -- ^ current stack state right before DestroyWindowEvent is sent + , floatingBeforeClosing :: M.Map Window W.RationalRect -- ^ floating map of the stackset right before DestroyWindowEvent is sent + } deriving (Typeable, Show) + +getSwallowedParent :: Window -> SwallowingState -> Maybe Window +getSwallowedParent win SwallowingState { currentlySwallowed } = + M.lookup win currentlySwallowed + +addSwallowedParent :: Window -> Window -> SwallowingState -> SwallowingState +addSwallowedParent parent child s@SwallowingState { currentlySwallowed } = + s { currentlySwallowed = M.insert child parent currentlySwallowed } + +removeSwallowed :: Window -> SwallowingState -> SwallowingState +removeSwallowed child s@SwallowingState { currentlySwallowed } = + s { currentlySwallowed = M.delete child currentlySwallowed } + +setStackBeforeWindowClosing + :: Maybe (W.Stack Window) -> SwallowingState -> SwallowingState +setStackBeforeWindowClosing stack s = s { stackBeforeWindowClosing = stack } + +setFloatingBeforeWindowClosing + :: M.Map Window W.RationalRect -> SwallowingState -> SwallowingState +setFloatingBeforeWindowClosing x s = s { floatingBeforeClosing = x } + +instance ExtensionClass SwallowingState where + initialValue = SwallowingState { currentlySwallowed = mempty + , stackBeforeWindowClosing = Nothing + , floatingBeforeClosing = mempty + } + + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 81aa22e4..7aaef0fb 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -194,6 +194,7 @@ library XMonad.Hooks.WallpaperSetter XMonad.Hooks.WorkspaceByPos XMonad.Hooks.WorkspaceHistory + XMonad.Hooks.WindowSwallowing XMonad.Hooks.XPropManage XMonad.Layout.Accordion XMonad.Layout.AutoMaster