diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 79 | ||||
| -rw-r--r-- | src/Plugins/XMonadLog.hs | 8 |
2 files changed, 47 insertions, 40 deletions
diff --git a/src/Main.hs b/src/Main.hs index 364fa02..4c3f351 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -92,32 +92,34 @@ readDefaultConfig = do data Opts = Help | Version - | Font String - | BgColor String - | FgColor String + | Font String + | BgColor String + | FgColor String | T | B - | AlignSep String - | Commands String - | SepChar String - | Template String - | OnScr String + | AlignSep String + | Commands String + | AddCommand 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" + [ 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 ['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" ] getOpts :: [String] -> IO ([Opts], [String]) @@ -150,23 +152,26 @@ doOpts :: Config -> [Opts] -> IO Config doOpts conf [] = return conf doOpts conf (o:oo) = case o of - Help -> putStr usage >> exitWith ExitSuccess - Version -> putStrLn info >> exitWith ExitSuccess - Font s -> doOpts (conf {font = s }) oo - BgColor s -> doOpts (conf {bgColor = s }) oo - FgColor s -> doOpts (conf {fgColor = s }) oo - T -> doOpts (conf {position = Top }) oo - B -> doOpts (conf {position = Bottom}) oo - AlignSep s -> doOpts (conf {alignSep = s }) oo - SepChar s -> doOpts (conf {sepChar = s }) oo - Template s -> doOpts (conf {template = s }) oo - OnScr n -> doOpts (conf {position = OnScreen (read n) $ position conf}) oo - Commands s -> case readCom s of - Right x -> doOpts (conf { commands = x }) oo - Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) - where readCom str = + Help -> putStr usage >> exitWith ExitSuccess + Version -> putStrLn info >> exitWith ExitSuccess + Font s -> doOpts (conf {font = s }) oo + BgColor s -> doOpts (conf {bgColor = s }) oo + FgColor s -> doOpts (conf {fgColor = s }) oo + T -> doOpts (conf {position = Top }) oo + B -> doOpts (conf {position = Bottom}) oo + AlignSep s -> doOpts (conf {alignSep = s }) oo + SepChar s -> doOpts (conf {sepChar = s }) oo + Template s -> doOpts (conf {template = s }) oo + OnScr n -> doOpts (conf {position = OnScreen (read n) $ position conf}) oo + Commands s -> case readCom 'c' s of + Right x -> doOpts (conf { commands = x }) oo + Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) + AddCommand s -> case readCom 'C' s of + Right x -> doOpts (conf { commands = commands conf ++ x }) oo + Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) + where readCom c str = case readStr str of - [x] -> Right x - _ -> Left "xmobar: cannot read list of commands specified with the -c option\n" + [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] diff --git a/src/Plugins/XMonadLog.hs b/src/Plugins/XMonadLog.hs index 3461e26..1403800 100644 --- a/src/Plugins/XMonadLog.hs +++ b/src/Plugins/XMonadLog.hs @@ -30,17 +30,19 @@ import Foreign.C (CChar) import XUtil (nextEvent') -data XMonadLog = XMonadLog | XPropertyLog String +data XMonadLog = XMonadLog | XPropertyLog String | NamedXPropertyLog String String deriving (Read, Show) instance Exec XMonadLog where alias XMonadLog = "XMonadLog" alias (XPropertyLog atom) = atom + alias (NamedXPropertyLog _ name) = name start x cb = do let atom = case x of - XMonadLog -> "_XMONAD_LOG" - XPropertyLog a -> a + XMonadLog -> "_XMONAD_LOG" + XPropertyLog a -> a + NamedXPropertyLog a _ -> a d <- openDisplay "" xlog <- internAtom d atom False |