diff options
| -rw-r--r-- | Main.hs | 3 | ||||
| -rw-r--r-- | Xmobar.hs | 52 | ||||
| -rw-r--r-- | xmobar.cabal | 3 |
3 files changed, 35 insertions, 23 deletions
@@ -37,7 +37,8 @@ main = cl <- parseTemplate config (template config) var <- execCommands config cl (d,w) <- createWin config - runXbar config var d w eventLoop + eventLoop config var d w + return () -- | Reads the configuration files or quits with an error readConfig :: FilePath -> IO Config @@ -20,7 +20,6 @@ module Xmobar (-- * Main Stuff , eventLoop , createWin , updateWin - , sendUpdateEvent -- * Printing -- $print , drawInWin @@ -39,14 +38,17 @@ module Xmobar (-- * Main Stuff , io ) where +import Prelude hiding (catch) import Graphics.X11.Xlib import Graphics.X11.Xlib.Misc import Graphics.X11.Xlib.Event -import Graphics.X11.Xlib.Extras import Control.Monad.State import Control.Monad.Reader import Control.Concurrent +import Control.Exception + +import System.Posix.Types (Fd(..)) import Config import Parsers @@ -75,16 +77,34 @@ runXbar c v d w (X f) = do runStateT (runReaderT f c) (XState d w v) return () +-- | A version of nextEvent that does not block in foreign calls. +nextEvent' :: Display -> XEventPtr -> IO () +nextEvent' d p = do + pend <- pending d + if pend /= 0 + then nextEvent d p + else do + threadWaitRead (Fd fd) + nextEvent' d p + where + fd = connectionNumber d + -- | The event loop -eventLoop :: Xbar () -eventLoop = - do c <- ask - s <- get - io $ forkOS $ sendUpdateEvent (display s) (window s) (refresh c) - io $ allocaXEvent $ \e -> - nextEvent (display s) e - updateWin - eventLoop +eventLoop :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> IO () +eventLoop c v d w = do + t <- forkIO (block go) + timer t + where + -- interrupt the drawing thread every so often + timer t = do + tenthSeconds (refresh c) + throwTo t (ErrorCall "Xmobar.eventLoop: yield") + timer t + -- Continuously wait for a timer interrupt or an expose event + go = do + runXbar c v d w updateWin + catch (unblock $ allocaXEvent $ nextEvent' d) (const $ return ()) + go -- | The function to create the initial window createWin :: Config -> IO (Display, Window) @@ -101,14 +121,6 @@ createWin config = mapWindow dpy win return (dpy,win) -sendUpdateEvent :: Display -> Window -> Int -> IO () -sendUpdateEvent dpy w d = - do tenthSeconds d - allocaXEvent $ \e -> do - setEventType e expose - sendEvent dpy w False noEventMask e - sync dpy False - updateWin :: Xbar () updateWin = do c <- ask @@ -190,7 +202,7 @@ execCommands c xs = mapM (execCommand c) xs execCommand :: Config -> (Runnable,String,String) -> IO (ThreadId, MVar String) execCommand c com = do var <- newMVar "Updating..." - h <- forkOS $ runCommandLoop var c com + h <- forkIO $ runCommandLoop var c com return (h,var) runCommandLoop :: MVar String -> Config -> (Runnable,String,String) -> IO () diff --git a/xmobar.cabal b/xmobar.cabal index 0202ab6..89d79c2 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -12,8 +12,7 @@ license: BSD3 license-file: LICENSE author: Andrea Rossato maintainer: andrea.rossato@unibz.it -build-depends: base>=2.0, X11>=1.2.1, mtl>=1.0, unix>=1.0, parsec>=2.0, filepath>=1.0, - X11-extras>=0.2 +build-depends: base>=2.0, X11>=1.2.1, mtl>=1.0, unix>=1.0, parsec>=2.0, filepath>=1.0 executable: xmobar main-is: Main.hs |