blob: aea01242b1b09f6a321f800695e24a8fa533334c (
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
|
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- 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.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 XMonad
import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog
import qualified XMonad.Util.ExtensibleState as XS
-- $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]
} deriving (Typeable)
instance ExtensionClass DynStatusBarInfo where
initialValue = DynStatusBarInfo [] []
type DynamicStatusBar = ScreenId -> IO Handle
type DynamicStatusBarCleanup = IO ()
dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
dynStatusBarStartup sb cleanup = do
liftIO $ do
dpy <- openDisplay ""
xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
closeDisplay dpy
updateStatusBars sb cleanup
dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = updateStatusBars sb cleanup >> return (All True)
dynStatusBarEventHook _ _ _ = return (All True)
updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
updateStatusBars sb cleanup = do
dsbInfo <- XS.get
screens <- getScreens
when (screens /= dsbInfoScreens dsbInfo) $ do
newHandles <- liftIO $ do
hClose `mapM_` dsbInfoHandles dsbInfo
cleanup
mapM sb screens
XS.put $ DynStatusBarInfo screens newHandles
-----------------------------------------------------------------------------
-- 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 <- XS.get
multiPP' dynamicLogString focusPP unfocusPP (dsbInfoHandles dsbInfo)
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' dynlStr focusPP unfocusPP handles = do
st <- get
let pickPP :: WorkspaceId -> WriterT (Last XState) X String
pickPP ws = do
let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset st
put st{ windowset = W.view ws $ windowset st }
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 :: MonadIO m => m [ScreenId]
getScreens = liftIO $ do
screens <- do
dpy <- openDisplay ""
rects <- getScreenInfo dpy
closeDisplay dpy
return rects
let ids = zip [0 .. ] screens
return $ map fst ids
|
