diff options
| -rw-r--r-- | Config.hs | 58 | ||||
| -rw-r--r-- | Main.hs | 51 | ||||
| -rw-r--r-- | Parsers.hs | 99 | ||||
| -rw-r--r-- | XMobar.hs (renamed from xmobar.hs) | 201 | ||||
| -rw-r--r-- | xmobar.cabal | 6 |
5 files changed, 242 insertions, 173 deletions
diff --git a/Config.hs b/Config.hs new file mode 100644 index 0000000..8672f26 --- /dev/null +++ b/Config.hs @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMobar.Config +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> +-- Stability : unstable +-- Portability : unportable +-- +-- The configuration module of XMobar, a status bar for the Xmonad Window Manager +-- +----------------------------------------------------------------------------- + +module Config ( -- * Configuration + -- $config + Config (..) + , defaultConfig + ) where + +-- $config +-- Configuration data type and default configuration + +-- | The configuration data type +data Config = + Config { fonts :: String -- ^ Fonts + , 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 + , hight :: Int -- ^ Window hight + , align :: String -- ^ text alignment + , refresh :: Int -- ^ Refresh rate in tenth of seconds + , commands :: [(String, Int, [String])] -- ^ For setting the refresh rate and + -- options for the programs to run (optionals) + , sepChar :: String -- ^ The character to be used for indicating + -- commands in the output template (default '%') + , template :: String -- ^ The output template + } deriving (Eq, Show, Read, Ord) + +-- | The default configuration values +defaultConfig :: Config +defaultConfig = + Config { fonts = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , bgColor = "#000000" + , fgColor = "#BFBFBF" + , xPos = 0 + , yPos = 0 + , width = 1024 + , hight = 15 + , align = "left" + , refresh = 10 + , commands = [("date", 10, [])] + , sepChar = "%" + , template = "Uptime: <fc=#00FF00>%uptime%</fc> ** <fc=#FF0000>%date%</fc>" + } + @@ -0,0 +1,51 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMobar.Main +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> +-- Stability : unstable +-- Portability : unportable +-- +-- The main module of XMobar, a status bar for the Xmonad Window Manager +-- +----------------------------------------------------------------------------- + +module Main ( -- * Main Stuff + -- $main + main + , readConfig + ) where + +import XMobar +import Parsers +import Config +import System.Environment + +-- $main + +-- | The main entry point +main :: IO () +main = + do args <- getArgs + config <- + if length args /= 1 + then do putStrLn ("No configuration file specified. Using default settings.") + return defaultConfig + else readConfig (args!!0) + cl <- parseTemplate config (template config) + var <- execCommands config cl + (d,w) <- createWin config + runXMobar config var d w eventLoop + +-- | Reads the configuration files or quits with an error +readConfig :: FilePath -> IO Config +readConfig f = + do s <- readFile f + case reads s of + [(config,_)] -> return config + [] -> error ("Corrupt config file: " ++ f) + _ -> error ("Some problem occured. Aborting...") + + diff --git a/Parsers.hs b/Parsers.hs new file mode 100644 index 0000000..6ca318c --- /dev/null +++ b/Parsers.hs @@ -0,0 +1,99 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMobar.Parsers +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> +-- Stability : unstable +-- Portability : unportable +-- +-- Parsers needed for XMobar, a status bar for the Xmonad Window Manager +-- +----------------------------------------------------------------------------- + +module Parsers ( + -- * Parsing + -- $parser + parseString + , stringParser + , defaultColors + , colorsAndText + , templateStringParser + , templateCommandParser + , templateParser + , parseTemplate + ) where + +import Config +import Text.ParserCombinators.Parsec + + +{- $parser +These are the neede parsers. Don't trust them too much. + +There are parsers for the commands output and parsers for the +formatting template. + -} + +-- | Runs the actual string parsers +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 + +-- | Gets the string and combines the needed parsers +stringParser :: Config -> Parser [(String, String)] +stringParser c = manyTill (colorsAndText c <|> defaultColors c) eof + +-- | Parses a string with the default color (no color set) +defaultColors :: Config -> Parser (String, String) +defaultColors config = + do { s <- many $ noneOf "<" + ; return (s,(fgColor config)) + } + <|> colorsAndText config + +-- | Parses a string with a color set +colorsAndText :: Config -> Parser (String, String) +colorsAndText config = + do { string "<fc=#" + ; n <- count 6 hexDigit + ; string ">" + ; s <- many $ noneOf "<" + ; string "</fc>" + ; return (s,"#"++n) + } + <|> defaultColors config + +-- | 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) + ; return (s, com, ss) + } + +-- | Parses the command part of the template string +templateCommandParser :: Config -> Parser (String,String,String) +templateCommandParser c = + do { let chr = head $ sepChar c + ; char chr + ; com <- many $ noneOf (sepChar c) + ; char chr + ; return $ ("",com,"") + } +-- | Combines the template parsers +templateParser :: Config -> Parser [(String,String,String)] +templateParser c = many (templateStringParser c) + +-- | Actually runs the template parsers +parseTemplate :: Config -> String -> IO [(String,String,String)] +parseTemplate config s = + case (parse (templateParser config) "" s) of + Left _ -> return [("","","")] + Right x -> return x + @@ -13,96 +13,48 @@ -- ----------------------------------------------------------------------------- -module Main ( -- * Configuration - -- $config - Config (..) - -- * Main Stuff - -- $main - , Xbar - , runXMobar - , main - , eventLoop - , createWin +module XMobar (-- * Main Stuff + -- $main + Xbar + , runXMobar + , eventLoop + , createWin -- * Printing -- $print - , drawInWin - , printStrings + , drawInWin + , printStrings -- * Program Execution -- $commands - , getOptions - , execCommands - , execCommand - , runCommandLoop - , readVariables - -- * Parsing - -- $parser - , parseString - , stringParser - , defaultColors - , colorsAndText - , templateStringParser - , templateCommandParser - , templateParser - , parseTemplate + , getOptions + , execCommands + , execCommand + , runCommandLoop + , readVariables -- * Unmamaged Windows -- $unmanwin - , mkUnmanagedWindow + , mkUnmanagedWindow -- * Useful Utilities - , readConfig - , initColor - , io - ) where + , initColor + , io + ) where import Graphics.X11.Xlib import Graphics.X11.Xlib.Misc -import Text.ParserCombinators.Parsec - import Control.Monad.State import Control.Monad.Reader import Control.Concurrent -import System.Environment import System.Process import System.Exit import System.IO (hClose, hGetLine) --- $config --- Configuration data type and default configuration - --- | The configuration data type -data Config = - Config { fonts :: String -- ^ Fonts - , 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 - , hight :: Int -- ^ Window hight - , align :: String -- ^ text alignment - , refresh :: Int -- ^ Refresh rate in tenth of seconds - , commands :: [(String, Int, [String])] -- ^ For setting the refresh rate and - -- options for the programs to run (optionals) - , sepChar :: String -- ^ The character to be used for indicating - -- commands in the output template (default '%') - , template :: String -- ^ The output template - } deriving (Eq, Show, Read, Ord) +import Config +import Parsers -defaultConfig :: Config -defaultConfig = - Config { fonts = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , bgColor = "#000000" - , fgColor = "#BFBFBF" - , xPos = 0 - , yPos = 0 - , width = 1024 - , hight = 15 - , align = "left" - , refresh = 10 - , commands = [("date", 10, [])] - , sepChar = "%" - , template = "Uptime: <fc=#00FF00>%uptime%</fc> ** <fc=#FF0000>%date%</fc>" - } +-- $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) @@ -114,30 +66,15 @@ data XState = , window :: Window , vars :: [(ThreadId, MVar String)] } --- $main -- | 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. +-- 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 main entry point -main :: IO () -main = - do args <- getArgs - config <- - if length args /= 1 - then do putStrLn ("No configuration file specified. Using default settings.") - return defaultConfig - else readConfig (args!!0) - cl <- parseTemplate config (template config) - var <- execCommands config cl - (d,w) <- createWin config - runXMobar config var d w eventLoop - -- | The event loop eventLoop :: Xbar () eventLoop = @@ -284,74 +221,6 @@ readVariables ((_,v):xs) = fs <- readVariables xs return $! f ++ fs -{- $parser -These are the neede parsers. Don't trust them too much. - -There are parsers for the commands output and parsers for the -formatting template. - -} - --- | Runs the actual string parsers -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 - --- | Gets the string and combines the needed parsers -stringParser :: Config -> Parser [(String, String)] -stringParser c = manyTill (colorsAndText c <|> defaultColors c) eof - --- | Parses a string with the default color (no color set) -defaultColors :: Config -> Parser (String, String) -defaultColors config = - do { s <- many $ noneOf "<" - ; return (s,(fgColor config)) - } - <|> colorsAndText config - --- | Parses a string with a color set -colorsAndText :: Config -> Parser (String, String) -colorsAndText config = - do { string "<fc=#" - ; n <- count 6 hexDigit - ; string ">" - ; s <- many $ noneOf "<" - ; string "</fc>" - ; return (s,"#"++n) - } - <|> defaultColors config - --- | 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) - ; return (s, com, ss) - } - --- | Parses the command part of the template string -templateCommandParser :: Config -> Parser (String,String,String) -templateCommandParser c = - do { let chr = head $ sepChar c - ; char chr - ; com <- many $ noneOf (sepChar c) - ; char chr - ; return $ ("",com,"") - } --- | Combines the template parsers -templateParser :: Config -> Parser [(String,String,String)] -templateParser c = many (templateStringParser c) - --- | Actually runs the template parsers -parseTemplate :: Config -> String -> IO [(String,String,String)] -parseTemplate config s = - case (parse (templateParser config) "" s) of - Left _ -> return [("","","")] - Right x -> return x - {- $unmanwin This is a way to create unmamaged window. It was a mistery in Haskell. @@ -372,27 +241,17 @@ mkUnmanagedWindow :: Display mkUnmanagedWindow dpy scr rw x y w h = do let visual = defaultVisualOfScreen scr attrmask = cWOverrideRedirect - window <- allocaSetWindowAttributes $ - \attributes -> do - set_override_redirect attributes True - createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) - inputOutput visual attrmask attributes - return window + 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. -} --- | Reads the configuration files or quits with an error -readConfig :: FilePath -> IO Config -readConfig f = - do s <- readFile f - case reads s of - [(config,_)] -> return config - [] -> error ("Corrupt config file: " ++ f) - _ -> error ("Some problem occured. Aborting...") - - -- | Get the Pixel value for a named color initColor :: Display -> String -> IO Pixel initColor dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c diff --git a/xmobar.cabal b/xmobar.cabal index 10e555a..0fa9b53 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,5 +1,5 @@ name: xmobar -version: 0.1 +version: 0.3 homepage: http://gorgias.mine.nu/repos/xmobar/ synopsis: A Statusbar for the XMonad Window Manager description: Xmobar is a minimal status bar for the XMonad Window Manager. @@ -13,7 +13,9 @@ maintainer: andrea.rossato@unibz.it build-depends: base>=2.0, X11>=1.2.1, mtl>=1.0, unix>=1.0, parsec>=2.0 executable: xmobar -main-is: xmobar.hs +main-is: Main.hs +Hs-Source-Dirs: ./ +Other-Modules: XMobar, Config, Parsers ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded ghc-prof-options: -prof -auto-all |