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
-      ( XS.modify
+      withWindowSet
-      . setStackBeforeWindowClosing
+        ( XS.modify
-      . W.stack
+        . setStackBeforeWindowClosing
-      . W.workspace
+        . W.stack
-      . W.current
+        . 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
+        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,25 +48,26 @@ 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
-      when (or parentMatches && or childMatches) $ do
+        childMatches  <- mapM (`runQuery` childWindow) childQueries
-        newWindowPid <- getProp32s "_NET_WM_PID" newWindow
+        when (or parentMatches && or childMatches) $ do
-        oldWindowPid <- getProp32s "_NET_WM_PID" focused
+          childWindowPid  <- getProp32s "_NET_WM_PID" childWindow
-        case (oldWindowPid, newWindowPid) of
+          parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow
-          (Just (oldPid : _), Just (newPid : _)) -> do
+          case (parentWindowPid, childWindowPid) of
-            isChild <-
+            (Just (parentPid : _), Just (childPid : _)) -> do
-              liftIO $ fromIntegral newPid `isChildOf` fromIntegral oldPid
+              isChild <- liftIO $ fi childPid `isChildOf` fi parentPid
-            when isChild $ do
+              when isChild $ do
-              -- 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
+                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)
+                  )
-          _ -> return ()
+                XS.modify (addSwallowedParent parentWindow childWindow)
-        return ()
+            _ -> 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
+copyFloatingState
-  isChildOf child parent = do
+  :: Ord a => a -> a -> W.StackSet i l a s sd -> W.StackSet i l a s sd
-    output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""
+copyFloatingState from to ws = ws
-    return $ any (show child `isInfixOf`) $ lines output
+  { 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
+    { 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")"