asdf

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
+    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)
+        maybeSwallowedParent <- XS.gets (getSwallowedParent childWindow)
         maybeOldStack        <- XS.gets stackBeforeWindowClosing
-        case (swallowedParent, maybeOldStack) of
+        oldFloating          <- XS.gets floatingBeforeClosing
+        case (maybeSwallowedParent, maybeOldStack) of
           (Just parent, Just oldStack) -> do
+            liftIO $ threadDelay 100000
             windows
-              ( updateStack (const $ Just $ oldStack { W.focus = parent })
+              (\ws ->
-              . onWorkspace "NSP" (W.delete' parent)
+                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,23 +48,24 @@ swallowEventHook parentQueries childQueries event = do
           _ -> return ()
         return ()
 
-    (MapRequestEvent _ _ _ _ _ newWindow) -> withFocused $ \focused -> do
+    (MapRequestEvent _ _ _ _ _ childWindow) -> withFocused $ \parentWindow ->
-      parentMatches <- mapM (`runQuery` focused) parentQueries
+      do
-      childMatches  <- mapM (`runQuery` newWindow) childQueries
+        parentMatches <- mapM (`runQuery` parentWindow) parentQueries
+        childMatches  <- mapM (`runQuery` childWindow) childQueries
         when (or parentMatches && or childMatches) $ do
-        newWindowPid <- getProp32s "_NET_WM_PID" newWindow
+          childWindowPid  <- getProp32s "_NET_WM_PID" childWindow
-        oldWindowPid <- getProp32s "_NET_WM_PID" focused
+          parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow
-        case (oldWindowPid, newWindowPid) of
+          case (parentWindowPid, childWindowPid) of
-          (Just (oldPid : _), Just (newPid : _)) -> do
+            (Just (parentPid : _), Just (childPid : _)) -> do
-            isChild <-
+              isChild <- liftIO $ fi childPid `isChildOf` fi parentPid
-              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 }))
+                  ( updateStack (fmap (\x -> x { W.focus = childWindow }))
-                . onWorkspace "NSP" (W.insertUp focused)
+                  . onWorkspace "NSP" (W.insertUp parentWindow)
+                  . copyFloatingState parentWindow childWindow
                   )
-              XS.modify (addSwallowedParent focused newWindow)
+                XS.modify (addSwallowedParent parentWindow childWindow)
             _ -> return ()
           return ()
     _ -> return ()
@@ -73,23 +83,39 @@ swallowEventHook parentQueries childQueries event = do
                     }
     }
 
-  onWorkspace
+
+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
+onWorkspace n f s = W.view (W.currentTag s) . f . W.view n $ s
 
-  isChildOf :: Int -> Int -> IO Bool
+
-  isChildOf child parent = do
+-- | 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
+    { 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
+    , 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

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")"