module XMonad.Hooks.DynamicBars {-# DEPRECATED "Use XMonad.Hooks.StatusBar instead" #-} (
DynamicStatusBar
, DynamicStatusBarCleanup
, DynamicStatusBarPartialCleanup
, dynStatusBarStartup
, dynStatusBarStartup'
, dynStatusBarEventHook
, dynStatusBarEventHook'
, multiPP
, multiPPFormat
) where
import Prelude
import Control.Monad.Trans (lift)
import Control.Monad.Writer (WriterT, execWriterT, tell)
import Graphics.X11.Xinerama
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xrandr
import System.IO
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog
import qualified XMonad.Util.ExtensibleState as XS
newtype DynStatusBarInfo = DynStatusBarInfo
{ DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo :: [(ScreenId, Handle)]
}
instance ExtensionClass DynStatusBarInfo where
initialValue :: DynStatusBarInfo
initialValue = [(ScreenId, Handle)] -> DynStatusBarInfo
DynStatusBarInfo []
type DynamicStatusBar = ScreenId -> IO Handle
type DynamicStatusBarCleanup = IO ()
type DynamicStatusBarPartialCleanup = ScreenId -> IO ()
dynStatusBarSetup :: X ()
dynStatusBarSetup :: X ()
dynStatusBarSetup = do
dpy <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
root <- asks theRoot
io $ xrrSelectInput dpy root rrScreenChangeNotifyMask
dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
dynStatusBarStartup :: DynamicStatusBar -> IO () -> X ()
dynStatusBarStartup DynamicStatusBar
sb IO ()
cleanup = do
X ()
dynStatusBarSetup
DynamicStatusBar -> IO () -> X ()
updateStatusBars DynamicStatusBar
sb IO ()
cleanup
dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
dynStatusBarStartup' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup = do
X ()
dynStatusBarSetup
DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup
dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
dynStatusBarEventHook :: DynamicStatusBar -> IO () -> Event -> X All
dynStatusBarEventHook DynamicStatusBar
sb IO ()
cleanup = X () -> Event -> X All
dynStatusBarRun (DynamicStatusBar -> IO () -> X ()
updateStatusBars DynamicStatusBar
sb IO ()
cleanup)
dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> Event -> X All
dynStatusBarEventHook' :: DynamicStatusBar
-> DynamicStatusBarPartialCleanup -> Event -> X All
dynStatusBarEventHook' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup = X () -> Event -> X All
dynStatusBarRun (DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup)
dynStatusBarRun :: X () -> Event -> X All
dynStatusBarRun :: X () -> Event -> X All
dynStatusBarRun X ()
action RRScreenChangeNotifyEvent{} = X ()
action X () -> X All -> X All
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
dynStatusBarRun X ()
_ Event
_ = All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
updateStatusBars :: DynamicStatusBar -> IO () -> X ()
updateStatusBars DynamicStatusBar
sb IO ()
cleanup = do
(dsbInfoScreens, dsbInfoHandles) <- X DynStatusBarInfo
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X DynStatusBarInfo
-> (DynStatusBarInfo -> ([ScreenId], [Handle]))
-> X ([ScreenId], [Handle])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(ScreenId, Handle)] -> ([ScreenId], [Handle])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ScreenId, Handle)] -> ([ScreenId], [Handle]))
-> (DynStatusBarInfo -> [(ScreenId, Handle)])
-> DynStatusBarInfo
-> ([ScreenId], [Handle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo
screens <- getScreens
when (screens /= dsbInfoScreens) $ do
newHandles <- liftIO $ do
hClose `mapM_` dsbInfoHandles
cleanup
mapM sb screens
XS.put $ DynStatusBarInfo (zip screens newHandles)
updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup = do
(dsbInfoScreens, dsbInfoHandles) <- X DynStatusBarInfo
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X DynStatusBarInfo
-> (DynStatusBarInfo -> ([ScreenId], [Handle]))
-> X ([ScreenId], [Handle])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([(ScreenId, Handle)] -> ([ScreenId], [Handle])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ScreenId, Handle)] -> ([ScreenId], [Handle]))
-> (DynStatusBarInfo -> [(ScreenId, Handle)])
-> DynStatusBarInfo
-> ([ScreenId], [Handle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo)
screens <- getScreens
when (screens /= dsbInfoScreens) $ do
let oldInfo = [ScreenId] -> [Handle] -> [(ScreenId, Handle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId]
dsbInfoScreens [Handle]
dsbInfoHandles
let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo
newInfo <- liftIO $ do
mapM_ (hClose . snd) infoToClose
mapM_ (cleanup . fst) infoToClose
let newScreens = [ScreenId]
screens [ScreenId] -> [ScreenId] -> [ScreenId]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ScreenId]
dsbInfoScreens
newHandles <- mapM sb newScreens
return $ zip newScreens newHandles
XS.put . DynStatusBarInfo $ infoToKeep ++ newInfo
multiPP :: PP
-> PP
-> X ()
multiPP :: PP -> PP -> X ()
multiPP = (PP -> X WorkspaceId) -> PP -> PP -> X ()
multiPPFormat PP -> X WorkspaceId
dynamicLogString
multiPPFormat :: (PP -> X String) -> PP -> PP -> X ()
multiPPFormat :: (PP -> X WorkspaceId) -> PP -> PP -> X ()
multiPPFormat PP -> X WorkspaceId
dynlStr PP
focusPP PP
unfocusPP = do
(_, dsbInfoHandles) <- X DynStatusBarInfo
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X DynStatusBarInfo
-> (DynStatusBarInfo -> ([ScreenId], [Handle]))
-> X ([ScreenId], [Handle])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(ScreenId, Handle)] -> ([ScreenId], [Handle])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ScreenId, Handle)] -> ([ScreenId], [Handle]))
-> (DynStatusBarInfo -> [(ScreenId, Handle)])
-> DynStatusBarInfo
-> ([ScreenId], [Handle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo
multiPP' dynlStr focusPP unfocusPP dsbInfoHandles
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' :: (PP -> X WorkspaceId) -> PP -> PP -> [Handle] -> X ()
multiPP' PP -> X WorkspaceId
dynlStr PP
focusPP PP
unfocusPP [Handle]
handles = do
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
let pickPP :: WorkspaceId -> WriterT (Last XState) X String
pickPP WorkspaceId
ws = do
let isFoc :: Bool
isFoc = (WorkspaceId
ws WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
==) (WorkspaceId -> Bool)
-> (WindowSet -> WorkspaceId) -> WindowSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (WindowSet -> Workspace WorkspaceId (Layout Window) Window)
-> WindowSet
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window)
-> (WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet -> Bool) -> WindowSet -> Bool
forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
st
XState -> WriterT (Last XState) X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{ windowset = W.view ws $ windowset st }
out <- X WorkspaceId -> WriterT (Last XState) X WorkspaceId
forall (m :: * -> *) a. Monad m => m a -> WriterT (Last XState) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (X WorkspaceId -> WriterT (Last XState) X WorkspaceId)
-> X WorkspaceId -> WriterT (Last XState) X WorkspaceId
forall a b. (a -> b) -> a -> b
$ PP -> X WorkspaceId
dynlStr (PP -> X WorkspaceId) -> PP -> X WorkspaceId
forall a b. (a -> b) -> a -> b
$ if Bool
isFoc then PP
focusPP else PP
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)
getScreens :: MonadIO m => m [ScreenId]
getScreens :: forall (m :: * -> *). MonadIO m => m [ScreenId]
getScreens = IO [ScreenId] -> m [ScreenId]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ScreenId] -> m [ScreenId]) -> IO [ScreenId] -> m [ScreenId]
forall a b. (a -> b) -> a -> b
$ do
screens <- do
dpy <- WorkspaceId -> IO Display
openDisplay WorkspaceId
""
rects <- getScreenInfo dpy
closeDisplay dpy
return rects
let ids = [ScreenId] -> [Rectangle] -> [(ScreenId, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId
0 .. ] [Rectangle]
screens
return $ map fst ids