diff --git a/XMonad/Hooks/StatusBar.hs b/XMonad/Hooks/StatusBar.hs index b22cef19..2a9276cc 100644 --- a/XMonad/Hooks/StatusBar.hs +++ b/XMonad/Hooks/StatusBar.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, TypeApplications #-} +{-# LANGUAGE FlexibleContexts, TypeApplications, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.StatusBar @@ -39,30 +39,33 @@ module XMonad.Hooks.StatusBar ( -- * Multiple Status Bars -- $multiple + -- * Dynamic Status Bars + -- $dynamic + dynamicSBs, + dynamicEasySBs, + -- * Property Logging utilities xmonadPropLog, xmonadPropLog', xmonadDefProp, - -- * Managing Status Bar Processes - spawnStatusBarAndRemember, - cleanupStatusBars, - - -- * Manual Plumbing - -- $plumbing + -- * Managing status bar Processes + -- $sbprocess + spawnStatusBar, + killStatusBar, + killAllStatusBars, ) where import Control.Exception (SomeException, try) import qualified Codec.Binary.UTF8.String as UTF8 (encode) +import qualified Data.Map as M import System.Posix.Signals (sigTERM, signalProcessGroup) import System.Posix.Types (ProcessID) -import qualified Data.Map as M - import Foreign.C (CChar) import XMonad -import XMonad.Prelude (void) +import XMonad.Prelude import XMonad.Util.Run import qualified XMonad.Util.ExtensibleState as XS @@ -70,6 +73,9 @@ import qualified XMonad.Util.ExtensibleState as XS import XMonad.Layout.LayoutModifier import XMonad.Hooks.ManageDocks import XMonad.Hooks.StatusBar.PP +import qualified XMonad.StackSet as W + +import Graphics.X11.Xrandr (xrrSelectInput) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -189,7 +195,7 @@ import XMonad.Hooks.StatusBar.PP -- chosen status bar from spawning again). Using 'statusBarProp', however, takes -- care of the necessary plumbing /and/ keeps track of the started status bars, so -- they can be correctly restarted with xmonad. This is achieved using --- 'spawnStatusBarAndRemember' to start them and 'cleanupStatusBars' to kill +-- 'spawnStatusBar' to start them and 'killStatusBar' to kill -- previously started bars. -- -- Even if you don't use a status bar, you can still use 'dynamicLogString' to @@ -297,8 +303,8 @@ statusBarPropTo :: String -- ^ Property to write the string to -> StatusBarConfig statusBarPropTo prop cmd pp = def { sbLogHook = xmonadPropLog' prop =<< dynamicLogString =<< pp - , sbStartupHook = spawnStatusBarAndRemember cmd - , sbCleanupHook = cleanupStatusBars + , sbStartupHook = spawnStatusBar cmd + , sbCleanupHook = killStatusBar cmd } -- | Like 'statusBarProp', but uses pipe-based logging instead. @@ -317,7 +323,7 @@ statusBarPipe cmd xpp = do -- Here's an example of what such declarative configuration of multiple status -- bars may look like: -- --- > -- Make sure to setup the xmobar config accordingly +-- > -- Make sure to setup the xmobar configs accordingly -- > xmobarTop = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top" (pure ppTop) -- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom) -- > xmobar1 = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1" (pure pp1) @@ -361,6 +367,105 @@ statusBarPipe cmd xpp = do -- -- By using the new interface, the config becomes more declarative and there's -- less room for errors. +-- +-- The only *problem* now is that the status bars will not be updated when your screen +-- configuration changes (by plugging in a monitor, for example). Check the section +-- on dynamic status bars for how to do that. + +-- $dynamic +-- Using multiple status bars by just combining them with '<>' works well +-- as long as the screen configuration does not change often. If it does, +-- you should use 'dynamicSBs': by providing a function that creates +-- status bars, it takes care of setting up the event hook, the log hook +-- and the startup hook necessary to make the status bars, well, dynamic. +-- +-- > xmobarTop = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top" (pure ppTop) +-- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom) +-- > xmobar1 = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1" (pure pp1) +-- > +-- > barSpawner :: ScreenId -> IO StatusBarConfig +-- > barSpawner 0 = pure $ xmobarTop <> xmobarBottom -- two bars on the main screen +-- > barSpawner 1 = pure $ xmobar1 +-- > barSpawner _ = mempty -- nothing on the rest of the screens +-- > +-- > main = xmonad $ dynamicSBs barSpawner (def { ... }) +-- +-- Make sure you specify which screen to place the status bar on (in xmobar, +-- this is achieved by the @-x@ argument). In addition to making sure that your +-- status bar lands where you intended it to land, the commands are used +-- internally to keep track of the status bars. +-- +-- Note also that this interface can be used with one screen, or if +-- the screen configuration doesn't change. + +newtype ActiveSBs = ASB {getASBs :: [(ScreenId, StatusBarConfig)]} + +instance ExtensionClass ActiveSBs where + initialValue = ASB [] + +-- | Given a function to create status bars, 'dynamicSBs' +-- adds the dynamic status bar capabilities to the config. +-- For a version of this function that applies 'docks' and +-- 'avoidStruts', check 'dynamicEasySBs'. +-- +-- Heavily inspired by "XMonad.Hooks.DynamicBars" +dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l +dynamicSBs f conf = conf + { startupHook = startupHook conf + >> setupEventHandler + >> killAllStatusBars + >> updateSBs f + , logHook = logHook conf >> logSBs + , handleEventHook = eventHookSBs f <> handleEventHook conf + } + +-- | Like 'dynamicSBs', but applies 'docks' to the +-- resulting config and adds 'avoidStruts' to the +-- layout. +dynamicEasySBs :: LayoutClass l Window + => (ScreenId -> IO StatusBarConfig) + -> XConfig l + -> XConfig (ModifiedLayout AvoidStruts l) +dynamicEasySBs f conf = + docks . dynamicSBs f $ conf { layoutHook = avoidStruts (layoutHook conf) } + +-- | Given the function to create status bars, update +-- the status bars by killing those that shouldn't be +-- visible anymore and creates any missing status bars +updateSBs :: (ScreenId -> IO StatusBarConfig) -> X () +updateSBs f = do + actualScreens <- withWindowSet $ return . map W.screen . W.screens + (toKeep, toKill) <- + partition ((`elem` actualScreens) . fst) . getASBs <$> XS.get + -- Kill the status bars + cleanSBs (map snd toKill) + -- Create new status bars if needed + let missing = actualScreens \\ map fst toKeep + added <- io $ traverse (\s -> (s,) <$> f s) missing + traverse_ (sbStartupHook . snd) added + XS.put (ASB (toKeep ++ added)) + +-- | Handles 'RRScreenChangeNotifyEvent' by updating the +-- status bars. +eventHookSBs :: (ScreenId -> IO StatusBarConfig) -> Event -> X All +eventHookSBs f RRScreenChangeNotifyEvent{} = updateSBs f >> return (All True) +eventHookSBs _ _ = return (All True) + +-- | Run 'sbLogHook' for the saved 'StatusBarConfig's +logSBs :: X () +logSBs = XS.get >>= traverse_ (sbLogHook . snd) . getASBs + +-- | Subscribe to the 'RRScreenChangeNotifyEvent' +setupEventHandler :: X () +setupEventHandler = do + dpy <- asks display + root <- asks theRoot + io $ xrrSelectInput dpy root rrScreenChangeNotifyMask + +-- | Kill the given 'StatusBarConfig's from the given +-- list +cleanSBs :: [StatusBarConfig] -> X () +cleanSBs = traverse_ sbCleanupHook -- | The default property xmonad writes to. (@_XMONAD_LOG@). xmonadDefProp :: String @@ -389,41 +494,49 @@ xmonadPropLog' prop msg = do -- This newtype wrapper, together with the ExtensionClass instance make use of -- the extensible state to save the PIDs bewteen xmonad restarts. -newtype StatusBarPIDs = StatusBarPIDs { getPIDs :: [ProcessID] } +newtype StatusBarPIDs = StatusBarPIDs { getPIDs :: M.Map String ProcessID } deriving (Show, Read) instance ExtensionClass StatusBarPIDs where - initialValue = StatusBarPIDs [] + initialValue = StatusBarPIDs mempty extensionType = PersistentExtension --- | Kills the status bars started with 'spawnStatusBarAndRemember', and resets --- the state. This could go for example at the beginning of the startupHook. +-- | Kills the status bar started with 'spawnStatusBar' using the given command +-- and resets the state. This could go for example at the beginning of the +-- startupHook, to kill the status bars that need to be restarted. -- -- Concretely, this function sends a 'sigTERM' to the saved PIDs using -- 'signalProcessGroup' to effectively terminate all processes, regardless --- of how many were started by using 'spawnStatusBarAndRemember'. +-- of how many were started by using 'spawnStatusBar'. -- -- There is one caveat to keep in mind: to keep the implementation simple; -- no checks are executed before terminating the processes. This means: if the -- started process dies for some reason, and enough time passes for the PIDs -- to wrap around, this function might terminate another process that happens -- to have the same PID. However, this isn't a typical usage scenario. -cleanupStatusBars :: X () -cleanupStatusBars = - getPIDs <$> XS.get - >>= (io . mapM_ killPid) - >> XS.put (StatusBarPIDs []) - where - killPid :: ProcessID -> IO () - killPid pidToKill = void $ try @SomeException (signalProcessGroup sigTERM pidToKill) +killStatusBar :: String -- ^ The command used to start the status bar + -> X () +killStatusBar cmd = do + XS.gets (M.lookup cmd . getPIDs) >>= flip whenJust (io . killPid) + XS.modify (StatusBarPIDs . M.delete cmd . getPIDs) --- | Spawns a status bar and saves its PID. This is useful when the status bars --- should be restarted with xmonad. Use this in combination with 'cleanupStatusBars'. +killPid :: ProcessID -> IO () +killPid pidToKill = void $ try @SomeException (signalProcessGroup sigTERM pidToKill) + +-- | Spawns a status bar and saves its PID together with the commands that was +-- used to start it. This is useful when the status bars should be restarted +-- with xmonad. Use this in combination with 'killStatusBar'. -- -- Note: in some systems, multiple processes might start, even though one command is -- provided. This means the first PID, of the group leader, is saved. -spawnStatusBarAndRemember :: String -- ^ The command used to spawn the status bar - -> X () -spawnStatusBarAndRemember cmd = do +spawnStatusBar :: String -- ^ The command used to spawn the status bar + -> X () +spawnStatusBar cmd = do newPid <- spawnPID cmd - XS.modify (StatusBarPIDs . (newPid :) . getPIDs) + XS.modify (StatusBarPIDs . M.insert cmd newPid . getPIDs) + +-- | Kill all status bars started with 'spawnStatusBar'. Note the +-- caveats in 'cleanupStatusBar' +killAllStatusBars :: X () +killAllStatusBars = + XS.gets (M.elems . getPIDs) >>= io . traverse_ killPid >> XS.put (StatusBarPIDs mempty)