blob: d8c40fead7b45b5b7b3757313e1f62fe80a7e0cb (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
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
|
