mirror of
https://github.com/elkowar/dots-of-war.git
synced 2024-12-24 13:22:23 +00:00
cleanup a lot
This commit is contained in:
parent
29cdd20346
commit
eb6e7c0c7b
4 changed files with 118 additions and 70 deletions
Binary file not shown.
|
|
@ -23,7 +23,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
|||
import qualified Rofi
|
||||
import qualified DescribedSubmap
|
||||
import qualified TiledDragging
|
||||
import qualified GHC.Word
|
||||
import qualified WindowSwallowing
|
||||
|
||||
|
||||
import Data.Foldable ( for_ )
|
||||
|
|
@ -516,76 +516,8 @@ main = do
|
|||
-- }}}
|
||||
|
||||
|
||||
mySwallowEventHook = swallowEventHook ([className =? "Alacritty", className =? "Termite"]) ([return True])
|
||||
mySwallowEventHook = WindowSwallowing.swallowEventHook ([className =? "Alacritty", className =? "Termite"]) ([return True])
|
||||
|
||||
swallowEventHook :: [Query Bool] -> [Query Bool] -> Event -> X All
|
||||
swallowEventHook parentQueries childQueries event = do
|
||||
case event of
|
||||
ConfigureEvent {} -> withWindowSet (XS.modify . setStackBeforeWindowClosing . W.stack . W.workspace . W.current)
|
||||
(DestroyWindowEvent _ _ _ _ eventId childWindow) -> when (eventId == childWindow) $ do
|
||||
swallowedParent <- XS.gets (getSwallowedParent childWindow)
|
||||
maybeOldStack <- XS.gets stackBeforeWindowClosing
|
||||
case (swallowedParent, maybeOldStack) of
|
||||
(Just parent, Just oldStack) -> do
|
||||
windows (updateStack (const $ Just $ oldStack { W.focus = parent }) . onWorkspace "NSP" (W.delete' parent))
|
||||
XS.modify (removeSwallowed childWindow . setStackBeforeWindowClosing Nothing)
|
||||
_ -> return ()
|
||||
return ()
|
||||
|
||||
(MapRequestEvent _ _ _ _ _ newWindow) -> withFocused $ \focused -> do
|
||||
parentMatches <- mapM (`runQuery` focused) parentQueries
|
||||
childMatches <- mapM (`runQuery` newWindow) childQueries
|
||||
when (or parentMatches && or childMatches) $ do
|
||||
newWindowPid <- getProp32s "_NET_WM_PID" newWindow
|
||||
oldWindowPid <- getProp32s "_NET_WM_PID" focused
|
||||
case (oldWindowPid, newWindowPid) of
|
||||
(Just (oldPid:_), Just (newPid:_)) -> do
|
||||
isChild <- liftIO $ (fromIntegral newPid) `isChildOf` (fromIntegral oldPid)
|
||||
when isChild $ do
|
||||
-- TODO use https://hackage.haskell.org/package/xmonad-contrib-0.16/docs/XMonad-Layout-Hidden.html
|
||||
windows (updateStack (fmap (\x -> x { W.focus = newWindow })) . onWorkspace "NSP" (W.insertUp focused))
|
||||
XS.modify (addSwallowedParent focused newWindow)
|
||||
_ -> return ()
|
||||
return ()
|
||||
_ -> return ()
|
||||
return $ All True
|
||||
where
|
||||
updateStack f ws =
|
||||
ws { W.current = (W.current ws) { W.workspace = (W.workspace $ W.current $ ws) { W.stack = (f $ W.stack . W.workspace . W.current $ ws) } } }
|
||||
|
||||
onWorkspace :: (Eq i, Eq s) => i -> (W.StackSet i l a s sd -> W.StackSet i l a s sd) -> (W.StackSet i l a s sd -> W.StackSet i l a s sd)
|
||||
onWorkspace n f s = W.view (W.currentTag s) . f . W.view n $ s
|
||||
|
||||
isChildOf :: Int -> Int -> IO Bool
|
||||
isChildOf child parent = do
|
||||
output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""
|
||||
return $ any ((show child) `isInfixOf`) $ lines output
|
||||
|
||||
logOut :: [String] -> IO ()
|
||||
logOut x = catchAndNotifyAny (appendFile "/tmp/xmonad-event-out" ((intercalate " - " x) ++ "\n"))
|
||||
|
||||
|
||||
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
|
||||
} 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 }
|
||||
|
||||
|
||||
instance ExtensionClass SwallowingState where
|
||||
initialValue = SwallowingState {currentlySwallowed = mempty, stackBeforeWindowClosing = Nothing }
|
||||
|
||||
-- POLYBAR Kram -------------------------------------- {{{
|
||||
|
||||
|
|
|
|||
115
files/.xmonad/lib/WindowSwallowing.hs
Normal file
115
files/.xmonad/lib/WindowSwallowing.hs
Normal file
|
|
@ -0,0 +1,115 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module 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 )
|
||||
|
||||
swallowEventHook :: [Query Bool] -> [Query Bool] -> Event -> X All
|
||||
swallowEventHook parentQueries childQueries event = do
|
||||
case event of
|
||||
ConfigureEvent{} -> withWindowSet
|
||||
( XS.modify
|
||||
. setStackBeforeWindowClosing
|
||||
. W.stack
|
||||
. W.workspace
|
||||
. W.current
|
||||
)
|
||||
(DestroyWindowEvent _ _ _ _ eventId childWindow) ->
|
||||
when (eventId == childWindow) $ do
|
||||
swallowedParent <- XS.gets (getSwallowedParent childWindow)
|
||||
maybeOldStack <- XS.gets stackBeforeWindowClosing
|
||||
case (swallowedParent, maybeOldStack) of
|
||||
(Just parent, Just oldStack) -> do
|
||||
windows
|
||||
( updateStack (const $ Just $ oldStack { W.focus = parent })
|
||||
. onWorkspace "NSP" (W.delete' parent)
|
||||
)
|
||||
XS.modify
|
||||
(removeSwallowed childWindow . setStackBeforeWindowClosing Nothing
|
||||
)
|
||||
_ -> return ()
|
||||
return ()
|
||||
|
||||
(MapRequestEvent _ _ _ _ _ newWindow) -> withFocused $ \focused -> do
|
||||
parentMatches <- mapM (`runQuery` focused) parentQueries
|
||||
childMatches <- mapM (`runQuery` newWindow) childQueries
|
||||
when (or parentMatches && or childMatches) $ do
|
||||
newWindowPid <- getProp32s "_NET_WM_PID" newWindow
|
||||
oldWindowPid <- getProp32s "_NET_WM_PID" focused
|
||||
case (oldWindowPid, newWindowPid) of
|
||||
(Just (oldPid : _), Just (newPid : _)) -> do
|
||||
isChild <-
|
||||
liftIO $ fromIntegral newPid `isChildOf` fromIntegral oldPid
|
||||
when isChild $ do
|
||||
-- TODO use https://hackage.haskell.org/package/xmonad-contrib-0.16/docs/XMonad-Layout-Hidden.html
|
||||
windows
|
||||
( updateStack (fmap (\x -> x { W.focus = newWindow }))
|
||||
. onWorkspace "NSP" (W.insertUp focused)
|
||||
)
|
||||
XS.modify (addSwallowedParent focused newWindow)
|
||||
_ -> return ()
|
||||
return ()
|
||||
_ -> return ()
|
||||
return $ All True
|
||||
where
|
||||
updateStack f ws = ws
|
||||
{ W.current = (W.current ws)
|
||||
{ W.workspace = (W.workspace $ W.current ws)
|
||||
{ W.stack = f
|
||||
. W.stack
|
||||
. W.workspace
|
||||
. W.current
|
||||
$ ws
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
onWorkspace
|
||||
:: (Eq i, Eq s)
|
||||
=> i
|
||||
-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)
|
||||
-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)
|
||||
onWorkspace n f s = W.view (W.currentTag s) . f . W.view n $ s
|
||||
|
||||
isChildOf :: Int -> Int -> 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
|
||||
} 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 }
|
||||
|
||||
|
||||
instance ExtensionClass SwallowingState where
|
||||
initialValue = SwallowingState { currentlySwallowed = mempty
|
||||
, stackBeforeWindowClosing = Nothing
|
||||
}
|
||||
|
|
@ -11,6 +11,7 @@ executable my-xmonad
|
|||
Rofi
|
||||
DescribedSubmap
|
||||
TiledDragging
|
||||
WindowSwallowing
|
||||
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -threaded -fno-warn-missing-signatures
|
||||
|
|
|
|||
Loading…
Reference in a new issue