diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 2 | ||||
| -rw-r--r-- | src/Xmobar.hs | 78 | 
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) | 
