summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorMartin Perner <martin@perner.cc>2011-08-31 13:39:01 +0200
committerMartin Perner <martin@perner.cc>2011-08-31 13:39:01 +0200
commit4fe99635e87c4f2262a27bf91c1ab6c7e3ee0988 (patch)
tree8471221ba858fb805f0619b158cf5c13e8e1b030 /src
parente8f3d5f0e6898e0b48d709267d83b2d4c8c2869f (diff)
downloadxmobar-4fe99635e87c4f2262a27bf91c1ab6c7e3ee0988.tar.gz
xmobar-4fe99635e87c4f2262a27bf91c1ab6c7e3ee0988.tar.bz2
Working version
The last commit removed the exposure event which turned out to be a big problem. Although the bug still exists that not all xrandr events are received when normal events are enabled. To work around this problem a second display is created on which only the xrandr events are enabled. On an exposure event the eventqueue for this display is processed. The results are very good, in the worst case an exposure event must be triggered by the user on xmobar to update its position.
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs4
-rw-r--r--src/Xmobar.hs40
2 files changed, 31 insertions, 13 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 18e05e2..941a844 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -42,6 +42,7 @@ import Control.Monad (unless)
main :: IO ()
main = do
d <- openDisplay ""
+ d' <- openDisplay ""
args <- getArgs
(o,file) <- getOpts args
(c,defaultings) <- case file of
@@ -60,7 +61,8 @@ main = do
cls <- mapM (parseTemplate conf) (splitTemplate conf)
vars <- mapM (mapM startCommand) cls
(r,w) <- createWin d fs conf
- eventLoop (XConf d r w fs conf) vars
+ _ <- enableXRandrEventListen d'
+ eventLoop (XConf d d' r w fs conf) vars
-- | Splits the template in its parts
splitTemplate :: Config -> [String]
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index 462de14..97d6990 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -23,7 +23,7 @@ module Xmobar
, startCommand
-- * Window Management
-- $window
- , createWin, updateWin
+ , createWin, updateWin, enableXRandrEventListen
-- * Printing
-- $print
, drawInWin, printStrings
@@ -60,6 +60,7 @@ type X = ReaderT XConf IO
-- | The ReaderT inner component
data XConf =
XConf { display :: Display
+ , xrrDspy :: Display -- display used for XRandr events
, rect :: Rectangle
, window :: Window
, fontS :: XFont
@@ -75,7 +76,7 @@ instance Exception WakeUp
-- | The event loop
eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO ()
-eventLoop xc@(XConf d _ w fs c) vs = block $ do
+eventLoop xc@(XConf d xrrD _ w fs c) vs = block $ do
tv <- atomically $ newTVar []
t <- myThreadId
ct <- forkIO (checker t tv [] `catch` \(SomeException _) -> return ())
@@ -101,16 +102,24 @@ eventLoop xc@(XConf d _ w fs c) vs = block $ do
go tv ct
-- event hanlder
- handle _ _ (ConfigureEvent {}) = return ()
+ handle _ ct (ConfigureEvent {}) = recreateWindow ct
- handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar)
+ handle tvar ct (ExposeEvent {}) = block $ do
+ -- check if there are XRandr events pending
+ num <- pending xrrD
+ if num == 0 then
+ -- if no pending events, make a update
+ runX xc (updateWin tvar)
+ else
+ recreateWindow ct
- -- this catches the RRScreenChangeNotify
- handle _ ct _ = block $ do
- killThread ct
- destroyWindow d w
- (r',w') <- createWin d fs c
- eventLoop (XConf d r' w' fs c) vs
+ handle _ _ _ = return ()
+
+ recreateWindow ct = do
+ killThread ct
+ destroyWindow d w
+ (r',w') <- createWin d fs c
+ eventLoop (XConf d xrrD r' w' fs c) vs
-- $command
@@ -129,6 +138,14 @@ startCommand (com,s,ss)
-- $window
+-- | The function to enable notifications from XRandr
+enableXRandrEventListen :: Display -> IO ()
+enableXRandrEventListen d = do
+ let dflt = defaultScreen d
+ rootw <- rootWindow d dflt
+ -- RRScreenChangeNotifyMask has the same value as keyPressMask
+ xrrSelectInput d rootw keyPressMask
+
-- | The function to create the initial window
createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
createWin d fs c = do
@@ -139,8 +156,7 @@ createWin d fs c = do
let ht = as + ds + 4
(r,o) = setPosition (position c) srs (fi ht)
win <- newWindow d (defaultScreenOfDisplay d) rootw r o
- -- RRScreenChangeNotifyMask has the same value as keyPressMask
- xrrSelectInput d rootw keyPressMask
+ selectInput d win (exposureMask .|. structureNotifyMask)
setProperties r c d win srs
when (lowerOnStart c) (lowerWindow d win)
mapWindow d win