mirror of
https://github.com/elkowar/dots-of-war.git
synced 2024-12-25 05:42:22 +00:00
asdf
This commit is contained in:
parent
0965527353
commit
ca0cd87b78
2 changed files with 38 additions and 11 deletions
Binary file not shown.
|
@ -14,6 +14,7 @@ import Control.Arrow ( (>>>) )
|
||||||
import Data.List ( isPrefixOf
|
import Data.List ( isPrefixOf
|
||||||
, isSuffixOf
|
, isSuffixOf
|
||||||
, isInfixOf
|
, isInfixOf
|
||||||
|
, intercalate
|
||||||
)
|
)
|
||||||
import qualified Foreign.C.Types
|
import qualified Foreign.C.Types
|
||||||
import System.Exit (exitSuccess)
|
import System.Exit (exitSuccess)
|
||||||
|
@ -313,7 +314,8 @@ myKeys = concat [ zoomRowBindings, tabbedBindings, multiMonitorBindings, program
|
||||||
--, ("M-b", launchWithBackgroundInstance (className =? "qutebrowser") "bwrap --bind / / --dev-bind /dev /dev --tmpfs /tmp --tmpfs /run qutebrowser")
|
--, ("M-b", launchWithBackgroundInstance (className =? "qutebrowser") "bwrap --bind / / --dev-bind /dev /dev --tmpfs /tmp --tmpfs /run qutebrowser")
|
||||||
--, ("M-b", safeSpawnProg "qutebrowser")
|
--, ("M-b", safeSpawnProg "qutebrowser")
|
||||||
, ("M-b", safeSpawnProg "firefox")
|
, ("M-b", safeSpawnProg "firefox")
|
||||||
, ("M-S-<Return>", launchWithBackgroundInstance (className =? "Alacritty") "alacritty")
|
, ("M-S-<Return>", spawn "alacritty")
|
||||||
|
--, ("M-S-<Return>", launchWithBackgroundInstance (className =? "Alacritty") "alacritty")
|
||||||
]
|
]
|
||||||
|
|
||||||
miscBindings :: [(String, X ())]
|
miscBindings :: [(String, X ())]
|
||||||
|
@ -518,13 +520,20 @@ mySwallowEventHook = swallowEventHook ([className =? "Alacritty", className =? "
|
||||||
swallowEventHook :: [Query Bool] -> [Query Bool] -> Event -> X All
|
swallowEventHook :: [Query Bool] -> [Query Bool] -> Event -> X All
|
||||||
swallowEventHook parentQueries childQueries event = do
|
swallowEventHook parentQueries childQueries event = do
|
||||||
case event of
|
case event of
|
||||||
(DestroyWindowEvent _ _ _ _ eventId window) ->
|
ConfigureEvent {} -> withWindowSet (XS.put . BeforeClosingStackStorage . W.stack . W.workspace . W.current)
|
||||||
when (eventId == window) $ do
|
(DestroyWindowEvent _ _ _ _ eventId window) -> when (eventId == window) $ do
|
||||||
(SwallowedStorage swallowed) <- XS.get
|
(SwallowedStorage swallowed) <- XS.get
|
||||||
case M.lookup window swallowed of
|
liftIO $ logOut [ show swallowed ]
|
||||||
Just win -> windows (\ws -> W.shiftWin (W.tag . W.workspace . W.current $ ws) (fromIntegral win) ws)
|
case M.lookup window swallowed of
|
||||||
Nothing -> return ()
|
Just win -> do
|
||||||
return ()
|
BeforeClosingStackStorage maybeOldStack <- XS.get
|
||||||
|
case maybeOldStack of
|
||||||
|
Just oldStack -> do
|
||||||
|
windows (\ws -> onWorkspace "NSP" (W.delete' win) ws |> updateStack (const $ Just $ oldStack { W.focus = win }))
|
||||||
|
XS.modify (\(SwallowedStorage m) -> SwallowedStorage $ M.delete window m)
|
||||||
|
Nothing -> return ()
|
||||||
|
Nothing -> return ()
|
||||||
|
return ()
|
||||||
|
|
||||||
(MapRequestEvent _ _ _ _ _ newWindow) -> withFocused $ \focused -> do
|
(MapRequestEvent _ _ _ _ _ newWindow) -> withFocused $ \focused -> do
|
||||||
parentMatches <- mapM (`runQuery` focused) parentQueries
|
parentMatches <- mapM (`runQuery` focused) parentQueries
|
||||||
|
@ -536,23 +545,42 @@ swallowEventHook parentQueries childQueries event = do
|
||||||
(Just (oldPid:_), Just (newPid:_)) -> do
|
(Just (oldPid:_), Just (newPid:_)) -> do
|
||||||
isChild <- liftIO $ (fromIntegral newPid) `isChildOf` (fromIntegral oldPid)
|
isChild <- liftIO $ (fromIntegral newPid) `isChildOf` (fromIntegral oldPid)
|
||||||
when isChild $ do
|
when isChild $ do
|
||||||
windows (W.shiftWin "NSP" focused) -- TODO use https://hackage.haskell.org/package/xmonad-contrib-0.16/docs/XMonad-Layout-Hidden.html
|
-- TODO use https://hackage.haskell.org/package/xmonad-contrib-0.16/docs/XMonad-Layout-Hidden.html
|
||||||
|
windows (\ws -> (onWorkspace "NSP" (W.insertUp focused) ws)
|
||||||
|
{ W.current = (W.current ws)
|
||||||
|
{ W.workspace = (W.workspace $ W.current ws)
|
||||||
|
{ W.stack = (fmap (\x -> x { W.focus = newWindow}) $ W.stack . W.workspace . W.current $ ws)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
})
|
||||||
XS.modify (\(SwallowedStorage m) -> SwallowedStorage $ M.insert newWindow focused m)
|
XS.modify (\(SwallowedStorage m) -> SwallowedStorage $ M.insert newWindow focused m)
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
return ()
|
return ()
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
return $ All True
|
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) } } }
|
||||||
|
|
||||||
|
|
||||||
isChildOf :: Int -> Int -> IO Bool
|
isChildOf :: Int -> Int -> IO Bool
|
||||||
isChildOf child parent = do
|
isChildOf child parent = do
|
||||||
output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""
|
output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""
|
||||||
return $ any ((show child) `isInfixOf`) $ lines output
|
return $ any ((show child) `isInfixOf`) $ lines output
|
||||||
|
|
||||||
|
logOut :: [String] -> IO ()
|
||||||
|
logOut x = catchAndNotifyAny (appendFile "/tmp/xmonad-event-out" ((intercalate " - " x) ++ "\n"))
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
newtype SwallowedStorage = SwallowedStorage (M.Map GHC.Word.Word64 GHC.Word.Word64) deriving Typeable
|
newtype SwallowedStorage = SwallowedStorage (M.Map GHC.Word.Word64 GHC.Word.Word64) deriving Typeable
|
||||||
instance ExtensionClass SwallowedStorage where
|
instance ExtensionClass SwallowedStorage where
|
||||||
initialValue = SwallowedStorage mempty
|
initialValue = SwallowedStorage mempty
|
||||||
|
|
||||||
|
newtype BeforeClosingStackStorage = BeforeClosingStackStorage (Maybe (W.Stack Window)) deriving (Typeable, Show)
|
||||||
|
instance ExtensionClass BeforeClosingStackStorage where
|
||||||
|
initialValue = BeforeClosingStackStorage Nothing
|
||||||
|
|
||||||
-- POLYBAR Kram -------------------------------------- {{{
|
-- POLYBAR Kram -------------------------------------- {{{
|
||||||
|
|
||||||
|
@ -615,7 +643,6 @@ dropEndWhile test xs = if test $ last xs then dropEndWhile test (init xs) else
|
||||||
catchAndNotifyAny :: IO () -> IO ()
|
catchAndNotifyAny :: IO () -> IO ()
|
||||||
catchAndNotifyAny ioAction = catch ioAction (\(e :: SomeException) -> notify "Xmonad exception" (show e))
|
catchAndNotifyAny ioAction = catch ioAction (\(e :: SomeException) -> notify "Xmonad exception" (show e))
|
||||||
|
|
||||||
|
|
||||||
getVisibleWorkspacesTagsOnMonitor :: ScreenId -> X [VirtualWorkspace]
|
getVisibleWorkspacesTagsOnMonitor :: ScreenId -> X [VirtualWorkspace]
|
||||||
getVisibleWorkspacesTagsOnMonitor monitor = do
|
getVisibleWorkspacesTagsOnMonitor monitor = do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
|
|
Loading…
Reference in a new issue