diff options
| -rw-r--r-- | app/Main.hs | 154 | ||||
| -rw-r--r-- | src/Xmobar/App/Main.hs | 48 | ||||
| -rw-r--r-- | src/Xmobar/App/Opts.hs | 109 | ||||
| -rw-r--r-- | xmobar.cabal | 8 |
4 files changed, 172 insertions, 147 deletions
diff --git a/app/Main.hs b/app/Main.hs index fb1a7ca..3c17447 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -17,16 +17,13 @@ module Main (main) where import Data.List (intercalate) -import Data.Version (showVersion) -import System.Console.GetOpt -import System.Exit import System.Environment (getArgs) import Control.Monad (unless) -import Text.Read (readMaybe) import System.Posix.Files (fileExist) import Xmobar -import Paths_xmobar (version) +import Xmobar.App.Main +import Xmobar.App.Opts -- $main @@ -41,6 +38,15 @@ main = do "Fields missing from config defaulted: " ++ intercalate "," defaultings doOpts c o >>= xmobar +-- | Read default configuration file or load the default config +defConfig :: String -> IO (Config,[String]) +defConfig msg = do + xdgConfigFile <- xmobarConfigFile + xdgConfigFileExists <- fileExist xdgConfigFile + if xdgConfigFileExists + then config xdgConfigFile msg + else return (defaultConfig,[]) + config :: FilePath -> String -> IO (Config,[String]) config f msg = do let err m = error $ f ++ ": " ++ m @@ -51,141 +57,3 @@ config f msg = do case r of Left e -> err (show e) Right res -> return res - --- | Read default configuration file or load the default config -defConfig :: String -> IO (Config,[String]) -defConfig msg = do - xdgConfigFile <- xmobarConfigFile - xdgConfigFileExists <- fileExist xdgConfigFile - if xdgConfigFileExists - then config xdgConfigFile msg - else return (defaultConfig,[]) - -data Opts = Help - | Debug - | Version - | Font String - | BgColor String - | FgColor String - | Alpha String - | T - | B - | D - | AlignSep String - | Commands String - | AddCommand String - | SepChar String - | Template String - | OnScr String - | IconRoot String - | Position String - | WmClass String - | WmName String - deriving (Show, Eq) - -options :: [OptDescr Opts] -options = - [ Option "h?" ["help"] (NoArg Help) "This help" - , Option "D" ["debug"] (NoArg Debug) "Emit verbose debugging messages" - , Option "V" ["version"] (NoArg Version) "Show version information" - , Option "f" ["font"] (ReqArg Font "font name") "Font name" - , Option "w" ["wmclass"] (ReqArg WmClass "class") "X11 WM_CLASS property" - , Option "n" ["wmname"] (ReqArg WmName "name") "X11 WM_NAME property" - , 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 "i" ["iconroot"] (ReqArg IconRoot "path") - "Root directory for icon pattern paths. Default '.'" - , Option "A" ["alpha"] (ReqArg Alpha "alpha") - "Transparency: 0 is transparent, 255 is opaque. Default: 255" - , 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 "d" ["dock"] (NoArg D) - "Don't override redirect from WM and function as a dock" - , Option "a" ["alignsep"] (ReqArg AlignSep "alignsep") - "Separators for left, center and right text\nalignment. Default: '}{'" - , Option "s" ["sepchar"] (ReqArg SepChar "char") - ("Character used to separate commands in" ++ - "\nthe output template. Default '%'") - , Option "t" ["template"] (ReqArg Template "template") - "Output template" - , Option "c" ["commands"] (ReqArg Commands "commands") - "List of commands to be executed" - , Option "C" ["add-command"] (ReqArg AddCommand "command") - "Add to the list of commands to be executed" - , Option "x" ["screen"] (ReqArg OnScr "screen") - "On which X screen number to start" - , Option "p" ["position"] (ReqArg Position "position") - "Specify position of xmobar. Same syntax as in config file" - ] - -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 - 2018 Jose A Ortega Ruiz\n " - ++ mail ++ "\n" ++ license - -mail :: String -mail = "<mail@jao.io>" - -license :: String -license = "\nThis program is distributed in the hope that it will be useful," ++ - "\nbut WITHOUT ANY WARRANTY; without even the implied warranty of" ++ - "\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." ++ - "\nSee the License for more details." - -doOpts :: Config -> [Opts] -> IO Config -doOpts conf [] = - return (conf {lowerOnStart = lowerOnStart conf && overrideRedirect conf}) -doOpts conf (o:oo) = - case o of - Help -> putStr usage >> exitSuccess - Version -> putStrLn info >> exitSuccess - Debug -> doOpts' conf - Font s -> doOpts' (conf {font = s}) - WmClass s -> doOpts' (conf {wmClass = s}) - WmName s -> doOpts' (conf {wmName = s}) - BgColor s -> doOpts' (conf {bgColor = s}) - FgColor s -> doOpts' (conf {fgColor = s}) - Alpha n -> doOpts' (conf {alpha = read n}) - T -> doOpts' (conf {position = Top}) - B -> doOpts' (conf {position = Bottom}) - D -> doOpts' (conf {overrideRedirect = False}) - AlignSep s -> doOpts' (conf {alignSep = s}) - SepChar s -> doOpts' (conf {sepChar = s}) - Template s -> doOpts' (conf {template = s}) - IconRoot s -> doOpts' (conf {iconRoot = s}) - OnScr n -> doOpts' (conf {position = OnScreen (read n) $ position conf}) - Commands s -> case readCom 'c' s of - Right x -> doOpts' (conf {commands = x}) - Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) - AddCommand s -> case readCom 'C' s of - Right x -> doOpts' (conf {commands = commands conf ++ x}) - Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) - Position s -> readPosition s - where readCom c 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] - doOpts' c = doOpts c oo - readPosition string = - case readMaybe string of - Just x -> doOpts' (conf { position = x }) - Nothing -> do - putStrLn "Can't parse position option, ignoring" - doOpts' conf diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs index 34d73e5..efc2753 100644 --- a/src/Xmobar/App/Main.hs +++ b/src/Xmobar/App/Main.hs @@ -15,10 +15,12 @@ ------------------------------------------------------------------------------ -module Xmobar.App.Main (xmobar) where +module Xmobar.App.Main (xmobar, doOpts) where import Data.Foldable (for_) import qualified Data.Map as Map +import System.Exit +import Text.Read (readMaybe) import Graphics.X11.Xlib import Control.Concurrent.Async (Async, cancel) @@ -30,6 +32,7 @@ import Xmobar.Run.Template import Xmobar.X11.Types import Xmobar.X11.Text import Xmobar.X11.Window +import Xmobar.App.Opts import Xmobar.App.EventLoop (startLoop, startCommand) xmobar :: Config -> IO () @@ -54,3 +57,46 @@ cleanupThreads :: [[([Async ()], a)]] -> IO () cleanupThreads vars = for_ (concat vars) $ \(asyncs, _) -> for_ asyncs cancel + +doOpts :: Config -> [Opts] -> IO Config +doOpts conf [] = + return (conf {lowerOnStart = lowerOnStart conf && overrideRedirect conf}) +doOpts conf (o:oo) = + case o of + Help -> putStr usage >> exitSuccess + Version -> putStrLn info >> exitSuccess + Debug -> doOpts' conf + Font s -> doOpts' (conf {font = s}) + WmClass s -> doOpts' (conf {wmClass = s}) + WmName s -> doOpts' (conf {wmName = s}) + BgColor s -> doOpts' (conf {bgColor = s}) + FgColor s -> doOpts' (conf {fgColor = s}) + Alpha n -> doOpts' (conf {alpha = read n}) + T -> doOpts' (conf {position = Top}) + B -> doOpts' (conf {position = Bottom}) + D -> doOpts' (conf {overrideRedirect = False}) + AlignSep s -> doOpts' (conf {alignSep = s}) + SepChar s -> doOpts' (conf {sepChar = s}) + Template s -> doOpts' (conf {template = s}) + IconRoot s -> doOpts' (conf {iconRoot = s}) + OnScr n -> doOpts' (conf {position = OnScreen (read n) $ position conf}) + Commands s -> case readCom 'c' s of + Right x -> doOpts' (conf {commands = x}) + Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) + AddCommand s -> case readCom 'C' s of + Right x -> doOpts' (conf {commands = commands conf ++ x}) + Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) + Position s -> readPosition s + where readCom c 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] + doOpts' c = doOpts c oo + readPosition string = + case readMaybe string of + Just x -> doOpts' (conf { position = x }) + Nothing -> do + putStrLn "Can't parse position option, ignoring" + doOpts' conf diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs new file mode 100644 index 0000000..842744b --- /dev/null +++ b/src/Xmobar/App/Opts.hs @@ -0,0 +1,109 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.App.Opts +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Fri Nov 30, 2018 01:19 +-- +-- +-- Command line option parsing +-- +------------------------------------------------------------------------------ + + +module Xmobar.App.Opts where + +import System.Console.GetOpt +import Data.Version (showVersion) + +import Paths_xmobar (version) + +data Opts = Help + | Debug + | Version + | Font String + | BgColor String + | FgColor String + | Alpha String + | T + | B + | D + | AlignSep String + | Commands String + | AddCommand String + | SepChar String + | Template String + | OnScr String + | IconRoot String + | Position String + | WmClass String + | WmName String + deriving (Show, Eq) + +options :: [OptDescr Opts] +options = + [ Option "h?" ["help"] (NoArg Help) "This help" + , Option "D" ["debug"] (NoArg Debug) "Emit verbose debugging messages" + , Option "V" ["version"] (NoArg Version) "Show version information" + , Option "f" ["font"] (ReqArg Font "font name") "Font name" + , Option "w" ["wmclass"] (ReqArg WmClass "class") "X11 WM_CLASS property" + , Option "n" ["wmname"] (ReqArg WmName "name") "X11 WM_NAME property" + , 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 "i" ["iconroot"] (ReqArg IconRoot "path") + "Root directory for icon pattern paths. Default '.'" + , Option "A" ["alpha"] (ReqArg Alpha "alpha") + "Transparency: 0 is transparent, 255 is opaque. Default: 255" + , 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 "d" ["dock"] (NoArg D) + "Don't override redirect from WM and function as a dock" + , Option "a" ["alignsep"] (ReqArg AlignSep "alignsep") + "Separators for left, center and right text\nalignment. Default: '}{'" + , Option "s" ["sepchar"] (ReqArg SepChar "char") + ("Character used to separate commands in" ++ + "\nthe output template. Default '%'") + , Option "t" ["template"] (ReqArg Template "template") + "Output template" + , Option "c" ["commands"] (ReqArg Commands "commands") + "List of commands to be executed" + , Option "C" ["add-command"] (ReqArg AddCommand "command") + "Add to the list of commands to be executed" + , Option "x" ["screen"] (ReqArg OnScr "screen") + "On which X screen number to start" + , Option "p" ["position"] (ReqArg Position "position") + "Specify position of xmobar. Same syntax as in config file" + ] + +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 - 2018 Jose A Ortega Ruiz\n " + ++ mail ++ "\n" ++ license + +mail :: String +mail = "<mail@jao.io>" + +license :: String +license = "\nThis program is distributed in the hope that it will be useful," ++ + "\nbut WITHOUT ANY WARRANTY; without even the implied warranty of" ++ + "\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." ++ + "\nSee the License for more details." diff --git a/xmobar.cabal b/xmobar.cabal index 874b1f4..1ab39a3 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -95,15 +95,17 @@ library hs-source-dirs: src exposed-modules: Xmobar + Xmobar.App.Main + Xmobar.App.Opts - other-modules: Xmobar.Config.Types, + other-modules: Paths_xmobar, + Xmobar.Config.Types, Xmobar.Config.Parse, Xmobar.Run.Types, Xmobar.Run.Template, Xmobar.Run.Commands, Xmobar.Run.Runnable Xmobar.App.EventLoop, - Xmobar.App.Main, Xmobar.App.Config, Xmobar.App.Compile, Xmobar.System.Utils, @@ -258,7 +260,7 @@ library executable xmobar hs-source-dirs: app main-is: Main.hs - other-modules: Paths_xmobar +-- other-modules: Paths_xmobar build-depends: base, containers, async, |