summaryrefslogtreecommitdiffhomepage
path: root/Xmobar.hs
diff options
context:
space:
mode:
authorAdam Vogt <vogt.adam@gmail.com>2009-10-11 03:56:18 +0200
committerAdam Vogt <vogt.adam@gmail.com>2009-10-11 03:56:18 +0200
commit638a9d5a9022e451e6eea4cc66eb1cf4d2d65f03 (patch)
tree4b604e4f9bbb7d9c34fc24f298f34dfbf3f47e4b /Xmobar.hs
parent1fd673d50d48ee3f7a4dc86eb6488cd26d976b4f (diff)
downloadxmobar-638a9d5a9022e451e6eea4cc66eb1cf4d2d65f03.tar.gz
xmobar-638a9d5a9022e451e6eea4cc66eb1cf4d2d65f03.tar.bz2
Support for base 4 without base-3 compatibility
Ignore-this: 6846a123ade5dc1164841e62beabbf71 darcs-hash:20091011015618-1499c-f91811df4a05f6e4d236faaa5f4b4050613253e1.gz
Diffstat (limited to 'Xmobar.hs')
-rw-r--r--Xmobar.hs16
1 files changed, 10 insertions, 6 deletions
diff --git a/Xmobar.hs b/Xmobar.hs
index 2380fd1..54daa06 100644
--- a/Xmobar.hs
+++ b/Xmobar.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : Xmobar
@@ -41,7 +42,7 @@ import Control.Exception hiding (handle)
import Data.Bits
import Data.Char
import Data.Maybe(fromMaybe)
-
+import Data.Typeable (Typeable)
import Config
import Parsers
@@ -69,12 +70,15 @@ data XConf =
runX :: XConf -> X () -> IO ()
runX xc f = runReaderT f xc
+data WakeUp = WakeUp deriving (Show,Typeable)
+instance Exception WakeUp
+
-- | The event loop
eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO ()
eventLoop xc@(XConf d _ w fs c) v = block $ do
tv <- atomically $ newTVar []
t <- myThreadId
- ct <- forkIO (checker t tv "" `catch` \_ -> return ())
+ ct <- forkIO (checker t tv "" `catch` \(SomeException _) -> return ())
go tv ct
where
-- interrupt the drawing thread every time a var is updated
@@ -84,14 +88,14 @@ eventLoop xc@(XConf d _ w fs c) v = block $ do
guard (nv /= ov)
writeTVar tvar nv
return nv
- throwDynTo t ()
+ throwTo t WakeUp
checker t tvar nval
-- Continuously wait for a timer interrupt or an expose event
go tv ct = do
- catchDyn (unblock $ allocaXEvent $ \e ->
- handle tv ct =<< (nextEvent' d e >> getEvent e))
- (\() -> runX xc (updateWin tv) >> return ())
+ catch (unblock $ allocaXEvent $ \e ->
+ handle tv ct =<< (nextEvent' d e >> getEvent e))
+ (\WakeUp -> runX xc (updateWin tv) >> return ())
go tv ct
-- event hanlder