summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Config.hs58
-rw-r--r--Main.hs51
-rw-r--r--Parsers.hs99
-rw-r--r--XMobar.hs (renamed from xmobar.hs)201
-rw-r--r--xmobar.cabal6
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>"
+ }
+
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..ca2b92f
--- /dev/null
+++ b/Main.hs
@@ -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
+
diff --git a/xmobar.hs b/XMobar.hs
index 088efe0..9bc982e 100644
--- a/xmobar.hs
+++ b/XMobar.hs
@@ -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