summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs79
-rw-r--r--src/Plugins/Monitors/Disk.hs3
-rw-r--r--src/Plugins/XMonadLog.hs8
-rw-r--r--src/StatFS.hsc4
4 files changed, 50 insertions, 44 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/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs
index 461663d..dca268d 100644
--- a/src/Plugins/Monitors/Disk.hs
+++ b/src/Plugins/Monitors/Disk.hs
@@ -83,8 +83,7 @@ fsStats path = do
Nothing -> return [-1, -1, -1]
Just f -> let tot = fsStatByteCount f
free = fsStatBytesAvailable f
- used = fsStatBytesUsed f
- in return [tot, free, used]
+ in return [tot, free, (tot - free)]
speedToStr :: Float -> String
speedToStr = showWithUnits 2 1
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
diff --git a/src/StatFS.hsc b/src/StatFS.hsc
index d785b89..d007d08 100644
--- a/src/StatFS.hsc
+++ b/src/StatFS.hsc
@@ -58,7 +58,7 @@ foreign import ccall unsafe "sys/vfs.h statfs64"
#endif
c_statfs :: CString -> Ptr CStatfs -> IO CInt
-toI :: CLong -> Integer
+toI :: CULong -> Integer
toI = toInteger
getFileSystemStats :: String -> IO (Maybe FileSystemStats)
@@ -79,5 +79,5 @@ getFileSystemStats path =
, fsStatByteCount = toI bcount * bpb
, fsStatBytesFree = toI bfree * bpb
, fsStatBytesAvailable = toI bavail * bpb
- , fsStatBytesUsed = toI (bcount - bfree) * bpb
+ , fsStatBytesUsed = toI (bcount - bavail) * bpb
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-30 23:11:27 +0000