diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..2719a79 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : Xmobar.Main +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- The main module of Xmobar, a text based status bar +-- +----------------------------------------------------------------------------- + +module Main ( -- * Main Stuff + -- $main + main + , readConfig + , readDefaultConfig + ) where + +import Xmobar +import Parsers +import Config +import XUtil + +import Data.List (intercalate) + +import Paths_xmobar (version) +import Data.IORef +import Data.Version (showVersion) +import Graphics.X11.Xlib +import System.Console.GetOpt +import System.Exit +import System.Environment +import System.Posix.Files +import Control.Monad (unless) + +-- $main + +-- | The main entry point +main :: IO () +main = do + d <- openDisplay "" + args <- getArgs + (o,file) <- getOpts args + (c,defaultings) <- case file of + [cfgfile] -> readConfig cfgfile + _ -> readDefaultConfig + + unless (null defaultings) $ putStrLn $ "Fields missing from config defaulted: " + ++ intercalate "," defaultings + + -- 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 + fs <- initFont d (font conf) + cl <- parseTemplate conf (template conf) + vars <- mapM startCommand cl + (r,w) <- createWin d fs conf + eventLoop (XConf d r w fs conf) vars + +-- | Reads the configuration files or quits with an error +readConfig :: FilePath -> IO (Config,[String]) +readConfig f = do + file <- io $ fileExist f + s <- io $ if file then readFileSafe f else error $ f ++ ": file not found!\n" ++ usage + either (\err -> error $ f ++ ": configuration file contains errors at:\n" ++ show err) + return $ parseConfig s + +-- | Read default configuration file or load the default config +readDefaultConfig :: IO (Config,[String]) +readDefaultConfig = do + home <- io $ getEnv "HOME" + let path = home ++ "/.xmobarrc" + f <- io $ fileExist path + if f then readConfig path else return (defaultConfig,[]) + +data Opts = Help + | Version + | Font String + | BgColor String + | FgColor String + | T + | B + | AlignSep String + | Commands String + | SepChar String + | Template String + | OnScr 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 ['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 "template" ) "The output template" + , Option ['c' ] ["commands" ] (ReqArg Commands "commands" ) "The list of commands to be executed" + , Option ['x' ] ["screen" ] (ReqArg OnScr "screen" ) "On which X screen number to start" + ] + +getOpts :: [String] -> IO ([Opts], [String]) +getOpts argv = + case getOpt Permute options argv of + (o,n,[]) -> return (o,n) + (_,_,errs) -> error (concat errs ++ usage) + +usage :: String +usage = (usageInfo header options) ++ footer + where header = "Usage: xmobar [OPTION...] [FILE]\nOptions:" + footer = "\nMail bug reports and suggestions to " ++ mail ++ "\n" + +info :: String +info = "xmobar " ++ showVersion version + ++ "\n (C) 2007 - 2010 Andrea Rossato " + ++ "\n (C) 2010 Jose A Ortega Ruiz\n " + ++ mail ++ "\n" ++ license + +mail :: String +mail = "<xmobar@projects.haskell.org>" + +license :: String +license = "\nThis program is distributed in the hope that it will be useful,\n" ++ + "but WITHOUT ANY WARRANTY; without even the implied warranty of\n" ++ + "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n" ++ + "See the License for more details." + +doOpts :: IORef Config -> [Opts] -> IO () +doOpts _ [] = return () +doOpts conf (o:oo) = + case o of + Help -> putStr usage >> exitWith ExitSuccess + Version -> putStrLn info >> 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 + OnScr n -> modifyIORef conf (\c -> c { position = OnScreen (read n) $ position c }) >> go + Commands s -> case readCom s of + 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" + readStr str = + [x | (x,t) <- reads str, ("","") <- lex t] + go = doOpts conf oo |