summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2012-04-11 09:15:50 -0700
committerjao <jao@gnu.org>2012-04-11 09:15:50 -0700
commit247e5b85bb53ba229b444082fd2d6b7261617014 (patch)
tree103d28b189e258f38cdfbfe5732624cd1713338d /src
parentac1fa917952057fb6950c0979cd8dcd308440551 (diff)
parent61c5e62376cce56247e1e709ed41896a014b7b69 (diff)
downloadxmobar-247e5b85bb53ba229b444082fd2d6b7261617014.tar.gz
xmobar-247e5b85bb53ba229b444082fd2d6b7261617014.tar.bz2
Merge pull request #41 from mathstuf/dev/add-incremental-config-option
dev/add-incremental-config-option
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs79
-rw-r--r--src/Plugins/XMonadLog.hs8
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