Xmobas.hs: updated to reflect the API change - code formatting and cleanup

darcs-hash:20070927172951-d6583-33d153901fd86bba488997c0601af14b47e28e87.gz

1 files changed, 36 insertions, 59 deletions

diff --git a/Xmobar.hs b/Xmobar.hs
index 7e67647..fc6ab8d 100644
--- a/Xmobar.hs
+++ b/Xmobar.hs
@@ -26,9 +26,7 @@ module Xmobar (-- * Main Stuff
               , printStrings
               -- * Program Execution
               -- $commands
-              , execCommands
               , execCommand
-              , runCommandLoop
               , readVariables
               -- * Unmamaged Windows
               -- $unmanwin
@@ -66,13 +64,13 @@ newtype Xbar a = X (ReaderT Config (StateT XState IO) a)
 -- | The State component of StateT
 data XState = 
     XState { display :: Display
-           , window :: Window
-           , vars :: [(ThreadId, MVar String)]
+           , window  :: Window
+           , vars    :: [(Maybe ThreadId, MVar String)]
            }
 
 -- | We use get to get the state and ask to get the configuration: whis way 
 -- functions requires less arguments.
-runXbar :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> Xbar () -> IO ()
+runXbar :: Config -> [(Maybe ThreadId, MVar String)] -> Display -> Window -> Xbar () -> IO ()
 runXbar c v d w (X f) = 
     do runStateT (runReaderT f c) (XState d w v)
        return ()
@@ -90,7 +88,7 @@ nextEvent' d p = do
     fd = connectionNumber d
 
 -- | The event loop
-eventLoop :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> IO ()
+eventLoop :: Config -> [(Maybe ThreadId, MVar String)] -> Display -> Window -> IO ()
 eventLoop c v d w = do
     t <- forkIO (block go)
     timer t
@@ -111,21 +109,21 @@ createWin :: Config -> IO (Display, Window)
 createWin config =
   do dpy   <- openDisplay ""
      let dflt = defaultScreen dpy
-     rootw  <- rootWindow dpy dflt
-     win <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw 
+     rootw <- rootWindow dpy dflt
+     win   <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw 
             (fi $ xPos config) 
             (fi $ yPos config) 
             (fi $ width config) 
             (fi $ height config)
      selectInput dpy win exposureMask
-     mapWindow dpy win
+     mapWindow   dpy win
      return (dpy,win)
 
 updateWin :: Xbar ()
 updateWin =
-    do c <- ask
-       s <- get
-       i <- io $ readVariables (vars s)
+    do c  <- ask
+       s  <- get
+       i  <- io $ readVariables (vars s)
        ps <- io $ parseString c i
        drawInWin ps
 
@@ -134,14 +132,14 @@ updateWin =
 -- | Draws in and updates the window
 drawInWin :: [(String, String)] -> Xbar ()
 drawInWin str = 
-    do config <- ask
-       st <- get
+    do config  <- ask
+       st      <- get
        let (dpy,win) = (display st, window st)
-       bgcolor  <-  io $ initColor dpy $ bgColor config
-       gc <- io $ createGC dpy win
+       bgcolor <-  io $ initColor dpy $ bgColor config
+       gc      <- io $ createGC dpy win
        --let's get the fonts
        let lf c = loadQueryFont dpy (font c)
-       fontst <-  io $ catch (lf config) (const $ lf defaultConfig)
+       fontst  <-  io $ catch (lf config) (const $ lf defaultConfig)
        io $ setFont dpy gc (fontFromFontStruct fontst)
        -- create a pixmap to write to and fill it with a rectangle
        p <- io $ createPixmap dpy win 
@@ -177,14 +175,14 @@ printStrings d gc fontst offs sl@((s,c,l):xs) =
     do config <- ask
        st <- get
        let (_,asc,_,_) = textExtents fontst s
-           totSLen = foldr (\(_,_,len) -> (+) len) 0 sl
-           valign = (fi (height config) + fi asc) `div` 2
-           remWidth = fi (width config) - fi totSLen
-           offset = case (align config) of
-                      "center" -> (remWidth + offs) `div` 2
-                      "right" -> remWidth - 1
-                      "left" -> offs
-                      _ -> offs
+           totSLen     = foldr (\(_,_,len) -> (+) len) 0 sl
+           valign      = (fi (height config) + fi asc) `div` 2
+           remWidth    = fi (width config) - fi totSLen
+           offset      = case (align config) of
+                           "center" -> (remWidth + offs) `div` 2
+                           "right"  -> remWidth - 1
+                           "left"   -> offs
+                           _        -> offs
        fgcolor <- io $ initColor (display st) c
        bgcolor <- io $ initColor (display st) (bgColor config)
        io $ setForeground (display st) gc fgcolor
@@ -194,34 +192,23 @@ printStrings d gc fontst offs sl@((s,c,l):xs) =
 
 -- $commands
 
--- | Runs a list of programs as independent threads and returns their thread id
--- and the MVar they will be writing to.
-execCommands :: Config -> [(Runnable,String,String)] -> IO [(ThreadId, MVar String)]
-execCommands c xs = mapM (execCommand c) xs
-
-execCommand :: Config -> (Runnable,String,String) -> IO (ThreadId, MVar String)
-execCommand c com = 
-    do var <- newMVar "Updating..."
-       h <- forkIO $ runCommandLoop var c com
-       return (h,var)
-
-runCommandLoop :: MVar String -> Config -> (Runnable,String,String) -> IO ()
-runCommandLoop var conf c@(com,s,ss)
-    | alias com == "" = 
-        do modifyMVar_ var (\_ -> return $ "Could not parse the template")
-           tenthSeconds (refresh conf)
-           runCommandLoop var conf c
-    | otherwise =
-        do str <- run com
-           modifyMVar_ var (\_ -> return $ s ++ str ++ ss)
-           tenthSeconds (rate com) 
-           runCommandLoop var conf c
+-- | Runs a command as an independent thread and returns its thread id
+-- and the MVar the command will be writing to.
+execCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, MVar String)
+execCommand (com,s,ss)
+    | alias com == ""  = do var <- newMVar "Updating..."
+                            modifyMVar_ var (const $ return $ "Could not parse the template")
+                            return (Nothing,var)
+    | otherwise        = do var <- newMVar "Updating..."
+                            let cb str = modifyMVar_ var (\_ -> return $ s ++ str ++ ss)
+                            h <- forkIO $ start com cb
+                            return (Just h,var)
 
 -- | Reads MVars set by 'runCommandLoop'
-readVariables :: [(ThreadId, MVar String)] -> IO String
+readVariables :: [(Maybe ThreadId, MVar String)] -> IO String
 readVariables [] = return ""
 readVariables ((_,v):xs) =
-    do f <- readMVar v
+    do f  <- readMVar v
        fs <- readVariables xs
        return $! f ++ fs
 
@@ -270,16 +257,6 @@ initColor' dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c
 io :: IO a -> Xbar a
 io = liftIO
 
--- | Work arount to the Int max bound: since threadDelay takes an Int, it
--- is not possible to set a thread delay grater than about 45 minutes.
--- With a little recursion we solve the problem.
-tenthSeconds :: Int -> IO ()
-tenthSeconds s | s >= x = do threadDelay y
-                             tenthSeconds (x - s)
-               | otherwise = threadDelay (s * 100000)
-               where y = (maxBound :: Int)
-                     x = y `div` 100000
-
 -- | Short-hand for 'fromIntegral'
 fi :: (Integral a, Num b) => a -> b
 fi = fromIntegral