diff options
Diffstat (limited to 'Main.hs')
| -rw-r--r-- | Main.hs | 164 |
1 files changed, 0 insertions, 164 deletions
diff --git a/Main.hs b/Main.hs deleted file mode 100644 index 2719a79..0000000 --- a/Main.hs +++ /dev/null @@ -1,164 +0,0 @@ -{-# 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 |