1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.Opts
-- Copyright: (c) 2018, 2019, 2020, 2022 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 ( recompileFlag
, verboseFlag
, getOpts
, doOpts) where
import Control.Monad (when)
import System.Console.GetOpt
import System.Exit (exitSuccess, exitWith, ExitCode(..))
import Data.Version (showVersion)
import Text.Read (readMaybe)
import Paths_xmobar (version)
import Xmobar.Config.Types
data Opts = Help
| Verbose
| Recompile
| Version
| TextOutput (Maybe String)
| Font String
| AddFont 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 "v" ["verbose"] (NoArg Verbose) "Emit verbose debugging messages"
, Option "r" ["recompile"] (NoArg Recompile) "Force recompilation"
, Option "V" ["version"] (NoArg Version) "Show version information"
, Option "T" ["text"] (OptArg TextOutput "color")
"Write text-only output to stdout. Plain/Ansi/Pango/Swaybar"
, Option "f" ["font"] (ReqArg Font "font name") "Font name"
, Option "N" ["add-font"] (ReqArg AddFont "font name")
"Add to the list of additional fonts"
, 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 = do
(o,n) <- case getOpt Permute options argv of
(o,n,[]) -> return (o,n)
(_,_,errs) -> error (concat errs ++ usage)
when (Help `elem` o) (putStr usage >> exitSuccess)
when (Version `elem` o) (putStr info >> exitSuccess)
return (o, n)
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) 2010 - 2022 Jose A Ortega Ruiz"
++ "\n (C) 2007 - 2010 Andrea Rossato\n "
++ mail ++ "\n" ++ license ++ "\n"
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 -> doOpts' conf
Version -> doOpts' conf
Recompile -> doOpts' conf
TextOutput s -> doOpts' $ case s of
Just fmt -> conf {textOutput = True,
textOutputFormat = read fmt}
Nothing -> conf {textOutput = True}
Verbose -> doOpts' (conf {verbose = True})
Font s -> doOpts' (conf {font = s})
AddFont s -> doOpts' (conf {additionalFonts = additionalFonts conf ++ [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
recompileFlag :: [Opts] -> Bool
recompileFlag = elem Recompile
verboseFlag :: [Opts] -> Bool
verboseFlag = elem Verbose
|
