Merge pull request #4 from mathstuf/dynamic-bars-partial-cleanup

X.H.DynamicBars: support per-monitor cleanup

XMonad/Hooks/DynamicBars.hs

@@ -18,8 +18,11 @@ module XMonad.Hooks.DynamicBars (
   -- $usage
     DynamicStatusBar
   , DynamicStatusBarCleanup
+  , DynamicStatusBarPartialCleanup
   , dynStatusBarStartup
+  , dynStatusBarStartup'
   , dynStatusBarEventHook
+  , dynStatusBarEventHook'
   , multiPP
   , multiPPFormat
   ) where
@@ -30,6 +33,7 @@ import Control.Monad
 import Control.Monad.Trans (lift)
 import Control.Monad.Writer (WriterT, execWriterT, tell)
 
+import Data.List
 import Data.Maybe
 import Data.Monoid
 import Data.Foldable (traverse_)
@@ -51,13 +55,25 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- dynamically responding to screen changes. A startup action, event hook, and
 -- a way to separate PP styles based on the screen's focus are provided:
 --
--- * The 'dynStatusBarStartup' hook which initializes the status bars.
+-- * The 'dynStatusBarStartup' hook which initializes the status bars. The
+-- first argument is an `ScreenId -> IO Handle` which spawns a status bar on the
+-- given screen and returns the pipe which the string should be written to.
+-- The second argument is a `IO ()` to shut down all status bars. This should
+-- be placed in your `startupHook`.
 --
 -- * The 'dynStatusBarEventHook' hook which respawns status bars when the
--- number of screens changes.
+-- number of screens changes. The arguments are the same as for the
+-- `dynStatusBarStartup` function. This should be placed in your
+-- `handleEventHook`.
+--
+-- * Each of the above functions have an alternate form
+-- (`dynStatusBarStartup'` and `dynStatusBarEventHook'`) which use a cleanup
+-- function which takes an additional `ScreenId` argument which allows for
+-- more fine-grained control for shutting down a specific screen's status bar.
 --
 -- * The 'multiPP' function which allows for different output based on whether
--- the screen for the status bar has focus.
+-- the screen for the status bar has focus (the first argument) or not (the
+-- second argument). This is for use in your `logHook`.
 --
 -- * The 'multiPPFormat' function is the same as the 'multiPP' function, but it
 -- also takes in a function that can customize the output to status bars.
@@ -69,37 +85,67 @@ import qualified XMonad.Util.ExtensibleState as XS
 --
 
 data DynStatusBarInfo = DynStatusBarInfo
-  { dsbInfoScreens :: [ScreenId]
-  , dsbInfoHandles :: [Handle]
+  { dsbInfo :: [(ScreenId, Handle)]
   } deriving (Typeable)
 
 instance ExtensionClass DynStatusBarInfo where
-  initialValue = DynStatusBarInfo [] []
+  initialValue = DynStatusBarInfo []
 
 type DynamicStatusBar = ScreenId -> IO Handle
 type DynamicStatusBarCleanup = IO ()
+type DynamicStatusBarPartialCleanup = ScreenId -> IO ()
 
-dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
-dynStatusBarStartup sb cleanup = do
+dynStatusBarSetup :: X ()
+dynStatusBarSetup = do
   dpy <- asks display
   root <- asks theRoot
   io $ xrrSelectInput dpy root rrScreenChangeNotifyMask
+
+dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
+dynStatusBarStartup sb cleanup = do
+  dynStatusBarSetup
   updateStatusBars sb cleanup
 
+dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
+dynStatusBarStartup' sb cleanup = do
+  dynStatusBarSetup
+  updateStatusBars' sb cleanup
+
 dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
-dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = updateStatusBars sb cleanup >> return (All True)
-dynStatusBarEventHook _  _       _                              = return (All True)
+dynStatusBarEventHook sb cleanup = dynStatusBarRun (updateStatusBars sb cleanup)
+
+dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> Event -> X All
+dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup)
+
+dynStatusBarRun :: X () -> Event -> X All
+dynStatusBarRun action (RRScreenChangeNotifyEvent {}) = action >> return (All True)
+dynStatusBarRun _      _                              = return (All True)
 
 updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
 updateStatusBars sb cleanup = do
-  dsbInfo <- XS.get
+  (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
   screens <- getScreens
-  when (screens /= dsbInfoScreens dsbInfo) $ do
+  when (screens /= dsbInfoScreens) $ do
       newHandles <- liftIO $ do
-          hClose `mapM_` dsbInfoHandles dsbInfo
+          hClose `mapM_` dsbInfoHandles
           cleanup
           mapM sb screens
-      XS.put $ DynStatusBarInfo screens newHandles
+      XS.put $ DynStatusBarInfo (zip screens newHandles)
+
+updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
+updateStatusBars' sb cleanup = do
+  (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
+  screens <- getScreens
+  when (screens /= dsbInfoScreens) $ do
+      let oldInfo = zip dsbInfoScreens dsbInfoHandles
+      let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo
+      newInfo <- liftIO $ do
+          mapM_ hClose $ map snd infoToClose
+          mapM_ cleanup $ map fst infoToClose
+          let newScreens = screens \\ dsbInfoScreens
+          newHandles <- mapM sb newScreens
+          return $ zip newScreens newHandles
+      XS.put . DynStatusBarInfo $ infoToKeep ++ newInfo
 
 -----------------------------------------------------------------------------
 -- The following code is from adamvo's xmonad.hs file.
@@ -112,8 +158,8 @@ multiPP = multiPPFormat dynamicLogString
 
 multiPPFormat :: (PP -> X String) -> PP -> PP -> X ()
 multiPPFormat dynlStr focusPP unfocusPP = do
-  dsbInfo <- XS.get
-  multiPP' dynlStr focusPP unfocusPP (dsbInfoHandles dsbInfo)
+  (_, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
+  multiPP' dynlStr focusPP unfocusPP dsbInfoHandles
 
 multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
 multiPP' dynlStr focusPP unfocusPP handles = do