aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Hooks
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--XMonad/Hooks/DynamicBars.hs136
1 files changed, 136 insertions, 0 deletions
diff --git a/XMonad/Hooks/DynamicBars.hs b/XMonad/Hooks/DynamicBars.hs
new file mode 100644
index 0000000..d8c40fe
--- /dev/null
+++ b/XMonad/Hooks/DynamicBars.hs
@@ -0,0 +1,136 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Hooks.DynamicBars
+-- Copyright : (c) Ben Boeckel 2012
+-- License : BSD-style (as xmonad)
+--
+-- Maintainer : mathstuf@gmail.com
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Manage per-screen status bars.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DynamicBars (
+ -- * Usage
+ -- $usage
+ DynamicStatusBar
+ , DynamicStatusBarCleanup
+ , dynStatusBarStartup
+ , dynStatusBarEventHook
+ , multiPP
+ ) where
+
+import Prelude
+
+import Control.Concurrent.MVar
+import Control.Monad
+import Control.Monad.Trans (lift)
+import Control.Monad.Writer (WriterT, execWriterT, tell)
+
+import Data.Maybe
+import Data.Monoid
+import Data.Traversable (traverse)
+
+import Graphics.X11.Xinerama
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xrandr
+
+import System.IO
+import System.IO.Unsafe
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Hooks.DynamicLog
+
+-- $usage
+-- Provides a few helper functions to manage per-screen status bars while
+-- 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 'dynStatusBarEventHook' hook which respawns status bars when the
+-- number of screens changes.
+--
+-- * The 'multiPP' function which allows for different output based on whether
+-- the screen for the status bar has focus.
+--
+-- The hooks take a 'DynamicStatusBar' function which is given the id of the
+-- screen to start up and returns the 'Handle' to the pipe to write to. The
+-- 'DynamicStatusBarCleanup' argument should tear down previous instances. It
+-- is called when the number of screens changes and on startup.
+--
+
+data DynStatusBarInfo = DynStatusBarInfo
+ { dsbInfoScreens :: [ScreenId]
+ , dsbInfoHandles :: [Handle]
+ }
+
+type DynamicStatusBar = ScreenId -> IO Handle
+type DynamicStatusBarCleanup = IO ()
+
+-- Global state
+statusBarInfo :: MVar DynStatusBarInfo
+statusBarInfo = unsafePerformIO $ newMVar (DynStatusBarInfo [] [])
+
+dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
+dynStatusBarStartup sb cleanup = liftIO $ do
+ dpy <- openDisplay ""
+ xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
+ closeDisplay dpy
+ updateStatusBars sb cleanup
+
+dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
+dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = liftIO (updateStatusBars sb cleanup) >> return (All True)
+dynStatusBarEventHook _ _ _ = return (All True)
+
+updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> IO ()
+updateStatusBars sb cleanup = liftIO $ do
+ dsbInfo <- takeMVar statusBarInfo
+ screens <- getScreens
+ if (screens /= (dsbInfoScreens dsbInfo))
+ then do
+ mapM hClose (dsbInfoHandles dsbInfo)
+ cleanup
+ newHandles <- mapM sb screens
+ putMVar statusBarInfo (DynStatusBarInfo screens newHandles)
+ else putMVar statusBarInfo dsbInfo
+
+-----------------------------------------------------------------------------
+-- The following code is from adamvo's xmonad.hs file.
+-- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs
+
+multiPP :: PP -- ^ The PP to use if the screen is focused
+ -> PP -- ^ The PP to use otherwise
+ -> X ()
+multiPP focusPP unfocusPP = do
+ dsbInfo <- liftIO $ readMVar statusBarInfo
+ multiPP' dynamicLogString focusPP unfocusPP (dsbInfoHandles dsbInfo)
+
+multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
+multiPP' dynlStr focusPP unfocusPP handles = do
+ state <- get
+ let pickPP :: WorkspaceId -> WriterT (Last XState) X String
+ pickPP ws = do
+ let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset state
+ put state{ windowset = W.view ws $ windowset state }
+ out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
+ when isFoc $ get >>= tell . Last . Just
+ return out
+ traverse put . getLast
+ =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
+ =<< mapM screenWorkspace (zipWith const [0 .. ] handles)
+ return ()
+
+getScreens :: IO [ScreenId]
+getScreens = do
+ screens <- do
+ dpy <- openDisplay ""
+ rects <- getScreenInfo dpy
+ closeDisplay dpy
+ return rects
+ let ids = zip [0 .. ] screens
+ return $ map fst ids