README and Cabal edits

Added some more credits, corrected typos, updated darcs version to 0.7,
changed name to Xmonbar and removed references to XMonad. Xmobar is now just
a minimalistic text based status bar for any kind of WM (the XMonad
community adopted the more advanced and stable dzen, after all ;-)

darcs-hash:20070714103913-d6583-b143dedf4ed5cbcb59b4f630ffce9afe82e32b86.gz

1 files changed, 0 insertions, 254 deletions

diff --git a/XMobar.hs b/XMobar.hs
deleted file mode 100644
index 7da3bd3..0000000
--- a/XMobar.hs
+++ /dev/null
@@ -1,254 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMobar
--- Copyright   :  (c) Andrea Rossato
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A status bar for the Xmonad Window Manager 
---
------------------------------------------------------------------------------
-
-module XMobar (-- * Main Stuff
-               -- $main
-               Xbar
-              , runXMobar
-              , eventLoop
-              , createWin
-              -- * Printing
-              -- $print
-              , drawInWin
-              , printStrings
-              -- * Program Execution
-              -- $commands
-              , execCommands
-              , execCommand
-              , runCommandLoop
-              , readVariables
-              -- * Unmamaged Windows
-              -- $unmanwin
-              , mkUnmanagedWindow
-              -- * Useful Utilities
-              , initColor
-              , io
-              ) where
-
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Misc
-
-import Control.Monad.State
-import Control.Monad.Reader
-import Control.Concurrent
-
-import Config
-import Parsers
-import Commands
-import Runnable
-
--- $main
---
--- The XMobar data type and basic loops and functions.
-
--- | This is just esthetics, stolen from XMonad: see 'runXMobar'
-newtype Xbar a = X (ReaderT Config (StateT XState IO) a)
-    deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader Config)
-
--- | The State component of StateT
-data XState = 
-    XState { display :: Display
-           , window :: Window
-           , vars :: [(ThreadId, MVar String)]
-           }
-
--- | Totally useless: but it is nice to be able to use get to get the
--- state and ask to get the configuration: functions requires less
--- arguments, after all.
-runXMobar :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> Xbar () -> IO ()
-runXMobar c v d w (X f) = 
-    do runStateT (runReaderT f c) (XState d w v)
-       return ()
-
--- | The event loop
-eventLoop :: Xbar ()
-eventLoop =
-    do c <- ask
-       s <- get
-       i <- io $ readVariables (vars s)
-       ps <- io $ parseString c i
-       drawInWin ps
-       -- back again: we are never ending
-       io $ tenthSeconds (refresh c)
-       eventLoop
-
--- | The function to create the initial window
-createWin :: Config -> IO (Display, Window)
-createWin config =
-  do dpy   <- openDisplay ""
-     let dflt = defaultScreen dpy
-     rootw  <- rootWindow dpy dflt
-     win <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw 
-            (fi $ xPos config) 
-            (fi $ yPos config) 
-            (fi $ width config) 
-            (fi $ height config)
-     mapWindow dpy win
-     return (dpy,win)
-
-
--- $print
-
--- | Draws in and updates the window
-drawInWin :: [(String, String)] -> Xbar ()
-drawInWin str = 
-    do config <- ask
-       st <- get
-       let (dpy,win) = (display st, window st)
-       bgcolor  <-  io $ initColor dpy $ bgColor config
-       gc <- io $ createGC dpy win
-       --let's get the fonts
-       fontst <-  io $ loadQueryFont dpy (font config)
-       io $ setFont dpy gc (fontFromFontStruct fontst)
-       -- create a pixmap to write to and fill it with a rectangle
-       p <- io $ createPixmap dpy win 
-            (fi (width config)) 
-            (fi (height config)) 
-            (defaultDepthOfScreen (defaultScreenOfDisplay dpy))
-       -- the fgcolor of the rectangle will be the bgcolor of the window
-       io $ setForeground dpy gc bgcolor
-       io $ fillRectangle dpy p gc 0 0 
-              (fi $ width config) 
-              (fi $ height config)
-       -- write to the pixmap the new string
-       let strWithLenth = map (\(s,c) -> (s,c,textWidth fontst s)) str
-       p' <- printStrings p gc fontst 1 strWithLenth 
-       -- copy the pixmap with the new string to the window
-       io $ copyArea dpy p' win gc 0 0 (fi (width config)) (fi (height config)) 0 0
-       -- free up everything (we do not want to leak memory!)
-       io $ freeFont dpy fontst
-       io $ freeGC dpy gc
-       io $ freePixmap dpy p'
-       -- resync
-       io $ sync dpy True
-
--- | An easy way to print the stuff we need to print
-printStrings :: Drawable 
-             -> GC
-             -> FontStruct
-             -> Position
-             -> [(String, String, Position)]
-             -> Xbar Pixmap
-printStrings p _ _ _ [] = return p
-printStrings p 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
-       fgcolor <- io $ initColor (display st) c
-       bgcolor <- io $ initColor (display st) (bgColor config)
-       io $ setForeground (display st) gc fgcolor
-       io $ setBackground (display st) gc bgcolor
-       io $ drawImageString (display st) p gc offset valign s
-       p' <- printStrings p gc fontst (offs + l) xs
-       return p'
-
--- $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 _ [] = return []
-execCommands c (x:xs) =
-    do i <- execCommand c x
-       is <- execCommands c xs
-       return $ i : is
-
-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
-
--- | Reads MVars set by 'runCommandLoop'
-readVariables :: [(ThreadId, MVar String)] -> IO String
-readVariables [] = return ""
-readVariables ((_,v):xs) =
-    do f <- readMVar v
-       fs <- readVariables xs
-       return $! f ++ fs
-
-{- $unmanwin
-
-This is a way to create unmamaged window. It was a mistery in Haskell. 
-Till I've found out...;-)
-
--}
-
--- | Creates a window with the attribute override_redirect set to True.
--- Windows Managers should not touch this kind of windows.
-mkUnmanagedWindow :: Display
-                  -> Screen
-                  -> Window
-                  -> Position
-                  -> Position
-                  -> Dimension
-                  -> Dimension
-                  -> IO Window
-mkUnmanagedWindow dpy scr rw x y w h = do
-  let visual = defaultVisualOfScreen scr
-      attrmask = cWOverrideRedirect
-  win <- allocaSetWindowAttributes $ 
-         \attributes -> do
-           set_override_redirect attributes True
-           createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) 
-                        inputOutput visual attrmask attributes                                
-  return win
-
-{- $utility
-Utilities, aka stollen without givin' credit stuff.
--}
-
--- | Get the Pixel value for a named color
-initColor :: Display -> String -> IO Pixel
-initColor dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c
-    where colormap = defaultColormap dpy (defaultScreen dpy)
-
--- | Short-hand for lifting in the IO monad
-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