diff --git a/files/.xmonad/.stack-work/stack.sqlite3 b/files/.xmonad/.stack-work/stack.sqlite3 index 3314278..c22b932 100644 Binary files a/files/.xmonad/.stack-work/stack.sqlite3 and b/files/.xmonad/.stack-work/stack.sqlite3 differ diff --git a/files/.xmonad/lib/WindowSwallowing.hs b/files/.xmonad/lib/WindowSwallowing.hs index d377d9a..e31b896 100644 --- a/files/.xmonad/lib/WindowSwallowing.hs +++ b/files/.xmonad/lib/WindowSwallowing.hs @@ -12,26 +12,35 @@ import Data.Semigroup ( All(..) ) import qualified Data.Map.Strict as M import Data.List ( isInfixOf ) import Control.Monad ( when ) +import Control.Concurrent ( threadDelay ) + 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 - ) + ConfigureEvent{} -> do + withWindowSet + ( XS.modify + . setStackBeforeWindowClosing + . W.stack + . W.workspace + . W.current + ) + withWindowSet (XS.modify . setFloatingBeforeWindowClosing . W.floating) (DestroyWindowEvent _ _ _ _ eventId childWindow) -> when (eventId == childWindow) $ do - swallowedParent <- XS.gets (getSwallowedParent childWindow) - maybeOldStack <- XS.gets stackBeforeWindowClosing - case (swallowedParent, maybeOldStack) of + maybeSwallowedParent <- XS.gets (getSwallowedParent childWindow) + maybeOldStack <- XS.gets stackBeforeWindowClosing + oldFloating <- XS.gets floatingBeforeClosing + case (maybeSwallowedParent, maybeOldStack) of (Just parent, Just oldStack) -> do + liftIO $ threadDelay 100000 windows - ( updateStack (const $ Just $ oldStack { W.focus = parent }) - . onWorkspace "NSP" (W.delete' parent) + (\ws -> + updateStack (const $ Just $ oldStack { W.focus = parent }) + $ onWorkspace "NSP" (W.delete' parent) + $ copyFloatingState childWindow parent + $ ws { W.floating = oldFloating } ) XS.modify (removeSwallowed childWindow . setStackBeforeWindowClosing Nothing @@ -39,25 +48,26 @@ swallowEventHook parentQueries childQueries event = do _ -> 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 () + (MapRequestEvent _ _ _ _ _ childWindow) -> withFocused $ \parentWindow -> + do + parentMatches <- mapM (`runQuery` parentWindow) parentQueries + childMatches <- mapM (`runQuery` childWindow) childQueries + when (or parentMatches && or childMatches) $ do + childWindowPid <- getProp32s "_NET_WM_PID" childWindow + parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow + case (parentWindowPid, childWindowPid) of + (Just (parentPid : _), Just (childPid : _)) -> do + isChild <- liftIO $ fi childPid `isChildOf` fi parentPid + 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 = childWindow })) + . onWorkspace "NSP" (W.insertUp parentWindow) + . copyFloatingState parentWindow childWindow + ) + XS.modify (addSwallowedParent parentWindow childWindow) + _ -> return () + return () _ -> return () return $ All True where @@ -73,23 +83,39 @@ swallowEventHook parentQueries childQueries event = do } } - 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 +copyFloatingState + :: Ord a => a -> a -> 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)) + } + +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 + + +-- | check if a given process is a child of another process. +-- 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 + { 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 @@ -108,8 +134,16 @@ 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 = fromIntegral diff --git a/files/scripts/screengif.sh b/files/scripts/screengif.sh index 8b605f3..38acfd7 100755 --- a/files/scripts/screengif.sh +++ b/files/scripts/screengif.sh @@ -3,3 +3,4 @@ file="$HOME/Bilder/gifs/gif_$(date +%s).gif" giph -s -l -y -f 10 -c 1,1,1,0.3 -b 5 -p 5 "$file" echo "$file" | xclip -selection clipboard +thunar "$(dirname "$file")"