diff --git a/Commands.hs b/Commands.hs --- a/Commands.hs +++ b/Commands.hs @@ -19,38 +19,60 @@ module Commands where +import Control.Concurrent +import Data.Char import System.Process import System.Exit import System.IO (hClose, hGetLine) -class Exec e where - run :: e -> IO String - rate :: e -> Int +class Show e => Exec e where alias :: e -> String + alias e = takeWhile (not . isSpace) $ show e + rate :: e -> Int + rate _ = 10 + run :: e -> IO String + run _ = return "" + start :: e -> (String -> IO ()) -> IO () + start e cb = go + where go = do + run e >>= cb + tenthSeconds (rate e) >> go data Command = Com Program Args Alias Rate deriving (Show,Read,Eq) -type Args = [String] +type Args = [String] type Program = String -type Alias = String -type Rate = Int +type Alias = String +type Rate = Int instance Exec Command where - alias (Com p _ a _) | p /= "" = if a == "" then p else a - | otherwise = "" - rate (Com _ _ _ r) = r - run (Com prog args _ _) = do - (i,o,e,p) <- runInteractiveCommand (prog ++ concat (map (' ':) args)) - exit <- waitForProcess p - let closeHandles = do - hClose o - hClose i - hClose e - case exit of - ExitSuccess -> do - str <- hGetLine o - closeHandles - return str - _ -> do closeHandles - return $ "Could not execute command " ++ prog + alias (Com p _ a _) + | p /= "" = if a == "" then p else a + | otherwise = "" + start (Com prog args _ r) cb = do go + where go = do + (i,o,e,p) <- runInteractiveCommand (prog ++ concat (map (' ':) args)) + exit <- waitForProcess p + let closeHandles = do + hClose o + hClose i + hClose e + case exit of + ExitSuccess -> do + str <- hGetLine o + closeHandles + cb str + _ -> do closeHandles + cb $ "Could not execute command " ++ prog + tenthSeconds r >> go + +-- | 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 diff --git a/Config.hs b/Config.hs --- a/Config.hs +++ b/Config.hs @@ -15,6 +15,7 @@ module Config ( -- * Configuration -- $config Config (..) + , XPosition (..), Align (..) , defaultConfig , runnableTypes ) where @@ -22,43 +23,42 @@ import Commands import {-# SOURCE #-} Runnable import Plugins.Monitors +import Plugins.Date +import Plugins.PipeReader +import Plugins.StdinReader -- $config -- Configuration data type and default configuration -- | The configuration data type data Config = - Config { font :: String -- ^ Font - , bgColor :: String -- ^ Backgroud color - , fgColor :: String -- ^ Default font color - , xPos :: Int -- ^ x Window position (origin in the upper left corner) - , yPos :: Int -- ^ y Window position - , width :: Int -- ^ Window width - , height :: Int -- ^ Window height - , align :: String -- ^ text alignment - , refresh :: Int -- ^ Refresh rate in tenth of seconds + Config { font :: String -- ^ Font + , bgColor :: String -- ^ Backgroud color + , fgColor :: String -- ^ Default font color + , position :: XPosition -- ^ Top Bottom or Static , commands :: [Runnable] -- ^ For setting the command, the command argujments - -- and refresh rate for the programs to run (optional) - , sepChar :: String -- ^ The character to be used for indicating - -- commands in the output template (default '%') - , template :: String -- ^ The output template + -- and refresh rate for the programs to run (optional) + , sepChar :: String -- ^ The character to be used for indicating + -- commands in the output template (default '%') + , alignSep :: String -- ^ Separators for left, center and right text alignment + , template :: String -- ^ The output template } deriving (Read) +data XPosition = Top | TopW Align Int | Bottom | BottomW Align Int | Static {xpos, ypos, width, height :: Int} deriving ( Read, Eq ) + +data Align = L | R | C deriving ( Read, Eq ) + -- | The default configuration values defaultConfig :: Config defaultConfig = - Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , bgColor = "#000000" - , fgColor = "#BFBFBF" - , xPos = 0 - , yPos = 0 - , width = 1024 - , height = 15 - , align = "left" - , refresh = 10 + Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , bgColor = "#000000" + , fgColor = "#BFBFBF" + , position = Top , commands = [] - , sepChar = "%" - , template = "Uptime: %uptime% ** %date%" + , sepChar = "%" + , alignSep = "}{" + , template = "Uptime: %uptime% }{ %date%" } -- | This is the list of types that can be hidden inside @@ -67,5 +67,5 @@ -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types appearing in this function's type -- signature. -runnableTypes :: (Command,(Monitors,())) +runnableTypes :: (Command,(Monitors,(Date,(PipeReader,(StdinReader,()))))) runnableTypes = undefined diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -24,6 +24,7 @@ import Config import Data.IORef +import Graphics.X11.Xlib import System.Console.GetOpt import System.Exit import System.Environment @@ -33,77 +34,79 @@ -- | The main entry point main :: IO () -main = - do args <- getArgs - (o,file) <- getOpts args - conf <- case file of - [cfgfile] -> readConfig cfgfile - _ -> readDefaultConfig - c <- newIORef conf - doOpts c o - config <- readIORef c - cl <- parseTemplate config (template config) - var <- execCommands config cl - (d,w) <- createWin config - eventLoop config var d w - return () +main = do + d <- openDisplay "" + args <- getArgs + (o,file) <- getOpts args + c <- case file of + [cfgfile] -> readConfig cfgfile + _ -> readDefaultConfig + -- listen for ConfigureEvents on the root window, for xrandr support: + rootw <- rootWindow d (defaultScreen d) + selectInput d rootw structureNotifyMask + + civ <- newIORef c + doOpts civ o + conf <- readIORef civ + let loadFont = loadQueryFont d . font + fs <- catch (loadFont conf) (const $ loadFont defaultConfig) + cl <- parseTemplate conf (template conf) + vars <- mapM startCommand cl + (r,w) <- createWin d fs conf + eventLoop (XConf d r w fs conf) vars + freeFont d fs + -- | Reads the configuration files or quits with an error readConfig :: FilePath -> IO Config -readConfig f = - do file <- fileExist f - s <- if file then readFile f else error $ f ++ ": file not found!\n" ++ usage - case reads s of - [(config,_)] -> return config - [] -> error $ f ++ ": configuration file contains errors!\n" ++ usage - _ -> error ("Some problem occured. Aborting...") +readConfig f = do + file <- fileExist f + s <- if file then readFile f else error $ f ++ ": file not found!\n" ++ usage + case reads s of + [(conf,_)] -> return conf + [] -> error $ f ++ ": configuration file contains errors!\n" ++ usage + _ -> error ("Some problem occured. Aborting...") -- | Read default configuration file or load the default config readDefaultConfig :: IO Config -readDefaultConfig = - do home <- getEnv "HOME" - let path = home ++ "/.xmobarrc" - f <- fileExist path - if f then readConfig path else return defaultConfig +readDefaultConfig = do + home <- getEnv "HOME" + let path = home ++ "/.xmobarrc" + f <- fileExist path + if f then readConfig path else return defaultConfig data Opts = Help | Version - | Font String - | BgColor String - | FgColor String - | XPos String - | YPos String - | Width String - | Height String - | Align String - | Refresh String + | Font String + | BgColor String + | FgColor String + | T + | B + | AlignSep String | Commands String - | SepChar String + | SepChar String | Template String deriving Show options :: [OptDescr Opts] options = - [ Option ['h','?'] ["help"] (NoArg Help) "This help" - , Option ['V'] ["version"] (NoArg Version) "Show version information" - , Option ['f'] ["font"] (ReqArg Font "font name") "The font name" - , Option ['B'] ["bgcolor"] (ReqArg BgColor "bg color") "The background color. Default black" - , Option ['F'] ["fgcolor"] (ReqArg FgColor "fg color") "The foreground color. Default grey" - , Option ['x'] ["xpos"] (ReqArg XPos "x pos") "The x position. Default 0" - , Option ['y'] ["ypos"] (ReqArg YPos "y pos") "The y position. Default 0" - , Option ['W'] ["width"] (ReqArg Width "width") "The status bar width. Default 1024" - , Option ['H'] ["height"] (ReqArg Height "height") "The status bar height. Default 15" - , Option ['a'] ["align"] (ReqArg Align "align") "The text alignment: center, left or right.\nDefault: left" - , Option ['r'] ["refresh"] (ReqArg Refresh "rate") "The refresh rate in tenth of seconds:\ndefault 1 sec." - , Option ['s'] ["sepchar"] (ReqArg SepChar "char") "The character used to separate commands in\nthe output template. Default '%'" - , Option ['t'] ["template"] (ReqArg Template "tempate") "The output template" - , Option ['c'] ["commands"] (ReqArg Commands "commands") "The list of commands to be executed" + [ Option ['h','?' ] ["help" ] (NoArg Help ) "This help" + , Option ['V' ] ["version" ] (NoArg Version ) "Show version information" + , Option ['f' ] ["font" ] (ReqArg Font "font name") "The font name" + , Option ['B' ] ["bgcolor" ] (ReqArg BgColor "bg color" ) "The background color. Default black" + , Option ['F' ] ["fgcolor" ] (ReqArg FgColor "fg color" ) "The foreground color. Default grey" + , Option ['o' ] ["top" ] (NoArg T ) "Place Xmobar at the top of the screen" + , Option ['b' ] ["bottom" ] (NoArg B ) "Place Xmobar at the bottom of the screen" + , Option ['a' ] ["alignsep" ] (ReqArg AlignSep "alignsep" ) "Separators for left, center and right text\nalignment. Default: '}{'" + , Option ['s' ] ["sepchar" ] (ReqArg SepChar "char" ) "The character used to separate commands in\nthe output template. Default '%'" + , Option ['t' ] ["template" ] (ReqArg Template "tempate" ) "The output template" + , Option ['c' ] ["commands" ] (ReqArg Commands "commands" ) "The list of commands to be executed" ] getOpts :: [String] -> IO ([Opts], [String]) getOpts argv = case getOpt Permute options argv of - (o,n,[]) -> return (o,n) + (o,n,[]) -> return (o,n) (_,_,errs) -> error (concat errs ++ usage) usage :: String @@ -112,7 +115,7 @@ footer = "\nMail bug reports and suggestions to " ++ mail version :: String -version = "Xmobar 0.7 (C) 2007 Andrea Rossato " ++ mail ++ license +version = "Xmobar 0.8 (C) 2007 Andrea Rossato " ++ mail ++ license mail :: String mail = "\n" @@ -127,30 +130,23 @@ doOpts _ [] = return () doOpts conf (o:oo) = case o of - Help -> putStr usage >> exitWith ExitSuccess - Version -> putStrLn version >> exitWith ExitSuccess - Font s -> modifyIORef conf (\c -> c { font = s }) >> go - BgColor s -> modifyIORef conf (\c -> c { bgColor = s }) >> go - FgColor s -> modifyIORef conf (\c -> c { fgColor = s }) >> go - XPos s -> modifyIORef conf (\c -> c { xPos = readInt s c xPos}) >> go - YPos s -> modifyIORef conf (\c -> c { yPos = readInt s c yPos }) >> go - Width s -> modifyIORef conf (\c -> c { width = readInt s c width }) >> go - Height s -> modifyIORef conf (\c -> c { height = readInt s c height }) >> go - Align s -> modifyIORef conf (\c -> c { align = s }) >> go - Refresh s -> modifyIORef conf (\c -> c { refresh = readInt s c refresh }) >> go - SepChar s -> modifyIORef conf (\c -> c { sepChar = s }) >> go - Template s -> modifyIORef conf (\c -> c { template = s }) >> go + Help -> putStr usage >> exitWith ExitSuccess + Version -> putStrLn version >> exitWith ExitSuccess + Font s -> modifyIORef conf (\c -> c { font = s }) >> go + BgColor s -> modifyIORef conf (\c -> c { bgColor = s }) >> go + FgColor s -> modifyIORef conf (\c -> c { fgColor = s }) >> go + T -> modifyIORef conf (\c -> c { position = Top }) >> go + B -> modifyIORef conf (\c -> c { position = Bottom}) >> go + AlignSep s -> modifyIORef conf (\c -> c { alignSep = s }) >> go + SepChar s -> modifyIORef conf (\c -> c { sepChar = s }) >> go + Template s -> modifyIORef conf (\c -> c { template = s }) >> go Commands s -> case readCom s of - Right x -> modifyIORef conf (\c -> c { commands = x })>> go - Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) + Right x -> modifyIORef conf (\c -> c { commands = x }) >> go + Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) where readCom str = case readStr str of [x] -> Right x - _ -> Left "xmobar: cannot read list of commands specified with the -c option\n" - readInt str c f = - case readStr str of - [x] -> x - _ -> f c + _ -> Left "xmobar: cannot read list of commands specified with the -c option\n" readStr str = [x | (x,t) <- reads str, ("","") <- lex t] go = doOpts conf oo diff --git a/Parsers.hs b/Parsers.hs --- a/Parsers.hs +++ b/Parsers.hs @@ -43,9 +43,9 @@ parseString :: Config -> String -> IO [(String, String)] parseString config s = case (parse (stringParser config) "" s) of - Left _ -> return [("Could not parse string: " ++ s - , (fgColor config))] - Right x -> return x + Left _ -> return [("Could not parse string: " ++ s + , (fgColor config))] + Right x -> return x -- | Gets the string and combines the needed parsers stringParser :: Config -> Parser [(String, String)] @@ -74,18 +74,14 @@ -- | Parses a color specification (hex or named) colorSpec :: Parser String colorSpec = - do { c <- char '#' - ; s <- count 6 hexDigit - ; return $ c:s - } - <|> many1 alphaNum + many1 (alphaNum <|> char ',' <|> char '#') -- | Parses the output template string templateStringParser :: Config -> Parser (String,String,String) templateStringParser c = - do{ s <- many $ noneOf (sepChar c) - ; (com,_,_) <- templateCommandParser c - ; ss <- many $ noneOf (sepChar c) + do{ s <- many $ noneOf (sepChar c) + ; (com,_,_) <- templateCommandParser c + ; ss <- many $ noneOf (sepChar c) ; return (com, s, ss) } @@ -107,10 +103,10 @@ parseTemplate :: Config -> String -> IO [(Runnable,String,String)] parseTemplate config s = do str <- case (parse (templateParser config) "" s) of - Left _ -> return [("","","")] - Right x -> return x + Left _ -> return [("","","")] + Right x -> return x let comList = map alias (commands config) - m = Map.fromList $ zip comList (commands config) + m = Map.fromList $ zip comList (commands config) return $ combine config m str -- | Given a finite "Map" and a parsed templatet produces the @@ -119,5 +115,5 @@ combine _ _ [] = [] combine config m ((ts,s,ss):xs) = [(com, s, ss)] ++ combine config m xs - where com = Map.findWithDefault dflt ts m - dflt = Run $ Com ts [] [] (refresh config) --"<" ++ ts ++ " not found!>" + where com = Map.findWithDefault dflt ts m + dflt = Run $ Com ts [] [] 10 diff --git a/Plugins.hs b/Plugins.hs --- a/Plugins.hs +++ b/Plugins.hs @@ -14,7 +14,8 @@ -- ----------------------------------------------------------------------------- -module Plugins ( Exec (..) +module Plugins ( Exec (..) + , tenthSeconds ) where import Commands diff --git a/Plugins/Date.hs b/Plugins/Date.hs new file mode 100644 --- /dev/null +++ b/Plugins/Date.hs @@ -0,0 +1,36 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Date +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A date plugin for Xmobar +-- +-- Usage example: in template put +-- Run Date "%a %b %_d %Y %H:%M:%S" "mydate" 10 +-- +----------------------------------------------------------------------------- + +module Plugins.Date where + +import Plugins + +import System.Locale +import System.Time + +data Date = Date String String Int + deriving (Read, Show) + +instance Exec Date where + alias (Date _ a _) = a + run (Date f _ _) = date f + rate (Date _ _ r) = r + +date :: String -> IO String +date format = do + t <- toCalendarTime =<< getClockTime + return $ formatCalendarTime defaultTimeLocale format t diff --git a/Plugins/HelloWorld.hs b/Plugins/HelloWorld.hs --- a/Plugins/HelloWorld.hs +++ b/Plugins/HelloWorld.hs @@ -17,9 +17,8 @@ import Plugins data HelloWorld = HelloWorld - deriving (Read) + deriving (Read, Show) instance Exec HelloWorld where - run HelloWorld = return "Hello World!!" - rate HelloWorld = 1000 alias HelloWorld = "helloWorld" + run HelloWorld = return "Hello World!!" diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs --- a/Plugins/Monitors.hs +++ b/Plugins/Monitors.hs @@ -32,29 +32,23 @@ | Battery Args Rate deriving (Show,Read,Eq) -type Args = [String] -type Program = String -type Alias = String -type Station = String +type Args = [String] +type Program = String +type Alias = String +type Station = String type Interface = String -type Rate = Int +type Rate = Int instance Exec Monitors where alias (Weather s _ _) = s alias (Network i _ _) = i - alias (Memory _ _) = "memory" - alias (Swap _ _) = "swap" - alias (Cpu _ _) = "cpu" - alias (Battery _ _) = "battery" - rate (Weather _ _ r) = r - rate (Network _ _ r) = r - rate (Memory _ r) = r - rate (Swap _ r) = r - rate (Cpu _ r) = r - rate (Battery _ r) = r - run (Weather s a _) = runM (a ++ [s]) weatherConfig runWeather - run (Network i a _) = runM (a ++ [i]) netConfig runNet - run (Memory args _) = runM args memConfig runMem - run (Swap args _) = runM args swapConfig runSwap - run (Cpu args _) = runM args cpuConfig runCpu - run (Battery args _) = runM args battConfig runBatt + alias (Memory _ _) = "memory" + alias (Swap _ _) = "swap" + alias (Cpu _ _) = "cpu" + alias (Battery _ _) = "battery" + start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r + start (Network i a r) = runM (a ++ [i]) netConfig runNet r + start (Memory a r) = runM a memConfig runMem r + start (Swap a r) = runM a swapConfig runSwap r + start (Cpu a r) = runM a cpuConfig runCpu r + start (Battery a r) = runM a battConfig runBatt r diff --git a/Plugins/Monitors/Batt.hs b/Plugins/Monitors/Batt.hs --- a/Plugins/Monitors/Batt.hs +++ b/Plugins/Monitors/Batt.hs @@ -26,6 +26,9 @@ "Batt: " -- template ["left"] -- available replacements +fileB0 :: (String, String) +fileB0 = ("/proc/acpi/battery/BAT0/info", "/proc/acpi/battery/BAT0/state") + fileB1 :: (String, String) fileB1 = ("/proc/acpi/battery/BAT1/info", "/proc/acpi/battery/BAT1/state") @@ -43,14 +46,16 @@ parseBATT :: IO Batt parseBATT = - do (a1,b1) <- readFileBatt fileB1 + do (a0,b0) <- readFileBatt fileB0 + (a1,b1) <- readFileBatt fileB1 (a2,b2) <- readFileBatt fileB2 let sp p s = case stringParser p s of [] -> 0 x -> read x + (f0, p0) = (sp (3,2) a0, sp (2,4) b0) (f1, p1) = (sp (3,2) a1, sp (2,4) b1) (f2, p2) = (sp (3,2) a2, sp (2,4) b2) - left = (p1 + p2) / (f1 + f2) --present / full + left = (p0 + p1 + p2) / (f0 + f1 + f2) --present / full return $ if isNaN left then NA else Batt left formatBatt :: Float -> Monitor [String] diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs --- a/Plugins/Monitors/Common.hs +++ b/Plugins/Monitors/Common.hs @@ -48,30 +48,27 @@ import Control.Concurrent import Control.Monad.Reader - import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef import qualified Data.Map as Map import Data.List - import Numeric - import Text.ParserCombinators.Parsec - import System.Console.GetOpt +import Plugins -- $monitor type Monitor a = ReaderT MConfig IO a data MConfig = MC { normalColor :: IORef (Maybe String) - , low :: IORef Int - , lowColor :: IORef (Maybe String) - , high :: IORef Int - , highColor :: IORef (Maybe String) - , template :: IORef String - , export :: IORef [String] + , low :: IORef Int + , lowColor :: IORef (Maybe String) + , high :: IORef Int + , highColor :: IORef (Maybe String) + , template :: IORef String + , export :: IORef [String] } -- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' @@ -100,12 +97,12 @@ -> IO MConfig mkMConfig tmpl exprts = do lc <- newIORef Nothing - l <- newIORef 33 + l <- newIORef 33 nc <- newIORef Nothing - h <- newIORef 66 + h <- newIORef 66 hc <- newIORef Nothing - t <- newIORef tmpl - e <- newIORef exprts + t <- newIORef tmpl + e <- newIORef exprts return $ MC nc l lc h hc t e data Opts = HighColor String @@ -117,12 +114,12 @@ options :: [OptDescr Opts] options = - [ Option ['H'] ["High"] (ReqArg High "number") "The high threshold" - , Option ['L'] ["Low"] (ReqArg Low "number") "The low threshold" - , Option ['h'] ["high"] (ReqArg HighColor "color number") "Color for the high threshold: ex \"#FF0000\"" - , Option ['n'] ["normal"] (ReqArg NormalColor "color number") "Color for the normal threshold: ex \"#00FF00\"" - , Option ['l'] ["low"] (ReqArg LowColor "color number") "Color for the low threshold: ex \"#0000FF\"" - , Option ['t'] ["template"] (ReqArg Template "output template") "Output template." + [ Option ['H'] ["High"] (ReqArg High "number" ) "The high threshold" + , Option ['L'] ["Low"] (ReqArg Low "number" ) "The low threshold" + , Option ['h'] ["high"] (ReqArg HighColor "color number" ) "Color for the high threshold: ex \"#FF0000\"" + , Option ['n'] ["normal"] (ReqArg NormalColor "color number" ) "Color for the normal threshold: ex \"#00FF00\"" + , Option ['l'] ["low"] (ReqArg LowColor "color number" ) "Color for the low threshold: ex \"#0000FF\"" + , Option ['t'] ["template"] (ReqArg Template "output template" ) "Output template." ] doArgs :: [String] @@ -130,8 +127,8 @@ -> Monitor String doArgs args action = do case (getOpt Permute options args) of - (o, n, []) -> do doConfigOptions o - action n + (o, n, [] ) -> do doConfigOptions o + action n (_, _, errs) -> return (concat errs) doConfigOptions :: [Opts] -> Monitor () @@ -139,18 +136,22 @@ doConfigOptions (o:oo) = do let next = doConfigOptions oo case o of - High h -> setConfigValue (read h) high >> next - Low l -> setConfigValue (read l) low >> next - HighColor hc -> setConfigValue (Just hc) highColor >> next + High h -> setConfigValue (read h) high >> next + Low l -> setConfigValue (read l) low >> next + HighColor hc -> setConfigValue (Just hc) highColor >> next NormalColor nc -> setConfigValue (Just nc) normalColor >> next - LowColor lc -> setConfigValue (Just lc) lowColor >> next - Template t -> setConfigValue t template >> next + LowColor lc -> setConfigValue (Just lc) lowColor >> next + Template t -> setConfigValue t template >> next -runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO String -runM args conf action = - do c <- conf - let ac = doArgs args action - runReaderT ac c +runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> (String -> IO ()) -> IO () +runM args conf action r cb = do go + where go = do + c <- conf + let ac = doArgs args action + s <- runReaderT ac c + cb s + tenthSeconds r + go io :: IO a -> Monitor a io = liftIO @@ -249,13 +250,13 @@ floatToPercent :: Float -> String floatToPercent n = - showDigits 2 (n * 100) ++ "%" + showDigits 1 (n * 100) ++ "%" stringParser :: Pos -> B.ByteString -> String stringParser (x,y) = B.unpack . li x . B.words . li y . B.lines - where li i l | length l >= i = l !! i - | otherwise = B.empty + where li i l | length l > i = l !! i + | otherwise = B.empty setColor :: String -> Selector (Maybe String) -> Monitor String setColor str s = @@ -265,7 +266,7 @@ Just c -> return $ "" ++ str ++ "" -showWithColors :: (Float -> String) -> Float -> Monitor String +showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String showWithColors f x = do h <- getConfigValue high l <- getConfigValue low diff --git a/Plugins/Monitors/Mem.hs b/Plugins/Monitors/Mem.hs --- a/Plugins/Monitors/Mem.hs +++ b/Plugins/Monitors/Mem.hs @@ -37,7 +37,7 @@ formatMem :: [Float] -> Monitor [String] formatMem x = - do let f n = showDigits 2 n + do let f n = showDigits 1 n mapM (showWithColors f) x runMem :: [String] -> Monitor String diff --git a/Plugins/Monitors/Swap.hs b/Plugins/Monitors/Swap.hs --- a/Plugins/Monitors/Swap.hs +++ b/Plugins/Monitors/Swap.hs @@ -29,9 +29,16 @@ parseMEM :: IO [Float] parseMEM = do file <- fileMEM - let p x y = flip (/) 1024 . read . stringParser x $ y - tot = p (1,11) file - free = p (1,12) file + let li i l + | l /= [] = (head l) !! i + | otherwise = B.empty + fs s l + | l == [] = False + | otherwise = head l == B.pack s + get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s) + st = map B.words . B.lines $ file + tot = get_data "SwapTotal:" st + free = get_data "SwapFree:" st return [tot, (tot - free), free, (tot - free) / tot] formatSwap :: [Float] -> Monitor [String] diff --git a/Plugins/Monitors/Weather.hs b/Plugins/Monitors/Weather.hs --- a/Plugins/Monitors/Weather.hs +++ b/Plugins/Monitors/Weather.hs @@ -39,7 +39,7 @@ , "tempF" , "dewPoint" , "rh" - ,"pressure" + , "pressure" ] data WeatherInfo = @@ -52,10 +52,11 @@ , wind :: String , visibility :: String , skyCondition :: String - , temperature :: Float + , tempC :: Int + , tempF :: Int , dewPoint :: String - , humidity :: Float - , pressure :: String + , humidity :: Int + , pressure :: Int } deriving (Show) pTime :: Parser (String, String, String, String) @@ -69,16 +70,23 @@ char ' ' return (y, m, d ,([h]++[hh]++":"++[mi]++mimi)) -pTemp :: Parser Float -pTemp = do manyTill anyChar $ char '(' - s <- manyTill digit $ (char ' ' <|> char '.') +pTemp :: Parser (Int, Int) +pTemp = do f <- manyTill (digit <|> char '.') $ char ' ' + manyTill anyChar $ char '(' + c <- manyTill digit $ (char ' ' <|> char '.') skipRestOfLine - return $read s + return $ (floor (read c :: Double), floor (read f :: Double)) -pRh :: Parser Float +pRh :: Parser Int pRh = do s <- manyTill digit $ (char '%' <|> char '.') return $ read s +pPressure :: Parser Int +pPressure = do manyTill anyChar $ char '(' + s <- manyTill digit $ char ' ' + skipRestOfLine + return $ read s + parseData :: Parser [WeatherInfo] parseData = do st <- getAllBut "," @@ -90,13 +98,14 @@ v <- getAfterString "Visibility: " sk <- getAfterString "Sky conditions: " skipTillString "Temperature: " - temp <- pTemp + (tC,tF) <- pTemp dp <- getAfterString "Dew Point: " skipTillString "Relative Humidity: " rh <- pRh - p <- getAfterString "Pressure (altimeter): " + skipTillString "Pressure (altimeter): " + p <- pPressure manyTill skipRestOfLine eof - return $ [WI st ss y m d h w v sk temp dp rh p] + return $ [WI st ss y m d h w v sk tC tF dp rh p] defUrl :: String defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/" @@ -115,11 +124,10 @@ return "Could not retrieve data" formatWeather :: [WeatherInfo] -> Monitor String -formatWeather [(WI st ss y m d h w v sk temp dp r p)] = - do cel <- showWithColors show temp - far <- showWithColors (showDigits 1) (((9 / 5) * temp) + 32) - rh <- showWithColors show r - parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, rh , p ] +formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] = + do cel <- showWithColors show tC + far <- showWithColors show tF + parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ] formatWeather _ = return "N/A" runWeather :: [String] -> Monitor String diff --git a/Plugins/PipeReader.hs b/Plugins/PipeReader.hs new file mode 100644 --- /dev/null +++ b/Plugins/PipeReader.hs @@ -0,0 +1,28 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.PipeReader +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for reading from named pipes +-- +----------------------------------------------------------------------------- + +module Plugins.PipeReader where + +import System.IO +import Plugins + +data PipeReader = PipeReader String String + deriving (Read, Show) + +instance Exec PipeReader where + alias (PipeReader _ a) = a + start (PipeReader p _) cb = do + h <- openFile p ReadMode + forever (hGetLine h >>= cb) + where forever a = a >> forever a diff --git a/Plugins/StdinReader.hs b/Plugins/StdinReader.hs new file mode 100644 --- /dev/null +++ b/Plugins/StdinReader.hs @@ -0,0 +1,33 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.StdinReader +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for reading from stdin +-- +----------------------------------------------------------------------------- + +module Plugins.StdinReader where + +import Prelude hiding (catch) +import System.Posix.Process +import System.Exit +import System.IO +import Control.Exception (catch) +import Plugins + +data StdinReader = StdinReader + deriving (Read, Show) + +instance Exec StdinReader where + start StdinReader cb = do + cb =<< catch (hGetLine stdin) (\e -> do hPrint stderr e; return "") + eof <- hIsEOF stdin + if eof + then exitImmediately ExitSuccess + else start StdinReader cb diff --git a/Plugins/helloworld.config b/Plugins/helloworld.config --- a/Plugins/helloworld.config +++ b/Plugins/helloworld.config @@ -1,16 +1,12 @@ Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" , bgColor = "#000000" , fgColor = "#BFBFBF" - , xPos = 0 - , yPos = 0 - , width = 1024 - , height = 15 - , align = "right" - , refresh = 10 + , position = TopW C 90 , commands = [ Run Cpu [] 10 , Run Weather "LIPB" [] 36000 , Run HelloWorld ] , sepChar = "%" - , template = "%cpu% | %helloWorld% | %LIPB% | %date%" + , alignSep = "}{" + , template = "%cpu% } %helloWorld% { %LIPB% | %date%" } diff --git a/README b/README --- a/README +++ b/README @@ -1,319 +1,415 @@ -Xmobar - A Minimalistic Text Based Status Bar +% Xmobar - A Minimalistic Text Based Status Bar +% Andrea Rossato -ABOUT -===== +About +----- -Xmobar is a minimalistic, text based, status bar. +[Xmobar] is a minimalistic, text based, status bar. It was designed to +work with the [XMonad] Window Manager. -It was inspired by the Ion3 status bar, and supports similar features, +It was inspired by the [Ion3] status bar, and supports similar features, like dynamic color management, output templates, and extensibility through plugins. -See xmobar.config-sample for a sample configuration. +[This is a screen shot] of my desktop with [XMonad] and [Xmobar]. -Try it with: -xmobar xmobar.config-sample +See `xmobar.config-sample`, distributed with the source code, for a +sample configuration. -DOWNLOAD -======== +Download +-------- -You can get the Xmobar source code from Hackage: -http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar +You can get the [Xmobar] source code from [Hackage]. To get the darcs source run: -darcs get http://gorgias.mine.nu/repos/xmobar/ + darcs get http://code.haskell.org/xmobar/ + The latest binary can be found here: -http://gorgias.mine.nu/xmobar/xmobar-0.7.bin + http://code.haskell.org/~arossato/xmobar/xmobar-0.8.bin + A recent screen shot can be found here: -http://gorgias.mine.nu/xmobar/xmobar-0.7.png -INSTALLATION -============ + http://code.haskell.org/~arossato/xmobar/xmobar-0.8.png -tar xvfz xmobar-0.7 -cd xmobar-0.7 -runhaskell Setup.lhs configure --prefix=/usr/local -runhaskell Setup.lhs build -runhaskell Setup.lhs haddock (optional for building the code documentation) -runhaskell Setup.lhs install (possibly to be run as root) +Version 0.8 requires Cabal-1.2.x, but works both with ghc-6.6.1 and +ghc-6.8.1. +[Here you can find] a source tree of xmobar-0.8 which works with +Cabal-1.1.x, but compiles only with ghc-6.6.x: + + http://code.haskell.org/~arossato/xmobar/xmobar-0.8-Cabal-1.1-ghc-6.6.tar.gz + +[Here you can find]: http://code.haskell.org/~arossato/xmobar/xmobar-0.8-Cabal-1.1-ghc-6.6.tar.gz + +Installation +------------ + +To install simply run: + + tar xvfz xmobar-0.8 + cd xmobar-0.8 + runhaskell Setup.lhs configure --prefix=/usr/local + runhaskell Setup.lhs build + runhaskell Setup.lhs haddock --executables # optional + runhaskell Setup.lhs install # possibly to be run as root + Run with: -xmobar /path/to/config & + + xmobar /path/to/config & + or -xmobar & -if you have the default configuration file saved as: -~/.xmobarrc -CONFIGURATION -============= + xmobar & -Quick Start ------------ +if you have the default configuration file saved as `~/.xmobarrc` -See xmobar.config-sample for an example. +Configuration +------------- +### Quick Start + +See `xmobar.config-sample` for an example. + For the output template: -- %command% will execute command and print the output. The output may - contain markups to change the characters' color. +- `%command%` will execute command and print the output. The output + may contain markups to change the characters' color. -- string will print "string" with #FF0000 color (red). +- `string` will print `string` with `#FF0000` color + (red). Other configuration options: -font: Name of the font to be used -bgColor: Backgroud color -fgColor: Default font color -xPos: x position (origin in the upper left corner) of the Xmobar window -yPos: y position -width: width of the Xmobar window -height: height -align: text alignment -refresh: Refresh rate in tenth of seconds -commands: For setting the options of the programs to run (optional) -sepChar: The character to be used for indicating commands in the - output template (default '%') -template: The output template +`font` +: Name of the font to be used -Command Line Options --------------------- +`bgColor` +: Background color -Xmobar can be either configured with a configuration file or with +`fgColor` +: Default font color + +`position` +: Top, TopW, Bottom, BottomW or Static (with x, y, width and height). + +: TopW and BottomW take 2 arguments: an alignment parameter (L for + left, C for centered, R for Right) and an integer for the + percentage width Xmobar window will have in respect to the + screen width + +: For example: + +: position = Bottom C 75 + +: to place Xmobar at the bottom, centered with the 75% of the screen width. + +: Or + +: position = Static { xpos = 0 , ypos = 0, width = 1024, height = 15 } + +: or + +: position = Top + +`commands` +: For setting the options of the programs to run (optional) + +`sepChar` +: The character to be used for indicating commands in the output + template (default '%') + +`alignSep` +: a 2 character string for aligning text in the output template. The + text before the first character will be align to left, the text in + between the 2 characters will be centered, and the text after the + second character will be align to the right. + +`template` +: The output template + +### Command Line Options + +[Xmobar] can be either configured with a configuration file or with command line options. In the second case, the command line options will overwrite the corresponding options set in the configuration file. Example: -xmobar -B white -a right -F blue -t '%LIPB%' -c '[Run Weather "LIPB" [] 36000]' + xmobar -B white -a right -F blue -t '%LIPB%' -c '[Run Weather "LIPB" [] 36000]' + This is the list of command line options (the output of xmobar --help): -Usage: xmobar [OPTION...] [FILE] -Options: - -h, -? --help This help - -V --version Show version information - -f font name --font=font name The font name - -B bg color --bgcolor=bg color The background color. Default black - -F fg color --fgcolor=fg color The foreground color. Default grey - -x x pos --xpos=x pos The x position. Default 0 - -y y pos --ypos=y pos The y position. Default 0 - -W width --width=width The status bar width. Default 1024 - -H height --height=height The status bar height. Default 15 - -a align --align=align The text alignment: center, left or right. - Default: left - -r rate --refresh=rate The refresh rate in tenth of seconds: - default 1 sec. - -s char --sepchar=char The character used to separate commands in - the output template. Default '%' - -t tempate --template=tempate The output template - -c commands --commands=commands The list of commands to be executed -Mail bug reports and suggestions to + Usage: xmobar [OPTION...] [FILE] + Options: + -h, -? --help This help + -V --version Show version information + -f font name --font=font name The font name + -B bg color --bgcolor=bg color The background color. Default black + -F fg color --fgcolor=fg color The foreground color. Default grey + -o --top Place Xmobar at the top of the screen + -b --bottom Place Xmobar at the bottom of the screen + -a alignsep --alignsep=alignsep Separators for left, center and right text + alignment. Default: '}{' + -s char --sepchar=char The character used to separate commands in + the output template. Default '%' + -t tempate --template=tempate The output template + -c commands --commands=commands The list of commands to be executed + Mail bug reports and suggestions to -The Output Template -------------------- +### The Output Template -The output template must contain at least one command. Xmobar will +The output template must contain at least one command. [Xmobar] will parse the template and will search for the command to be executed in -the "commands" configuration option. First an "alias" will be search -(internal commands such as Weather or Network have default aliasing, -see below). After that the command name will be tried. If a command is -found, the arguments specified in the "commands" list will be used. +the `commands` configuration option. First an `alias` will be searched +(plugins such as Weather or Network have default aliases, see below). +After that, the command name will be tried. If a command is found, the +arguments specified in the `commands` list will be used. -If no command is found in the "commands" list, Xmobar will try to -execute a program with the name found in the template. If the -execution is not successful an error will be reported. +If no command is found in the `commands` list, [Xmobar] will ask the +operating system to execute a program with the name found in the +template. If the execution is not successful an error will be +reported. -The "commands" Configuration Option ------------------------------------ +### The `commands` Configuration Option -The "commands" configuration option is a list of commands' information -and arguments to be used by Xmobar when parsing the output template. -Each member of the list consists in a command prefixed by the "Run" -keyword. Each command has arguments to control the way Xmobar is going +The `commands` configuration option is a list of commands information +and arguments to be used by [Xmobar] when parsing the output template. +Each member of the list consists in a command prefixed by the `Run` +keyword. Each command has arguments to control the way [Xmobar] is going to execute it. The option consists in a list of commands separated by a comma and -enclosed by square parenthesis. Example: +enclosed by square parenthesis. -[Run Memory ["-t","Mem: %"] 10, Run Swap [] 10] +Example: -The only internal available command is Com (see below Executing -External Commands). But by default Xmobar comes with a plugin -consisting in a set of system monitors. This plugin installs the -following internal commands: Weather, Network, Memory, Swap, Cpu, -Battery. + [Run Memory ["-t","Mem: %"] 10, Run Swap [] 10] +to run the Memory monitor plugin with the specified template, and the +swap monitor plugin, with default options, every second. + +The only internal available command is `Com` (see below Executing +External Commands). All other commands are provided by plugins. +[Xmobar] comes with some plugins, providing a set of system monitors, +a standard input reader, an Unix named pipe reader, and a configurable +date plugin. These plugins install the following internal commands: +`Weather`, `Network`, `Memory`, `Swap`, `Cpu`, `Battery`, `Date`, +`StdinReader`, and `PipeReader`. + To remove them see below Installing/Removing a Plugin Other commands can be created as plugins with the Plugin infrastructure. See below Writing a Plugin -This is an example of a command in the "commands" list: -Run Memory ["-t","Mem: %"] 10 +### System Monitor Plugins -Internal Commands and Aliases ------------------------------ +This is the description of the system monitor plugins that are +installed by default. -Each command in the "commands" configuration option list has an alias -to be used in the template. +Each monitor has an `alias` to be used in the output template. +Monitors have default aliases. -Internal commands have default aliases: +`Weather StationID Args RefreshRate` -Weather StationID Args RefreshRate -- aliases to the Station ID: so Weather "LIPB" [] can be used in template as %LIBP% +- aliases to the Station ID: so `Weather "LIPB" []` can be used in template as `%LIBP%` - Args: the argument list (see below) -- Variables that can be used with the "-t"/"--template" argument: - "station", "stationState", "year", "month", "day", "hour", - "wind", "visibility", "skyCondition", "tempC", "tempF", - "dewPoint", "rh", "pressure" -- Default template: ": C, rh % ()" +- Variables that can be used with the `-t`/`--template` argument: + `station`, `stationState`, `year`, `month`, `day`, `hour`, + `wind`, `visibility`, `skyCondition`, `tempC`, `tempF`, + `dewPoint`, `rh`, `pressure` +- Default template: `: C, rh % ()` -Network Interface Args RefreshRate -- aliases to the interface name: so Network "eth0" [] can be used as %eth0% +`Network Interface Args RefreshRate` + +- aliases to the interface name: so `Network "eth0" []` can be used as `%eth0%` - Args: the argument list (see below) -- Variables that can be used with the "-t"/"--template" argument: - "dev", "rx", "tx" -- Default template: ": |" +- Variables that can be used with the `-t`/`--template` argument: + `dev`, `rx`, `tx` +- Default template: `: |` -Memory Args RefreshRate -- aliases to "memory" +`Memory Args RefreshRate` + +- aliases to `memory` - Args: the argument list (see below) -- Variables that can be used with the "-t"/"--template" argument: - "total", "free", "buffer", "cache", "rest", "used", "usedratio" -- Default template: "Mem: % (M)" +- Variables that can be used with the `-t`/`--template` argument: + `total`, `free`, `buffer`, `cache`, `rest`, `used`, `usedratio` +- Default template: `Mem: % (M)` -Swap Args RefreshRate -- aliases to "swap" +`Swap Args RefreshRate` + +- aliases to `swap` - Args: the argument list (see below) -- Variables that can be used with the "-t"/"--template" argument: - "total", "used", "free", "usedratio" -- Default template: "Swap: %" +- Variables that can be used with the `-t`/`--template` argument: + `total`, `used`, `free`, `usedratio` +- Default template: `Swap: %` -Cpu Args RefreshRate -- aliases to "cpu" +`Cpu Args RefreshRate` + +- aliases to `cpu` - Args: the argument list (see below) -- Variables that can be used with the "-t"/"--template" argument: - "total", "user", "nice", "system", "idle" -- Default template: "Cpu: " +- Variables that can be used with the `-t`/`--template` argument: + `total`, `user`, `nice`, `system`, `idle` +- Default template: `Cpu: ` -Battery Args RefreshRate -- aliases to "battery" +`Battery Args RefreshRate` + +- aliases to `battery` - Args: the argument list (see below) -- Variables that can be used with the "-t"/"--template" argument: - "left" -- Default template: "Batt: " +- Variables that can be used with the `-t`/`--template` argument: + `left` +- Default template: `Batt: ` -Internal Commands Arguments ---------------------------- +### Monitor Plugins Commands Arguments These are the arguments that can be used for internal commands in the -"commands" configuration option: +`commands` configuration option: --H number --High=number The high threshold --L number --Low=number The low threshold --h color number --high=color number Color for the high threshold: es "#FF0000" --n color number --normal=color number Color for the normal threshold: es "#00FF00" --l color number --low=color number Color for the low threshold: es "#0000FF" --t output template --template=output template Output template of the command. + -H number --High=number The high threshold + -L number --Low=number The low threshold + -h color number --high=color number Color for the high threshold: es "#FF0000" + -n color number --normal=color number Color for the normal threshold: es "#00FF00" + -l color number --low=color number Color for the low threshold: es "#0000FF" + -t output template --template=output template Output template of the command. Commands' arguments must be set as a list. Es: -Run Weather "EGPF" ["-t",": C"] 36000 -In this case Xmobar will run the weather monitor, getting information + Run Weather "EGPF" ["-t",": C"] 36000 + +In this case [Xmobar] will run the weather monitor, getting information for the weather station ID EGPF (Glasgow Airport, as a homage to GHC) every hour (36000 tenth of seconds), with a template that will output something like: -"Glasgow Airport: 16.0C" -Executing External Commands ---------------------------- + Glasgow Airport: 16.0C +### Executing External Commands + In order to execute an external command you can either write the command name in the template, in this case it will be executed without arguments, or you can configure it in the "commands" configuration option list with the Com template command: -Com ProgarmName Args Alias RefreshRate +`Com ProgarmName Args Alias RefreshRate` + - ProgramName: the name of the program - Args: the arguments to be passed to the program at execution time - Alias: a name to be used in the template. If the alias is en empty string the program name can be used in the template. + Es: -Run Com "uname" ["-s","-r"] "" 36000 -can be used in the output template as %uname% -Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600 -can be used in the output template as %mydate% + Run Com "uname" ["-s","-r"] "" 36000 -PLUGINS -======= +can be used in the output template as `%uname%` -Writing a Plugin ----------------- + Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600 -Writing a plugin for Xmobar should be very simple. You need to create +can be used in the output template as `%mydate%` + +### Other Plugins + +`Date Args Alias RefreshRate` + +`StdinReader` + +`PipeReader "/path/to/pipe" Alias` + +Plugins +------- + +### Writing a Plugin + +Writing a plugin for [Xmobar] should be very simple. You need to create a data type with at least one constructor. -Next you must declare this data type an instance of the Exec class, by -defining the 3 needed methods: +Next you must declare this data type an instance of the `Exec` class, by +defining the 1 needed method (alternatively `start` or `run`) and 2 +optional ones (alias and rate): - run :: e -> IO String - rate :: e -> Int - alias :: e -> String + start :: e -> (String -> IO ()) -> IO () + run :: e -> IO String + rate :: e -> Int + alias :: e -> String -"run" must produce the IO String that will be displayed by Xmobar. -"rate" is the refresh rate for you plugin (the number of tenth of -seconds between two successive runs); -"alias" is the name to be used in the output template. +`start` must receive a callback to be used to display the `String` +produced by the plugin. This method can be used for plugins that need +to perform asynchronous actions. See `Plugins/PipeReader.hs` for an +example. -That requires importing the plugin API (the Exec class definition), -that is exported by Plugins.hs. So you just need to import it in your -module with: +`run` can be used for simpler plugins. If you define only `run` the +plugin will be run every second. To overwrite this default you just +need to implement `rate`, which must return the number of tenth of +seconds between every successive runs. See `Plugins/HelloWorld.hs` for +an example of a plugin that runs just once, and `Plugins/Date.hs` for +one that implements `rate`. -import Plugins +Notice that Date could be implemented as: + instance Exec Date where + alias (Date _ a _) = a + start (Date f _ r) = date f r + + date :: String -> Int -> (String -> IO ()) -> IO () + date format r callback = do go + where go = do + t <- toCalendarTime =<< getClockTime + callback $ formatCalendarTime defaultTimeLocale format t + tenthSeconds r >> go + +This implementation is equivalent to the one you can read in +`Plugins/Date.hs`. + +`alias` is the name to be used in the output template. Default alias +will be the data type constructor. + +Implementing a plugin requires importing the plugin API (the `Exec` +class definition), that is exported by `Plugins.hs`. So you just need +to import it in your module with: + + import Plugins + After that your type constructor can be used as an argument for the -Runnable type constructor "Run" in the "commands" list of the +Runnable type constructor `Run` in the `commands` list of the configuration options. -This requires importing you plugin into Config.hs and adding you type -to the type list in the type signature of Config.runnableTypes. +This requires importing your plugin into `Config.hs` and adding you +type to the type list in the type signature of `Config.runnableTypes`. -For a vary basic example see Plugins/HelloWorld.hs that is distributed -with Xmobar. +For a very basic example see `Plugins/HelloWorld.hs` or the other +plugins that are distributed with [Xmobar]. -Installing/Removing a Plugin ----------------------------- +### Installing/Removing a Plugin Installing a plugin should require 3 steps. Here we are going to -install the HelloWorld plugin that comes with Xmobar: +install the HelloWorld plugin that comes with [Xmobar]: -1. import the plugin module in Config.hs, by adding: +1. import the plugin module in `Config.hs`, by adding: -import Plugins.HelloWorld + import Plugins.HelloWorld 2. add the plugin data type to the list of data types in the type - signature of "runnableTypes" in Config.hs. For instance, for the - HelloWorld plugin, change "runnableTypes" into: + signature of `runnableTypes` in `Config.hs`. For instance, for the + HelloWorld plugin, change `runnableTypes` into: -runnableTypes :: (Command,(Monitors,(HelloWorld,()))) -runnableTypes = undefined + runnableTypes :: (Command,(Monitors,(HelloWorld,()))) + runnableTypes = undefined -3. Rebuild and reinstall Xmobar. Now test it with: +3. Rebuild and reinstall [Xmobar]. Now test it with: -xmobar Plugins/helloworld.config + xmobar Plugins/helloworld.config As you may see in the example configuration file, the plugin can be -used by adding, in the "commands" list: +used by adding, in the `commands` list: -Run HelloWorld + Run HelloWorld and, in the output template, the alias of the plugin: -%helloWorld% + %helloWorld% That's it. @@ -322,45 +418,66 @@ To remove the system monitor plugin: -1. remove, from Config.hs, the line -import Plugins.Monitors +1. remove, from `Config.hs`, the line -2. in Config.hs change -runnableTypes :: (Command,(Monitors,())) -runnableTypes = undefined -to -runnableTypes :: (Command,()) -runnableTypes = undefined + import Plugins.Monitors -3. rebuild Xmobar. +2. in `Config.hs` change -AUTHOR -====== + runnableTypes :: (Command,(Monitors,())) + runnableTypes = undefined -Andrea Rossato + to -CREDITS -======= + runnableTypes :: (Command,()) + runnableTypes = undefined +3. rebuild [Xmobar]. + +Credits +------- + Thanks to Robert Manea and Spencer Janssen for their help in -understanding how X works. He gave me suggestions on how to solve many -problems with Xmobar. +understanding how X works. They gave me suggestions on how to solve +many problems with [Xmobar]. Thanks to Claus Reinke for make me understand existential types (or at -least for letting me thing I grasp existential types...;-). +least for letting me think I grasp existential types...;-). -Xmobar incorporates patches from: Krzysztof Kosciuszkiewicz and -Spencer Janssen. +[Xmobar] incorporates patches from: Krzysztof Kosciuszkiewicz, Spencer +Janssen, Jens Petersen, Dmitry Kurochkin, and Lennart Kolmodin. -LINKS -===== +Useful links +------------ -The Xmobar home page: -http://gorgias.mine.nu/repos/xmobar/ +The [Xmobar] home page -Xmobars darcs repository: -http://gorgias.mine.nu/repos/xmobar/ +The [XMonad] home page -To understand the internal mysteries of Xmobar try reading this: -http://www.haskell.org/haskellwiki/X_window_programming_in_Haskell +[Xmobars darcs repository] +To understand the internal mysteries of Xmobar you may try reading +this tutorial [on X Window Programming in Haskell]. + +Author +------ + +Andrea Rossato + +`andrea.rossato at unibz.it` + +Legal +----- + +This software is released under a BSD-style license. See LICENSE for +more details. + +Copyright © 2007 Andrea Rossato + +[This is a screen shot]: http://haskell.org/sitewiki/images/a/ae/Arossato-config.png +[Hackage]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar +[Xmobar]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar +[Xmobars darcs repository]: http://code.haskell.org/xmobar +[on X Window Programming in Haskell]: http://www.haskell.org/haskellwiki/X_window_programming_in_Haskell +[Ion3]: http://modeemi.fi/~tuomov/ion/ +[XMonad]: http://xmonad.org diff --git a/README.html b/README.html new file mode 100644 --- /dev/null +++ b/README.html @@ -0,0 +1,1012 @@ + +Xmobar - A Minimalistic Text Based Status Bar +

Xmobar - A Minimalistic Text Based Status Bar

About

Xmobar is a minimalistic, text based, status bar. It was designed to work with the XMonad Window Manager.

It was inspired by the Ion3 status bar, and supports similar features, like dynamic color management, output templates, and extensibility through plugins.

This is a screen shot of my desktop with XMonad and Xmobar.

See xmobar.config-sample, distributed with the source code, for a sample configuration.

Download

You can get the Xmobar source code from Hackage.

To get the darcs source run:

    darcs get http://code.haskell.org/xmobar/
+

The latest binary can be found here:

    http://code.haskell.org/~arossato/xmobar/xmobar-0.8.bin
+

A recent screen shot can be found here:

    http://code.haskell.org/~arossato/xmobar/xmobar-0.8.png
+

Version 0.8 requires Cabal-1.2.x, but works both with ghc-6.6.1 and ghc-6.8.1.

Here you can find a source tree of xmobar-0.8 which works with Cabal-1.1.x, but compiles only with ghc-6.6.x:

    http://code.haskell.org/~arossato/xmobar/xmobar-0.8-Cabal-1.1-ghc-6.6.tar.gz
+

Installation

To install simply run:

    tar xvfz xmobar-0.8
+    cd xmobar-0.8
+    runhaskell Setup.lhs configure --prefix=/usr/local
+    runhaskell Setup.lhs build
+    runhaskell Setup.lhs haddock --executables # optional
+    runhaskell Setup.lhs install # possibly to be run as root
+

Run with:

    xmobar /path/to/config &
+

or

    xmobar &
+

if you have the default configuration file saved as ~/.xmobarrc

Configuration

Quick Start

See xmobar.config-sample for an example.

For the output template:

  • %command% will execute command and print the output. The output may contain markups to change the characters' color.

  • <fc=#FF0000>string</fc> will print string with #FF0000 color (red).

Other configuration options:

font

Name of the font to be used

bgColor

Background color

fgColor

Default font color

position

Top, TopW, Bottom, BottomW or Static (with x, y, width and height).

TopW and BottomW take 2 arguments: an alignment parameter (L for left, C for centered, R for Right) and an integer for the percentage width Xmobar window will have in respect to the screen width

For example:

   position = Bottom C 75
+

to place Xmobar at the bottom, centered with the 75% of the screen width.

Or

   position = Static { xpos = 0 , ypos = 0, width = 1024, height = 15 }
+

or

  position = Top
+
commands

For setting the options of the programs to run (optional)

sepChar

The character to be used for indicating commands in the output template (default '%')

alignSep

a 2 character string for aligning text in the output template. The text before the first character will be align to left, the text in between the 2 characters will be centered, and the text after the second character will be align to the right.

template

The output template

Command Line Options

Xmobar can be either configured with a configuration file or with command line options. In the second case, the command line options will overwrite the corresponding options set in the configuration file.

Example:

xmobar -B white -a right -F blue -t '%LIPB%' -c '[Run Weather "LIPB" [] 36000]'
+

This is the list of command line options (the output of xmobar --help):

Usage: xmobar [OPTION...] [FILE]
+Options:
+  -h, -?        --help               This help
+  -V            --version            Show version information
+  -f font name  --font=font name     The font name
+  -B bg color   --bgcolor=bg color   The background color. Default black
+  -F fg color   --fgcolor=fg color   The foreground color. Default grey
+  -o            --top                Place Xmobar at the top of the screen
+  -b            --bottom             Place Xmobar at the bottom of the screen
+  -a alignsep   --alignsep=alignsep  Separators for left, center and right text
+                                     alignment. Default: '}{'
+  -s char       --sepchar=char       The character used to separate commands in
+                                     the output template. Default '%'
+  -t tempate    --template=tempate   The output template
+  -c commands   --commands=commands  The list of commands to be executed
+Mail bug reports and suggestions to <andrea.rossato@unibz.it>
+

The Output Template

The output template must contain at least one command. Xmobar will parse the template and will search for the command to be executed in the commands configuration option. First an alias will be searched (plugins such as Weather or Network have default aliases, see below). After that, the command name will be tried. If a command is found, the arguments specified in the commands list will be used.

If no command is found in the commands list, Xmobar will ask the operating system to execute a program with the name found in the template. If the execution is not successful an error will be reported.

The commands Configuration Option

The commands configuration option is a list of commands information and arguments to be used by Xmobar when parsing the output template. Each member of the list consists in a command prefixed by the Run keyword. Each command has arguments to control the way Xmobar is going to execute it.

The option consists in a list of commands separated by a comma and enclosed by square parenthesis.

Example:

[Run Memory ["-t","Mem: <usedratio>%"] 10, Run Swap [] 10]
+

to run the Memory monitor plugin with the specified template, and the swap monitor plugin, with default options, every second.

The only internal available command is Com (see below Executing External Commands). All other commands are provided by plugins. Xmobar comes with some plugins, providing a set of system monitors, a standard input reader, an Unix named pipe reader, and a configurable date plugin. These plugins install the following internal commands: Weather, Network, Memory, Swap, Cpu, Battery, Date, StdinReader, and PipeReader.

To remove them see below Installing/Removing a Plugin

Other commands can be created as plugins with the Plugin infrastructure. See below Writing a Plugin

System Monitor Plugins

This is the description of the system monitor plugins that are installed by default.

Each monitor has an alias to be used in the output template. Monitors have default aliases.

Weather StationID Args RefreshRate

  • aliases to the Station ID: so Weather "LIPB" [] can be used in template as %LIBP%
  • Args: the argument list (see below)
  • Variables that can be used with the -t/--template argument: station, stationState, year, month, day, hour, wind, visibility, skyCondition, tempC, tempF, dewPoint, rh, pressure
  • Default template: <station>: <tempC>C, rh <rh>% (<hour>)

Network Interface Args RefreshRate

  • aliases to the interface name: so Network "eth0" [] can be used as %eth0%
  • Args: the argument list (see below)
  • Variables that can be used with the -t/--template argument: dev, rx, tx
  • Default template: <dev>: <rx>|<tx>

Memory Args RefreshRate

  • aliases to memory
  • Args: the argument list (see below)
  • Variables that can be used with the -t/--template argument: total, free, buffer, cache, rest, used, usedratio
  • Default template: Mem: <usedratio>% (<cache>M)

Swap Args RefreshRate

  • aliases to swap
  • Args: the argument list (see below)
  • Variables that can be used with the -t/--template argument: total, used, free, usedratio
  • Default template: Swap: <usedratio>%

Cpu Args RefreshRate

  • aliases to cpu
  • Args: the argument list (see below)
  • Variables that can be used with the -t/--template argument: total, user, nice, system, idle
  • Default template: Cpu: <total>

Battery Args RefreshRate

  • aliases to battery
  • Args: the argument list (see below)
  • Variables that can be used with the -t/--template argument: left
  • Default template: Batt: <left>

Monitor Plugins Commands Arguments

These are the arguments that can be used for internal commands in the commands configuration option:

-H number           --High=number               The high threshold
+-L number           --Low=number                The low threshold
+-h color number     --high=color number         Color for the high threshold: es "#FF0000"
+-n color number     --normal=color number       Color for the normal threshold: es "#00FF00"
+-l color number     --low=color number          Color for the low threshold: es "#0000FF"
+-t output template  --template=output template  Output template of the command.
+

Commands' arguments must be set as a list. Es:

Run Weather "EGPF" ["-t","<station>: <tempC>C"] 36000
+

In this case Xmobar will run the weather monitor, getting information for the weather station ID EGPF (Glasgow Airport, as a homage to GHC) every hour (36000 tenth of seconds), with a template that will output something like:

Glasgow Airport: 16.0C
+

Executing External Commands

In order to execute an external command you can either write the command name in the template, in this case it will be executed without arguments, or you can configure it in the "commands" configuration option list with the Com template command:

Com ProgarmName Args Alias RefreshRate

  • ProgramName: the name of the program
  • Args: the arguments to be passed to the program at execution time
  • Alias: a name to be used in the template. If the alias is en empty string the program name can be used in the template.

Es:

    Run Com "uname" ["-s","-r"] "" 36000
+

can be used in the output template as %uname%

    Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600
+

can be used in the output template as %mydate%

Other Plugins

Date Args Alias RefreshRate

StdinReader

PipeReader "/path/to/pipe" Alias

Plugins

Writing a Plugin

Writing a plugin for Xmobar should be very simple. You need to create a data type with at least one constructor.

Next you must declare this data type an instance of the Exec class, by defining the 1 needed method (alternatively start or run) and 2 optional ones (alias and rate):

    start :: e -> (String -> IO ()) -> IO ()
+    run   :: e -> IO String
+    rate  :: e -> Int
+    alias :: e -> String
+

start must receive a callback to be used to display the String produced by the plugin. This method can be used for plugins that need to perform asynchronous actions. See Plugins/PipeReader.hs for an example.

run can be used for simpler plugins. If you define only run the plugin will be run every second. To overwrite this default you just need to implement rate, which must return the number of tenth of seconds between every successive runs. See Plugins/HelloWorld.hs for an example of a plugin that runs just once, and Plugins/Date.hs for one that implements rate.

Notice that Date could be implemented as:

    instance Exec Date where
+        alias (Date _ a _) = a
+        start (Date f _ r) = date f r
+
+    date :: String -> Int -> (String -> IO ()) -> IO ()
+    date format r callback = do go
+        where go = do
+                t <- toCalendarTime =<< getClockTime
+                callback $ formatCalendarTime defaultTimeLocale format t
+                tenthSeconds r >> go
+

This implementation is equivalent to the one you can read in Plugins/Date.hs.

alias is the name to be used in the output template. Default alias will be the data type constructor.

Implementing a plugin requires importing the plugin API (the Exec class definition), that is exported by Plugins.hs. So you just need to import it in your module with:

    import Plugins
+

After that your type constructor can be used as an argument for the Runnable type constructor Run in the commands list of the configuration options.

This requires importing your plugin into Config.hs and adding you type to the type list in the type signature of Config.runnableTypes.

For a very basic example see Plugins/HelloWorld.hs or the other plugins that are distributed with Xmobar.

Installing/Removing a Plugin

Installing a plugin should require 3 steps. Here we are going to install the HelloWorld plugin that comes with Xmobar:

  1. import the plugin module in Config.hs, by adding:

    import Plugins.HelloWorld
+

  2. add the plugin data type to the list of data types in the type signature of runnableTypes in Config.hs. For instance, for the HelloWorld plugin, change runnableTypes into:

    runnableTypes :: (Command,(Monitors,(HelloWorld,())))
+runnableTypes = undefined
+

  3. Rebuild and reinstall Xmobar. Now test it with:

    xmobar Plugins/helloworld.config
+

As you may see in the example configuration file, the plugin can be used by adding, in the commands list:

    Run HelloWorld
+

and, in the output template, the alias of the plugin:

    %helloWorld%
+

That's it.

To remove a plugin, just remove its type from the type signature of runnableTypes and remove the imported modules.

To remove the system monitor plugin:

  1. remove, from Config.hs, the line

    import Plugins.Monitors
+

  2. in Config.hs change

     runnableTypes :: (Command,(Monitors,()))
+ runnableTypes = undefined
+

    to

     runnableTypes :: (Command,())
+ runnableTypes = undefined
+

  3. rebuild Xmobar.

Credits

Thanks to Robert Manea and Spencer Janssen for their help in understanding how X works. They gave me suggestions on how to solve many problems with Xmobar.

Thanks to Claus Reinke for make me understand existential types (or at least for letting me think I grasp existential types...;-).

Xmobar incorporates patches from: Krzysztof Kosciuszkiewicz, Spencer Janssen, Jens Petersen, Dmitry Kurochkin, and Lennart Kolmodin.

The Xmobar home page

The XMonad home page

Xmobars darcs repository

To understand the internal mysteries of Xmobar you may try reading this tutorial on X Window Programming in Haskell.

Author

Andrea Rossato

andrea.rossato at unibz.it

This software is released under a BSD-style license. See LICENSE for more details.

Copyright © 2007 Andrea Rossato

+ diff --git a/Runnable.hs b/Runnable.hs --- a/Runnable.hs +++ b/Runnable.hs @@ -27,13 +27,15 @@ import Config (runnableTypes) import Commands -data Runnable = forall r . (Exec r, Read r) => Run r +data Runnable = forall r . (Exec r, Read r, Show r) => Run r instance Exec Runnable where - run (Run a) = run a - rate (Run a) = rate a + start (Run a) = start a alias (Run a) = alias a +instance Show Runnable where + show (Run x) = show x + instance Read Runnable where readPrec = readRunnable @@ -44,7 +46,7 @@ instance ReadAsAnyOf () ex where readAsAnyOf ~() = mzero -instance (Read t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where +instance (Show t, Read t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where readAsAnyOf ~(t,ts) = r t `mplus` readAsAnyOf ts where r ty = do { m <- readPrec; return (Run (m `asTypeOf` ty)) } diff --git a/Runnable.hs-boot b/Runnable.hs-boot --- a/Runnable.hs-boot +++ b/Runnable.hs-boot @@ -2,7 +2,7 @@ module Runnable where import Commands -data Runnable = forall r . (Exec r,Read r) => Run r +data Runnable = forall r . (Exec r,Read r,Show r) => Run r instance Read Runnable instance Exec Runnable diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,80 +1,4 @@ #!/usr/bin/env runhaskell > import Distribution.Simple -> import Distribution.PackageDescription -> import Distribution.Setup -> import Distribution.Simple.Utils -> import Distribution.Simple.LocalBuildInfo -> import Distribution.Program -> import Distribution.PreProcess - -> import System.FilePath.Posix -> import System.Directory -> import Data.List - - -> main = defaultMainWithHooks defaultUserHooks {haddockHook = xmonadHaddock} - -> -- a different implementation of haddock hook from -> -- from Distribution.Simple: will use synopsis and description for -> -- building executables' documentation. - -> xmonadHaddock pkg_descr lbi hooks (HaddockFlags hoogle verbose) = do -> confHaddock <- do let programConf = withPrograms lbi -> haddockName = programName haddockProgram -> mHaddock <- lookupProgram haddockName programConf -> maybe (die "haddock command not found") return mHaddock - -> let tmpDir = (buildDir lbi) "tmp" -> createDirectoryIfMissing True tmpDir -> createDirectoryIfMissing True haddockPref -> preprocessSources pkg_descr lbi verbose (allSuffixHandlers hooks) -> setupMessage "Running Haddock for" pkg_descr - -> let outputFlag = if hoogle then "--hoogle" else "--html" -> showPkg = showPackageId (package pkg_descr) -> showDepPkgs = map showPackageId (packageDeps lbi) - -> withExe pkg_descr $ \exe -> do -> let bi = buildInfo exe -> inFiles <- getModulePaths bi (otherModules bi) -> srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) - -> let prologName = showPkg ++ "-haddock-prolog.txt" -> writeFile prologName (description pkg_descr ++ "\n") - -> let exeTargetDir = haddockPref exeName exe -> outFiles = srcMainPath : inFiles -> haddockFile = exeTargetDir (haddockName pkg_descr) - -> createDirectoryIfMissing True exeTargetDir -> rawSystemProgram verbose confHaddock -> ([outputFlag, -> "--odir=" ++ exeTargetDir, -> "--title=" ++ showPkg ++ ": " ++ synopsis pkg_descr, -> "--package=" ++ showPkg, -> "--dump-interface=" ++ haddockFile, -> "--prologue=" ++ prologName -> ] -> ++ map ("--use-package=" ++) showDepPkgs -> ++ programArgs confHaddock -> ++ (if verbose > 4 then ["--verbose"] else []) -> ++ outFiles -> ) -> removeFile prologName - -> getModulePaths :: BuildInfo -> [String] -> IO [FilePath] -> getModulePaths bi = -> fmap concat . -> mapM (flip (moduleToFilePath (hsSourceDirs bi)) ["hs", "lhs"]) - - -> allSuffixHandlers :: Maybe UserHooks -> -> [PPSuffixHandler] -> allSuffixHandlers hooks -> = maybe knownSuffixHandlers -> (\h -> overridesPP (hookedPreProcessors h) knownSuffixHandlers) -> hooks -> where -> overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler] -> overridesPP = unionBy (\x y -> fst x == fst y) +> main = defaultMainWithHooks defaultUserHooks diff --git a/Xmobar.hs b/Xmobar.hs --- a/Xmobar.hs +++ b/Xmobar.hs @@ -15,39 +15,35 @@ module Xmobar (-- * Main Stuff -- $main - Xbar - , runXbar + X, XConf (..), runX , eventLoop - , createWin - , updateWin + -- * Program Execution + -- $command + , startCommand + -- * Window Management + -- $window + , createWin, updateWin -- * Printing -- $print - , drawInWin - , printStrings - -- * Program Execution - -- $commands - , execCommands - , execCommand - , runCommandLoop - , readVariables + , drawInWin, printStrings -- * Unmamaged Windows -- $unmanwin , mkUnmanagedWindow -- * Useful Utilities - , initColor - , io + , initColor, io, nextEvent', fi ) 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 Graphics.X11.Xinerama -import Control.Monad.State +import Control.Arrow ((&&&)) import Control.Monad.Reader import Control.Concurrent -import Control.Exception - +import Control.Concurrent.STM +import Control.Exception hiding (handle) +import Data.Bits import System.Posix.Types (Fd(..)) import Config @@ -59,176 +55,211 @@ -- -- The Xmobar data type and basic loops and functions. --- | This is copied from XMonad. -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)] - } +-- | The X type is a ReaderT +type X = ReaderT XConf IO --- | 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 c v d w (X f) = - do runStateT (runReaderT f c) (XState d w v) - return () +-- | The ReaderT inner component +data XConf = + XConf { display :: Display + , rect :: Rectangle + , window :: Window + , fontS :: FontStruct + , config :: Config + } --- | 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 +-- | Runs the ReaderT +runX :: XConf -> X () -> IO () +runX xc f = runReaderT f xc -- | The event loop -eventLoop :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> IO () -eventLoop c v d w = do - t <- forkIO (block go) - timer t +eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO () +eventLoop xc@(XConf d _ w fs c) v = block $ do + tv <- atomically $ newTVar [] + t <- myThreadId + ct <- forkIO (checker t tv "" `catch` \_ -> return ()) + go tv ct where - -- interrupt the drawing thread every so often - timer t = do - tenthSeconds (refresh c) - throwTo t (ErrorCall "Xmobar.eventLoop: yield") - timer t + -- interrupt the drawing thread every time a var is updated + checker t tvar ov = do + nval <- atomically $ do + nv <- fmap concat $ mapM readTVar (map snd v) + guard (nv /= ov) + writeTVar tvar nv + return nv + throwDynTo t () + checker t tvar nval + -- 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 + go tv ct = do + catchDyn (unblock $ allocaXEvent $ \e -> + handle tv ct =<< (nextEvent' d e >> getEvent e)) + (\() -> runX xc (updateWin tv) >> return ()) + go tv ct --- | 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) - selectInput dpy win exposureMask - mapWindow dpy win - return (dpy,win) + -- event hanlder + handle _ ct (ConfigureEvent {ev_window = win}) = do + rootw <- rootWindow d (defaultScreen d) + when (win == rootw) $ block $ do + killThread ct + destroyWindow d w + (r',w') <- createWin d fs c + eventLoop (XConf d r' w' fs c) v -updateWin :: Xbar () -updateWin = - do c <- ask - s <- get - i <- io $ readVariables (vars s) - ps <- io $ parseString c i - drawInWin ps + handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar) --- $print + handle _ _ _ = return () --- | 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 - let lf c = loadQueryFont dpy (font c) - 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 - (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 - 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 +-- $command --- | An easy way to print the stuff we need to print -printStrings :: Drawable - -> GC - -> FontStruct - -> Position - -> [(String, String, Position)] - -> Xbar () -printStrings _ _ _ _ [] = return () -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 - 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) d gc offset valign s - printStrings d gc fontst (offs + l) xs +-- | Runs a command as an independent thread and returns its thread id +-- and the TVar the command will be writing to. +startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String) +startCommand (com,s,ss) + | alias com == "" = do var <- atomically $ newTVar is + atomically $ writeTVar var "Could not parse the template" + return (Nothing,var) + | otherwise = do var <- atomically $ newTVar is + let cb str = atomically $ writeTVar var (s ++ str ++ ss) + h <- forkIO $ start com cb + return (Just h,var) + where is = s ++ "Updating..." ++ ss --- $commands +-- $window --- | 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 +-- | The function to create the initial window +createWin :: Display -> FontStruct -> Config -> IO (Rectangle,Window) +createWin d fs c = do + let dflt = defaultScreen d + r:_ <- getScreenInfo d + rootw <- rootWindow d dflt + let (_,as,ds,_) = textExtents fs [] + ht = as + ds + 2 + (x,y,w,h,o) = setPosition (position c) r (fi ht) + win <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rootw x y w h o + selectInput d win (exposureMask .|. structureNotifyMask) + setProperties h c d win + mapWindow d win + return (Rectangle x y w h,win) -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) +setPosition :: XPosition -> Rectangle -> Dimension -> (Position,Position,Dimension,Dimension,Bool) +setPosition p (Rectangle rx ry rw rh) ht = + case p of + Top -> (rx , ry , rw , h , True) + TopW L i -> (rx , ry , nw i , h , True) + TopW R i -> (right i, ry , nw i , h , True) + TopW C i -> (center i, ry , nw i , h , True) + Bottom -> (rx , ny , rw , h , True) + BottomW L i -> (rx , ny , nw i , h , True) + BottomW R i -> (right i, ny , nw i , h , True) + BottomW C i -> (center i, ny , nw i , h , True) + Static cx cy cw ch -> (fi cx , fi cy , fi cw, fi ch, True) + where + ny = ry + fi (rh - ht) + center i = rx + (fi $ div (remwid i) 2) + right i = rx + (fi $ remwid i) + remwid i = rw - pw (fi i) + pw i = rw * (min 100 i) `div` 100 + nw = fi . pw . fi + h = fi ht -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 +setProperties :: Dimension -> Config -> Display -> Window -> IO () +setProperties h c d w = do + a1 <- internAtom d "_NET_WM_STRUT" False + c1 <- internAtom d "CARDINAL" False + a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False + c2 <- internAtom d "ATOM" False + v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False + changeProperty32 d w a1 c1 propModeReplace $ map fi $ getStrutValues h c + changeProperty32 d w a2 c2 propModeReplace [fromIntegral v] --- | 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 +getStrutValues :: Dimension -> Config -> [Int] +getStrutValues h c = + case position c of + Top -> [0, 0, fi h, 0 ] + Bottom -> [0, 0, 0 , fi h] + _ -> [0, 0, 0 , 0 ] +updateWin :: TVar String -> X () +updateWin v = do + xc <- ask + let (conf,rec) = (config &&& rect) xc + [lc,rc] = if length (alignSep conf) == 2 + then alignSep conf + else alignSep defaultConfig + i <- io $ atomically $ readTVar v + let def = [i,[],[]] + [l,c,r] = case break (==lc) i of + (le,_:re) -> case break (==rc) re of + (ce,_:ri) -> [le,ce,ri] + _ -> def + _ -> def + ps <- io $ mapM (parseString conf) [l,c,r] + drawInWin rec ps + +-- $print + +-- | Draws in and updates the window +drawInWin :: Rectangle -> [[(String, String)]] -> X () +drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do + r <- ask + let (c,d ) = (config &&& display) r + (w,fs) = (window &&& fontS ) r + bgcolor <- io $ initColor d $ bgColor c + gc <- io $ createGC d w + --let's get the fonts + io $ setFont d gc (fontFromFontStruct fs) + -- create a pixmap to write to and fill it with a rectangle + p <- io $ createPixmap d w wid ht + (defaultDepthOfScreen (defaultScreenOfDisplay d)) + -- the fgcolor of the rectangle will be the bgcolor of the window + io $ setForeground d gc bgcolor + io $ fillRectangle d p gc 0 0 wid ht + -- write to the pixmap the new string + let strWithLenth = map (\(s,cl) -> (s,cl,textWidth fs s)) + printStrings p gc fs 1 L $ strWithLenth left + printStrings p gc fs 1 R $ strWithLenth right + printStrings p gc fs 1 C $ strWithLenth center + -- copy the pixmap with the new string to the window + io $ copyArea d p w gc 0 0 wid ht 0 0 + -- free up everything (we do not want to leak memory!) + io $ freeGC d gc + io $ freePixmap d p + -- resync + io $ sync d True + +-- | An easy way to print the stuff we need to print +printStrings :: Drawable -> GC -> FontStruct -> Position + -> Align -> [(String, String, Position)] -> X () +printStrings _ _ _ _ _ [] = return () +printStrings dr gc fontst offs a sl@((s,c,l):xs) = do + r <- ask + let (conf,d) = (config &&& display) r + Rectangle _ _ wid ht = rect r + (_,as,ds,_) = textExtents fontst s + totSLen = foldr (\(_,_,len) -> (+) len) 0 sl + valign = (fi ht + fi as - fi ds) `div` 2 + remWidth = fi wid - fi totSLen + offset = case a of + C -> (remWidth + offs) `div` 2 + R -> remWidth - 1 + L -> offs + (fc,bc) <- case (break (==',') c) of + (f,',':b) -> do + fgc <- io $ initColor d f + bgc <- io $ initColor d b + return (fgc,bgc) + (f,_) -> do + fgc <- io $ initColor d f + bgc <- io $ initColor d (bgColor conf) + return (fgc,bgc) + io $ setForeground d gc fc + io $ setBackground d gc bc + io $ drawImageString d dr gc offset valign s + printStrings dr gc fontst (offs + l) a xs + {- $unmanwin -This is a way to create unmamaged window. It was a mistery in Haskell. -Till I've found out...;-) +This is a way to create unmamaged window. -} @@ -241,44 +272,46 @@ -> Position -> Dimension -> Dimension + -> Bool -> IO Window -mkUnmanagedWindow dpy scr rw x y w h = do - let visual = defaultVisualOfScreen scr +mkUnmanagedWindow dpy scr rw x y w h o = do + let visual = defaultVisualOfScreen scr attrmask = cWOverrideRedirect - win <- allocaSetWindowAttributes $ + allocaSetWindowAttributes $ \attributes -> do - set_override_redirect attributes True + set_override_redirect attributes o createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) inputOutput visual attrmask attributes - return win {- $utility -Utilities, aka stollen without givin' credit stuff. +Utilities -} -- | Get the Pixel value for a named color: if an invalid name is -- given the black pixel will be returned. initColor :: Display -> String -> IO Pixel initColor dpy c = - catch (initColor' dpy c) (const $ return $ blackPixel dpy (defaultScreen dpy)) + catch (initColor' dpy c) (const . return . blackPixel dpy $ (defaultScreen dpy)) initColor' :: Display -> String -> IO Pixel initColor' dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c where colormap = defaultColormap dpy (defaultScreen dpy) +-- | 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 + -- | Short-hand for lifting in the IO monad -io :: IO a -> Xbar a +io :: IO a -> X 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 diff --git a/xmobar.cabal b/xmobar.cabal --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,6 +1,6 @@ name: xmobar -version: 0.7 -homepage: http://gorgias.mine.nu/xmobar/ +version: 0.8 +homepage: http://code.haskell.org/~arossato/xmobar synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. . @@ -12,13 +12,18 @@ 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 +cabal-version: >= 1.2 +flag small_base + description: Choose the new smaller, split-up base package. -executable: xmobar -main-is: Main.hs -Hs-Source-Dirs: ./ -Other-Modules: Xmobar, Config, Parsers, Commands, Runnable, Plugins, Plugins.Monitors.Common, - Plugins.Monitors.Batt Plugins.Monitors.Weather, Plugins.Monitors.Swap, - Plugins.Monitors.Mem, Plugins.Monitors.Cpu, Plugins.Monitors.Net -ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded -ghc-prof-options: -prof -auto-all +executable xmobar + main-is: Main.hs + other-Modules: Xmobar, Config, Parsers, Commands, Runnable, Plugins + ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded + ghc-prof-options: -prof -auto-all + if flag(small_base) + build-depends: base >= 3, containers, process, old-time, old-locale, bytestring + else + build-depends: base < 3 + build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm + diff --git a/xmobar.config-sample b/xmobar.config-sample --- a/xmobar.config-sample +++ b/xmobar.config-sample @@ -1,22 +1,17 @@ Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" , bgColor = "black" , fgColor = "grey" - , xPos = 0 - , yPos = 0 - , width = 1024 - , height = 15 - , align = "right" - , refresh = 10 + , position = Static { xpos = 0 , ypos = 0, width = 1024, height = 15 } , commands = [ Run Weather "EGPF" ["-t",": C","-L","18","-H","25","--normal","green","--high","red","--low","lightblue"] 36000 , Run Network "eth0" ["-L","0","-H","32","--normal","green","--high","red"] 10 , Run Network "eth1" ["-L","0","-H","32","--normal","green","--high","red"] 10 , Run Cpu ["-L","3","-H","50","--normal","green","--high","red"] 10 - , Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600 - , Run Com "date" ["+%Y"] "year" 304128000 , Run Memory ["-t","Mem: %"] 10 , Run Swap [] 10 , Run Com "uname" ["-s","-r"] "" 36000 + , Run Date "%a %b %_d %Y %H:%M:%S" "date" 10 ] , sepChar = "%" - , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% | %EGPF% | %mydate% of %year% %uname%" + , alignSep = "}{" + , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }{ %date%| %EGPF% | %uname%" } diff --git a/xmobar.css b/xmobar.css new file mode 100644 --- /dev/null +++ b/xmobar.css @@ -0,0 +1,88 @@ +body { + margin: auto; + padding-right: 1em; + padding-left: 1em; + max-width: 50em; + border-left: 1px solid black; + border-right: 1px solid black; + color: black; + font-family: Verdana, sans-serif; + font-size: 100%; + line-height: 140%; + color: #333; +} +pre { + border: 1px dotted gray; + background-color: #ccffcc; + color: #111111; + padding: 0.5em; +} +code { + font-family: monospace; + font-size: 110%; +} +h1 a, h2 a, h3 a, h4 a, h5 a { + text-decoration: none; + color: #009900; +} +h1, h2, h3, h4, h5 { font-family: verdana; + font-weight: bold; + color: #009900; } +h1 { + font-size: 130%; +} + +h2 { + font-size: 110%; + border-bottom: 1px dotted black; +} + +h3 { + font-size: 95%; +} + +h4 { + font-size: 90%; + font-style: italic; +} + +h5 { + font-size: 90%; + font-style: italic; +} + +h1.title { + font-size: 150%; + font-weight: bold; + text-align: left; + border: none; +} + +dt code { + font-weight: bold; +} +dd p { + margin-top: 0; +} + +a:link { + color: #009900 + } + +a:visited { + color: #669966 + } +a:hover { + color: #669966 + } +a:active { + color: #009900 + } + +#footer { + padding-top: 1em; + font-size: 70%; + color: gray; + text-align: center; +} +