summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorMartin Perner <martin@perner.cc>2011-09-19 12:07:33 +0200
committerMartin Perner <martin@perner.cc>2011-09-19 12:07:33 +0200
commit1dabd20fb794567d3413f562e590fa5aa04144a0 (patch)
treef49a392b22363eeff2a0b5068032b4376cffbc11 /src
parent8833a8166387075d75ee15690a58cbd2aacf2a67 (diff)
downloadxmobar-1dabd20fb794567d3413f562e590fa5aa04144a0.tar.gz
xmobar-1dabd20fb794567d3413f562e590fa5aa04144a0.tar.bz2
Refactored eventLoop
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs2
-rw-r--r--src/Xmobar.hs78
2 files changed, 46 insertions, 34 deletions
diff --git a/src/Main.hs b/src/Main.hs
index e8efd61..364fa02 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -57,7 +57,7 @@ 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
+ startLoop (XConf 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 37fd653..fe46906 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -17,7 +17,7 @@ module Xmobar
( -- * Main Stuff
-- $main
X , XConf (..), runX
- , eventLoop
+ , startLoop
-- * Program Execution
-- $command
, startCommand
@@ -77,27 +77,16 @@ instance Exception WakeUp
data SignalType = Wakeup | Reposition | ChangeScreen
--- | The event loop
-eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO ()
-eventLoop xcfg@(XConf d _ w fs _) vs = do
+-- | Starts the main event loop and threads
+startLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO ()
+startLoop xcfg@(XConf _ _ w _ _) vs = do
tv <- atomically $ newTVar []
sig <- setupSignalHandler
- _ <- forkIO (checker tv [] sig `catch` \(SomeException _) -> putStrLn "Thread checker failed" >> return ())
+ _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> putStrLn "Thread checker failed" >> return ())
_ <- forkOS (eventer sig `catch` \(SomeException _) -> putStrLn "Thread eventer failed" >> return ())
- go tv xcfg sig
+ eventLoop tv xcfg sig
where
- -- interrupt the drawing thread every time a var is updated
- checker tvar ov signal = do
- nval <- atomically $ do
- nv <- mapM concatV vs
- guard (nv /= ov)
- writeTVar tvar nv
- return nv
- putMVar signal Wakeup
- checker tvar nval signal
-
- concatV = fmap concat . mapM (readTVar . snd)
-
+ -- Reacts on events from X
eventer signal =
alloca $ \ptrEventBase ->
alloca $ \ptrErrorBase ->
@@ -122,29 +111,52 @@ eventLoop xcfg@(XConf d _ w fs _) vs = do
when ( (fromIntegral (ev_event_type ev) - xrrEventBase) == 0)
$ putMVar signal Reposition
+-- | Send signal to eventLoop every time a var is updated
+checker :: TVar [String] -> [String] -> [[(Maybe ThreadId, TVar String)]] -> MVar SignalType -> IO ()
+checker tvar ov vs signal = do
+ nval <- atomically $ do
+ nv <- mapM concatV vs
+ guard (nv /= ov)
+ writeTVar tvar nv
+ return nv
+ putMVar signal Wakeup
+ checker tvar nval vs signal
+ where
+ concatV = fmap concat . mapM (readTVar . snd)
+
- -- Continuously wait for a timer interrupt or an expose event
- go tv xc@(XConf _ _ _ _ cfg) signal = do
+-- | Continuously wait for a signal from a thread or a interrupt handler
+eventLoop :: TVar [String] -> XConf -> MVar SignalType -> IO ()
+eventLoop tv xc@(XConf d _ w fs cfg) signal = do
typ <- takeMVar signal
case typ of
- Wakeup -> do
- runX xc (updateWin tv)
- go tv xc signal
- Reposition -> reposWindow cfg
- ChangeScreen ->
- case position cfg of
+ Wakeup -> do
+ runX xc (updateWin tv)
+ eventLoop tv xc signal
+
+ Reposition ->
+ reposWindow cfg
+
+ ChangeScreen -> do
+ ncfg <- updateConfigPosition cfg
+ reposWindow ncfg
+
+ where
+ reposWindow rcfg = do
+ r' <- repositionWin d w fs rcfg
+ eventLoop tv (XConf d r' w fs rcfg) signal
+
+ updateConfigPosition ocfg =
+ case position ocfg of
OnScreen n o -> do
srs <- getScreenInfo d
if n == length srs then
- reposWindow (cfg {position = OnScreen 1 o})
+ return (ocfg {position = OnScreen 1 o})
else
- reposWindow (cfg {position = OnScreen (n+1) o})
+ return (ocfg {position = OnScreen (n+1) o})
o ->
- reposWindow (cfg {position = OnScreen 1 o})
- where
- reposWindow rcfg = do
- r' <- repositionWin d w fs rcfg
- go tv (XConf d r' w fs rcfg) signal
+ return (ocfg {position = OnScreen 1 o})
+
-- | Signal handling
setupSignalHandler :: IO (MVar SignalType)