diff --git a/lib/WorkspaceMon.hs b/lib/WorkspaceMon.hs index c388361..82e5ae0 100644 --- a/lib/WorkspaceMon.hs +++ b/lib/WorkspaceMon.hs @@ -1,10 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module WorkspaceMon (fromList, runWorkspaceMon) where +module WorkspaceMon (M.fromList, runWorkspaceMon) where import SendXMsg -import Data.Map as M +import qualified Data.Map as M import Control.Concurrent import Control.Monad @@ -24,7 +24,9 @@ import System.Process (Pid) -- TOOD it would be really nice if the manner we used to match windows was -- the same as that in XMonad itself (eg with Query types) -type MatchTags = Map String String +type MatchTags = M.Map String String + +type WatchedPIDs = MVar [Pid] data WConf = WConf { display :: Display @@ -48,20 +50,21 @@ runWorkspaceMon :: MatchTags -> IO () runWorkspaceMon mts = do dpy <- openDisplay "" root <- rootWindow dpy $ defaultScreen dpy + curPIDs <- newMVar [] -- TODO this is ugly, use a mutable state monad -- listen only for substructure change events (which includes MapNotify) allocaSetWindowAttributes $ \a -> do set_event_mask a substructureNotifyMask changeWindowAttributes dpy root cWEventMask a let c = WConf { display = dpy, matchTags = mts } _ <- allocaXEvent $ \e -> - runW c $ forever $ handle =<< io (nextEvent dpy e >> getEvent e) + runW c $ forever $ handle curPIDs =<< io (nextEvent dpy e >> getEvent e) return () -handle :: Event -> W () +handle :: WatchedPIDs -> Event -> W () -- | assume this fires at least once when a new window is created (also could -- use CreateNotify but that is really noisy) -handle MapNotifyEvent { ev_window = w } = do +handle curPIDs MapNotifyEvent { ev_window = w } = do dpy <- asks display hint <- io $ getClassHint dpy w mts <- asks matchTags @@ -71,10 +74,11 @@ handle MapNotifyEvent { ev_window = w } = do pid <- getWindowProperty32 dpy a w case pid of -- ASSUMPTION windows will only have one PID at one time - Just [p] -> waitAndKill t $ fromIntegral p + Just [p] -> let p' = fromIntegral p + in withUniquePid curPIDs p' $ waitAndKill t p' _ -> return () -handle _ = return () +handle _ _ = return () waitAndKill :: String -> Pid -> IO () waitAndKill tag pid = waitUntilExit pidDir @@ -89,3 +93,13 @@ waitAndKill tag pid = waitUntilExit pidDir res <- doesDirectoryExist d if res then threadDelay 100000 >> waitUntilExit d else sendXMsg Workspace tag + +withUniquePid :: WatchedPIDs -> Pid -> IO () -> IO () +withUniquePid curPIDs pid f = do + pids <- readMVar curPIDs + if pid `elem` pids + then return () + else do + modifyMVar_ curPIDs (return . (pid:)) + f + modifyMVar_ curPIDs (return . filter (/=pid))