From fc9754fd2cd5212dc6d99aa99299d43079afc976 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Wed, 25 Mar 2020 12:24:40 -0400 Subject: [PATCH] ADD workspace monitor --- bin/xmonad.hs | 2 ++ lib/WorkspaceMon.hs | 61 +++++++++++++++++++++++++++++++++++++++++++++ my-xmonad.cabal | 44 +++++++++++++++++--------------- 3 files changed, 87 insertions(+), 20 deletions(-) create mode 100644 lib/WorkspaceMon.hs diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 5fd0f05..fa47a89 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -8,6 +8,7 @@ import DBus.Client (Client) import Notify import SendXMsg import Shell +import WorkspaceMon import DBus.Common import DBus.IntelBacklight @@ -81,6 +82,7 @@ main = do dbClient <- startXMonadService (barPID, h) <- spawnPipe' "xmobar" _ <- forkIO runPowermon + _ <- forkIO runWorkspaceMon launch $ ewmh $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [barPID] dbClient) diff --git a/lib/WorkspaceMon.hs b/lib/WorkspaceMon.hs new file mode 100644 index 0000000..a5b74bd --- /dev/null +++ b/lib/WorkspaceMon.hs @@ -0,0 +1,61 @@ +module WorkspaceMon (runWorkspaceMon) where + +import Control.Concurrent +import Control.Monad + +import Graphics.X11.Types + +import Graphics.X11.Xlib.Atom +import Graphics.X11.Xlib.Display +import Graphics.X11.Xlib.Event +import Graphics.X11.Xlib.Extras +import Graphics.X11.Xlib.Misc +import Graphics.X11.Xlib.Types + +import System.Directory +import System.Process (Pid) + +runWorkspaceMon :: IO () +runWorkspaceMon = do + dpy <- openDisplay "" + root <- rootWindow dpy $ defaultScreen dpy + -- listen only for substructure change events (which includes MapNotify) + allocaSetWindowAttributes $ \a -> do + set_event_mask a substructureNotifyMask + changeWindowAttributes dpy root cWEventMask a + _ <- allocaXEvent $ \e -> + forever $ handle dpy =<< (nextEvent dpy e >> getEvent e) + return () + +handle :: Display -> Event -> IO () + +-- | assume this fires at least once when a new window is created (also could +-- use CreateNotify but that is really noisy) +handle dpy MapNotifyEvent { ev_window = w } = do + hint <- getClassHint dpy w + -- this will need to eventually accept a conditional argument that + -- we can change upon initialization + when (resName hint == "gimp") $ do + a <- internAtom dpy "_NET_WM_PID" False + pid <- getWindowProperty32 dpy a w + case pid of + -- ASSUMPTION windows will only have one PID at one time + Just [p] -> waitAndKill $ fromIntegral p + _ -> return () + +handle _ _ = return () + +waitAndKill :: Pid -> IO () +waitAndKill pid = waitUntilExit pidDir + where + pidDir = "/proc/" ++ show pid + waitUntilExit d = do + -- TODO this will not work if the process is a zombie (maybe I care...) + -- ASSUMPTION on linux PIDs will always increase until they overflow, in + -- which case they will start to recycle. Barring any fork bombs, this + -- code should work because we can reasonably expect that no processes + -- will spawn with the same PID within the delay limit + res <- doesDirectoryExist d + when res $ do + threadDelay 100000 + waitUntilExit d diff --git a/my-xmonad.cabal b/my-xmonad.cabal index acb507e..5eeb13d 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -10,6 +10,7 @@ library , Theme , Notify , Shell + , WorkspaceMon , DBus.Common , DBus.IntelBacklight , DBus.Internal @@ -18,45 +19,48 @@ library , Xmobar.Plugins.IntelBacklight , Xmobar.Plugins.Screensaver , Xmobar.Plugins.VPN - build-depends: base - , X11 >= 1.9.1 + build-depends: X11 >= 1.9.1 + , base + , bytestring >= 0.10.8.2 , colour >= 2.3.5 + , containers >= 0.6.0.1 + , dbus >= 1.2.7 + , fdo-notify + , io-streams >= 1.5.1.0 + , mtl >= 2.2.2 + , tcp-streams >= 1.0.1.1 + , text >= 1.2.3.1 + , directory >= 1.3.3.0 + , process >= 1.6.5.0 + , xmobar , xmonad >= 0.13 , xmonad-contrib >= 0.13 - , fdo-notify - , dbus >= 1.2.7 - , text >= 1.2.3.1 - , containers >= 0.6.0.1 - , tcp-streams >= 1.0.1.1 - , io-streams >= 1.5.1.0 - , bytestring >= 0.10.8.2 - , xmobar ghc-options: -Wall -Werror -fno-warn-missing-signatures default-language: Haskell2010 executable xmonad main-is: bin/xmonad.hs - build-depends: base + build-depends: X11 >= 1.9.1 + , base + , containers >= 0.6.0.1 + , dbus >= 1.2.7 + , directory >= 1.3.3.0 + , my-xmonad + , process >= 1.6.5.0 + , unix >= 2.7.2.2 , xmonad >= 0.13 , xmonad-contrib >= 0.13 , xmonad-extras >= 0.15.2 - , X11 >= 1.9.1 - , unix >= 2.7.2.2 - , process >= 1.6.5.0 - , directory >= 1.3.3.0 - , containers >= 0.6.0.1 - , dbus >= 1.2.7 - , my-xmonad default-language: Haskell2010 ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded executable xmobar main-is: bin/xmobar.hs build-depends: base - , xmonad >= 0.13 , dbus >= 1.2.7 - , xmobar , my-xmonad + , xmobar + , xmonad >= 0.13 default-language: Haskell2010 ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded