xmobar 0.12 → 0.13
raw patch · 20 files changed
+667/−291 lines, 20 filesdep +alsa-mixer
Dependencies added: alsa-mixer
Files
- NEWS +47/−1
- README +93/−28
- samples/xmonadpropwrite.hs +41/−0
- src/Commands.hs +1/−3
- src/Main.hs +31/−20
- src/Plugins/Mail.hs +3/−2
- src/Plugins/Monitors.hs +71/−52
- src/Plugins/Monitors/Batt.hs +39/−35
- src/Plugins/Monitors/Common.hs +3/−30
- src/Plugins/Monitors/Cpu.hs +22/−12
- src/Plugins/Monitors/Disk.hs +21/−10
- src/Plugins/Monitors/MPD.hs +1/−10
- src/Plugins/Monitors/MultiCpu.hs +17/−7
- src/Plugins/Monitors/Net.hs +40/−24
- src/Plugins/Monitors/ThermalZone.hs +43/−0
- src/Plugins/Monitors/Volume.hs +124/−0
- src/Plugins/StdinReader.hs +2/−1
- src/StatFS.hsc +3/−3
- src/Xmobar.hs +52/−50
- xmobar.cabal +13/−3
NEWS view
@@ -1,12 +1,58 @@ % xmobar - Release notes % Jose A. Ortega Ruiz +## Version 0.13 (March 28, 2011)++_New features_++ - New `Volume` monitor displaying ALSA soundcards information, by+ Thomas Tuegel.+ - New `ThermalZone` plugin substituting `Thermal` and using linux's+ *sysfs* interface (you need this one if you're using a kernel+ version equal to or above 2.6.37). See [issue 44].+ - xmobar app new has WM_CLASS, WM_NAME and _NET_WM_PID xprops+ ([issue 38]).++_Incompatible changes_++ - The MPD plugin does not accept host and port options anymore: use+ the environment variables MPD_HOST and MPD_PORT instead.+ - The `Mail` plugin now takes a second parameter (a string)+ specifying its alias. As a side-effect, this solves [issue 30].++_Bug fixes_++ - [issue 14]: `StdinReader` and other plugins accepting external+ input don't get confused anymore when characters from `alignSep`+ appear in their input.+ - [issue 27]: `BottomSize` placement now respects its width argument.+ - [issue 28]: Compilation in Mac OS X fixed.+ - [issue 30]: `Mail` plugin can be specified anywhere in commands list.+ - [issue 36]: Battery monitor now supports non-standard locations of+ the `/sys/class/power_supply/AC/online` file.+ - [issue 40]: Battery monitor now supports the new power_now, that+ replaces current_now in linux kernels for v. 2.36 and above.+ - [issue 42]: More accurate net monitor rates.+ - DiskIO, Cpu and MultiCpu monitors are also more accurate now.+ - Text is now correctly centered vertically.+ - `FullBM` border spec fixed.++[issue 14]: http://code.google.com/p/xmobar/issues/detail?id=14+[issue 27]: http://code.google.com/p/xmobar/issues/detail?id=27+[issue 28]: http://code.google.com/p/xmobar/issues/detail?id=28+[issue 30]: http://code.google.com/p/xmobar/issues/detail?id=30+[issue 36]: http://code.google.com/p/xmobar/issues/detail?id=36+[issue 38]: http://code.google.com/p/xmobar/issues/detail?id=38+[issue 40]: http://code.google.com/p/xmobar/issues/detail?id=40+[issue 42]: http://code.google.com/p/xmobar/issues/detail?id=42+[issue 44]: http://code.google.com/p/xmobar/issues/detail?id=44+ ## Version 0.12 (Dec 24, 2010) xmobar has a new [maintainer], a new [website], a new [mailing list] and uses a new [source code repository]. -Many thanks to Andrea Rossato, xombar's author and maintainer so far,+Many thanks to Andrea Rossato, xmobar's author and maintainer so far, for creating xmobar in the first place, and for giving me the chance to become its maintainer. And a big thanks to Ben Boeckel, Petr Rockai and Norbert Zeh for their patches.
README view
@@ -12,7 +12,7 @@ features, like dynamic color management, output templates, and extensibility through plugins. -This page documents xmobar 0.12 (see [release notes]).+This page documents xmobar 0.13 (see [release notes]). [This is a screen shot] of Andrea's desktop with [xmonad] and xmobar. [This] is xmobar running under [sawfish], with antialiased fonts. And@@ -46,7 +46,7 @@ If you don't have `cabal-install` installed, you can get xmobar's source code in a variety of ways: - - From [Hackage]. Just download [xmobar-0.12.tar.gz] from xmobar's+ - From [Hackage]. Just download [xmobar-0.13.tar.gz] from xmobar's hackage page. - From [Github]. You can also obtain a tarball in [Github's downloads page]. You'll find there links to each tagged release.@@ -55,13 +55,13 @@ git: git clone git://github.com/jaor/xmobar -[xmobar-0.12.tar.gz]: http://hackage.haskell.org/packages/archive/xmobar/0.12/xmobar-0.12.tar.gz+[xmobar-0.13.tar.gz]: http://hackage.haskell.org/packages/archive/xmobar/0.13/xmobar-0.13.tar.gz [Github's downloads page]: https://github.com/jaor/xmobar/downloads To install simply run (if needed): - tar xvfz xmobar-0.12- cd xmobar-0.12+ tar xvfz xmobar-0.13+ cd xmobar-0.13 If you have cabal installed, you can now use it from within xmobar's source tree. Otherwise, run the configure script:@@ -120,6 +120,10 @@ headers in your system (e.g., install `libiw-dev` in Debian-based systems). +`with_alsa`+: Support for ALSA sound cards. Enables the Volume plugin. Requires the+ [alsa-mixer] package.+ `all_extensions` : Enables all the extensions above. @@ -313,9 +317,9 @@ date plugin. These plugins install the following internal commands: `Weather`, `Network`, `Wireless` (optional), `Memory`, `Swap`, `Cpu`, `MultiCpu`, `Battery`, `TopProc`, `TopMem`, `DiskU`, `DiskIO`,-`Thermal`, `CpuFreq`, `CoreTemp`, `MPD` (optional), `Mail` (optional),-`MBox` (optional), `Date`, `Uptime`, `StdinReader`, `CommandReader`,-and `PipeReader`.+`Thermal`, `ThermalZone`, `CpuFreq`, `CoreTemp`, `Volume` (optional),+`MPD` (optional), `Mail` (optional), `MBox` (optional), `Date`,+`Uptime`, `StdinReader`, `CommandReader`, and `PipeReader`. To remove them see below Installing/Removing a Plugin @@ -435,6 +439,8 @@ - `-m`: color to display power lower than the `-H` threshold - `-h`: color to display power highter than the `-H` threshold - `-p`: color to display positive power (battery charging)+ - `-f`: file in `/sys/class/power_supply` with AC info (default:+ "AC/online") - Variables that can be used with the `-t`/`--template` argument: `left`, `leftbar`, `timeleft`, `watts`, `acstatus` - Default template: `Batt: <watts>, <left>% / <timeleft>`@@ -509,9 +515,28 @@ Disks [("/", "<read> <write>"), ("sdb1", "<total>")] [] 10 +`ThermalZone Number Args RefreshRate`++- Aliases to "thermaln": so `ThermalZone 0 []` can be used in template+ as `%thermal0%`+- Args: default monitor arguments (see below)+- Variables that can be used with the `-t`/`--template` argument:+ `temp`+- Default template: `<temp>C`+- This plugin works only on sytems with devices having thermal zone.+ Check directories in `/sys/class/thermal` for possible values of the+ zone number (e.g., 0 corresponds to `thermal_zone0` in that+ directory).+- Example:++ Run ThermalZone 0 ["-t","<id>: <temp>C"] 30+ `Thermal Zone Args RefreshRate` -- Aliases to the Zone: so `Zone "THRM" []` can be used in template as `%THRM%`+- **This plugin is deprecated. Use `ThermalZone` instead.**++- Aliases to the Zone: so `Thermal "THRM" []` can be used in template+ as `%THRM%` - Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `temp`@@ -520,7 +545,7 @@ Check directories in /proc/acpi/thermal_zone for possible values. - Example: - Run Thermal "THRM" ["-t","iwl4965-temp: <temp>C"]+ Run Thermal "THRM" ["-t","iwl4965-temp: <temp>C"] 50 `CpuFreq Args RefreshRate` @@ -549,6 +574,36 @@ "-L", "40", "-H", "60", "-l", "lightblue", "-n", "gray90", "-h", "red"] 50 +`Volume Mixer Element Args RefreshRate`++- Aliases to the mixer name and element name separated by a colon. Thus,+ `Volume "default" "Master" [] 10` can be used as `%default:Master%`.+- Args: default monitor arguments (see below). Also accepts:+ - `-O` _string_ On string+ - The string used in place of `<status>` when the mixer element+ is on. Defaults to "[on]".+ - Long option: `--on`+ - `-o` _string_ Off string+ - The string used in place of `<status>` when the mixer element+ is off. Defaults to "[off]".+ - Long option: `--off`+ - `-C` _color_ On color+ - The color to be used for `<status>` when the mixer element+ is on. Defaults to "green".+ - Long option: `--onc`+ - `-c` _color_ Off color+ - The color to be used for `<status>` when the mixer element+ is off. Defaults to "red".+ - Long option: `--offc`+ - `--highd` _number_ High threshold for dB. Defaults to -5.0.+ - `--lowd` _number_ Low threshold for dB. Defaults to -30.0.+- Variables that can be used with the `-t`/`--template` argument:+ `volume`, `volumebar`, `dB`, `status`+- Default template: `Vol: <volume>% <status>`+- Requires the package [alsa-mixer] installed in your system. In addition,+ to activate this plugin you must pass `--flags="with_alsa"` during+ compilation.+ `MPD Args RefreshRate` - This monitor will only be compiled if you ask for it using the@@ -556,9 +611,9 @@ - Aliases to `mpd` - Args: default monitor arguments (see below). In addition you can provide `-P`, `-S` and `-Z`, with an string argument, to represent the- playing, stopped and paused states in the `statei` template field,- and `-h`, `-p` and `-x` for the host, port and password (default- host is "localhost", port 6600 and empty password).+ playing, stopped and paused states in the `statei` template field.+ The environment variables `MPD_HOST` and `MPD_PORT` are used to configure the+ mpd server to communicate with. - Variables that can be used with the `-t`/`--template` argument: `bar`, `state`, `statei`, `volume`, `length` `lapsed`, `remaining`,@@ -573,16 +628,21 @@ "<composer> <title> (<album>) <track>/<plength> <statei> ", "--", "-P", ">>", "-Z", "|", "-S", "><"] 10 -`Mail Args`+`Mail Args Alias` -- Aliases to `Mail` - Args: list of maildirs in form- `[("name1","path1"),("name2","path2")]`. Paths may start with a '~'+ `[("name1","path1"),...]`. Paths may start with a '~' to expand to the user's home directory. - This plugin requires inotify support in your linux kernel and the [hinotify] package. To activate, pass `--flags="with_inotify"` during compilation.+- Example: + Run Mail [("inbox", "~/var/mail/inbox"),+ ("lists", "~/var/mail/lists")]+ "mail"++ `MBox Mboxes Opts Alias` - Mboxes a list of mbox files of the form `[("name", "path", "color")]`,@@ -613,10 +673,12 @@ - Aliases to `PropName` - Reads the X property named by `PropName` (a string) and displays its- value. The [xmonadpropwrite script] in xmobar's distribution can be- used to set the given property from the output of any other program- or script.+ value. The [samples/xmonadpropwrite.hs script] in xmobar's+ distribution can be used to set the given property from the output+ of any other program or script. +[samples/xmonadpropwrite.hs script]: https://github.com/jaor/xmobar/raw/master/samples/xmonadpropwrite.hs+ ## Monitor Plugins Commands Arguments These are the arguments that can be used for internal commands in the@@ -625,9 +687,10 @@ - `-t` _string_ Output template - Template for the monitor output. Field names must be enclosed between pointy brackets (`<foo>`) and will be substituted by the- computed values. You can also specify a foreground color for a- region bracketing it between `<fc=color>` and `</fc>`. The rest- of the template is output verbatim.+ computed values. You can also specify the foreground (and+ optionally, background) color for a region by bracketing it+ between `<fc=fgcolor>` (or `<fc=fgcolor,bgcolor>`) and+ `</fc>`. The rest of the template is output verbatim. - Long option: `--template` - Default value: per monitor (see above). - `-H` _number_ The high threshold.@@ -786,7 +849,7 @@ logHook = dynamicLogString defaultPP >>= xmonadPropLog } This plugin can be used as a sometimes more convenient alternative- to `StdinReader`. For it instance, allows you to (re)start xmobar+ to `StdinReader`. For instance, it allows you to (re)start xmobar outside xmonad. [here]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html@@ -919,11 +982,12 @@ Credits ======= -xmobar [incorporates patches] from Ben Boeckel, Roman Cheplyaka, John-Goerzen, Juraj Hercek, Tomas Janousek, Spencer Janssen, Krzysztof-Kosciuszkiewicz, Lennart Kolmodin, Dmitry Kurochkin, Svein Ove, Jens+xmobar [incorporates patches] by Ben Boeckel, Roman Cheplyaka, John+Goerzen, Juraj Hercek, Tomas Janousek, Spencer Janssen, Lennart+Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Svein Ove, Jens Petersen, Petr Rockai, Andrew Sackville-West, Alexander Solovyov,-Sergei Trofimovich, Jan Vornberger, Daniel Wagner and Norbert Zeh.+Sergei Trofimovich, Thomas Tuegel, Jan Vornberger, Daniel Wagner and+Norbert Zeh. [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors @@ -976,7 +1040,7 @@ Copyright © 2007-2010 Andrea Rossato -Copyright © 2010 Jose Antonio Ortega Ruiz+Copyright © 2010-2011 Jose Antonio Ortega Ruiz [Github]: http://github.com/jaor/xmobar/ [Github page]: http://github.com/jaor/xmobar@@ -991,3 +1055,4 @@ [libmpd]: http://hackage.haskell.org/package/libmpd/ [sawfish]: http://sawfish.wikia.com/ [utf8-string]: http://hackage.haskell.org/package/utf8-string/+[alsa-mixer]: http://hackage.haskell.org/package/alsa-mixer
+ samples/xmonadpropwrite.hs view
@@ -0,0 +1,41 @@+-- Copyright Spencer Janssen <spencerjanssen@gmail.com>+-- Tomas Janousek <tomi@nomi.cz>+-- BSD3 (see LICENSE)+--+-- Reads from standard input and writes to an X propery on root window.+-- To be used with XPropertyLog:+-- Add it to commands:+-- Run XPropertyLog "_XMONAD_LOG_CUSTOM"+-- Add it to the template:+-- template = "... %_XMONAD_LOG_CUSTOM% ..."+-- Run:+-- $ blah blah | xmonadpropwrite _XMONAD_LOG_CUSTOM++import Control.Monad+import Graphics.X11+import Graphics.X11.Xlib.Extras+import qualified Data.ByteString as B+import Foreign.C (CChar)+import System.IO+import System.Environment++main = do+ atom <- flip fmap getArgs $ \args -> case args of+ [a] -> a+ _ -> "_XMONAD_LOG"++ d <- openDisplay ""+ xlog <- internAtom d atom False+ ustring <- internAtom d "UTF8_STRING" False++ root <- rootWindow d (defaultScreen d)++ forever $ do+ msg <- B.getLine+ changeProperty8 d root xlog ustring propModeReplace (encodeCChar msg)+ sync d True++ return ()++encodeCChar :: B.ByteString -> [CChar]+encodeCChar = map fromIntegral . B.unpack
src/Commands.hs view
@@ -41,9 +41,7 @@ run _ = return "" start :: e -> (String -> IO ()) -> IO () start e cb = go- where go = do- run e >>= cb- tenthSeconds (rate e) >> go+ where go = run e >>= cb >> tenthSeconds (rate e) >> go data Command = Com Program Args Alias Rate deriving (Show,Read,Eq)
src/Main.hs view
@@ -28,7 +28,6 @@ import Data.List (intercalate) import Paths_xmobar (version)-import Data.IORef import Data.Version (showVersion) import Graphics.X11.Xlib import System.Console.GetOpt@@ -56,15 +55,28 @@ rootw <- rootWindow d (defaultScreen d) selectInput d rootw structureNotifyMask - civ <- newIORef c- doOpts civ o- conf <- readIORef civ+ conf <- doOpts c o fs <- initFont d (font conf)- cl <- parseTemplate conf (template conf)- vars <- mapM startCommand cl+ cls <- mapM (parseTemplate conf) (splitTemplate conf)+ vars <- mapM (mapM startCommand) cls (r,w) <- createWin d fs conf eventLoop (XConf d r w fs conf) vars +-- | Splits the template in its parts+splitTemplate :: Config -> [String]+splitTemplate conf =+ case break (==l) t of+ (le,_:re) -> case break (==r) re of+ (ce,_:ri) -> [le, ce, ri]+ _ -> def+ _ -> def+ where [l, r] = if length (alignSep conf) == 2+ then alignSep conf+ else alignSep defaultConfig+ t = template conf+ def = [t, "", ""]++ -- | Reads the configuration files or quits with an error readConfig :: FilePath -> IO (Config,[String]) readConfig f = do@@ -125,7 +137,7 @@ info :: String info = "xmobar " ++ showVersion version ++ "\n (C) 2007 - 2010 Andrea Rossato "- ++ "\n (C) 2010 Jose A Ortega Ruiz\n "+ ++ "\n (C) 2010 - 2011 Jose A Ortega Ruiz\n " ++ mail ++ "\n" ++ license mail :: String@@ -137,23 +149,23 @@ "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n" ++ "See the License for more details." -doOpts :: IORef Config -> [Opts] -> IO ()-doOpts _ [] = return ()+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 -> modifyIORef conf (\c -> c { font = s }) >> go- BgColor s -> modifyIORef conf (\c -> c { bgColor = s }) >> go- FgColor s -> modifyIORef conf (\c -> c { fgColor = s }) >> go- T -> modifyIORef conf (\c -> c { position = Top }) >> go- B -> modifyIORef conf (\c -> c { position = Bottom}) >> go- AlignSep s -> modifyIORef conf (\c -> c { alignSep = s }) >> go- SepChar s -> modifyIORef conf (\c -> c { sepChar = s }) >> go- Template s -> modifyIORef conf (\c -> c { template = s }) >> go- OnScr n -> modifyIORef conf (\c -> c { position = OnScreen (read n) $ position c }) >> go+ 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 -> modifyIORef conf (\c -> c { commands = x }) >> go+ Right x -> doOpts (conf { commands = x }) oo Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) where readCom str = case readStr str of@@ -161,4 +173,3 @@ _ -> Left "xmobar: cannot read list of commands specified with the -c option\n" readStr str = [x | (x,t) <- reads str, ("","") <- lex t]- go = doOpts conf oo
src/Plugins/Mail.hs view
@@ -30,11 +30,12 @@ import qualified Data.Set as S -- | A list of mail box names and paths to maildirs.-data Mail = Mail [(String, FilePath)]+data Mail = Mail [(String, FilePath)] String deriving (Read, Show) instance Exec Mail where- start (Mail ms) cb = do+ alias (Mail _ a) = a+ start (Mail ms _) cb = do vs <- mapM (const $ newTVarIO S.empty) ms let ts = map fst ms
src/Plugins/Monitors.hs view
@@ -3,7 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Plugins.Monitors--- Copyright : (c) Andrea Rossato+-- Copyright : (c) 2010, 2011 Jose Antonio Ortega Ruiz+-- (c) 2007-10 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>@@ -27,6 +28,7 @@ import Plugins.Monitors.MultiCpu import Plugins.Monitors.Batt import Plugins.Monitors.Thermal+import Plugins.Monitors.ThermalZone import Plugins.Monitors.CpuFreq import Plugins.Monitors.CoreTemp import Plugins.Monitors.Disk@@ -38,29 +40,36 @@ #ifdef LIBMPD import Plugins.Monitors.MPD #endif+#ifdef ALSA+import Plugins.Monitors.Volume+#endif -data Monitors = Weather Station Args Rate- | Network Interface Args Rate- | Memory Args Rate- | Swap Args Rate- | Cpu Args Rate- | MultiCpu Args Rate- | Battery Args Rate- | BatteryP [String] Args Rate- | DiskU DiskSpec Args Rate- | DiskIO DiskSpec Args Rate- | Thermal Zone Args Rate- | CpuFreq Args Rate- | CoreTemp Args Rate- | TopProc Args Rate- | TopMem Args Rate- | Uptime Args Rate+data Monitors = Weather Station Args Rate+ | Network Interface Args Rate+ | BatteryP [String] Args Rate+ | DiskU DiskSpec Args Rate+ | DiskIO DiskSpec Args Rate+ | Thermal Zone Args Rate+ | ThermalZone ZoneNo Args Rate+ | Memory Args Rate+ | Swap Args Rate+ | Cpu Args Rate+ | MultiCpu Args Rate+ | Battery Args Rate+ | CpuFreq Args Rate+ | CoreTemp Args Rate+ | TopProc Args Rate+ | TopMem Args Rate+ | Uptime Args Rate #ifdef IWLIB | Wireless Interface Args Rate #endif #ifdef LIBMPD | MPD Args Rate #endif+#ifdef ALSA+ | Volume String String Args Rate+#endif deriving (Show,Read,Eq) type Args = [String]@@ -68,52 +77,62 @@ type Alias = String type Station = String type Zone = String+type ZoneNo = Int type Interface = String type Rate = Int type DiskSpec = [(String, String)] instance Exec Monitors where- alias (Weather s _ _) = s- alias (Network i _ _) = i- alias (Thermal z _ _) = z- alias (Memory _ _) = "memory"- alias (Swap _ _) = "swap"- alias (Cpu _ _) = "cpu"- alias (MultiCpu _ _) = "multicpu"- alias (Battery _ _) = "battery"- alias (BatteryP _ _ _)= "battery"- alias (CpuFreq _ _) = "cpufreq"- alias (TopProc _ _) = "top"- alias (TopMem _ _) = "topmem"- alias (CoreTemp _ _) = "coretemp"- alias (DiskU _ _ _) = "disku"- alias (DiskIO _ _ _) = "diskio"- alias (Uptime _ _) = "uptime"+ alias (Weather s _ _) = s+ alias (Network i _ _) = i+ alias (Thermal z _ _) = z+ alias (ThermalZone z _ _) = "thermal" ++ show z+ alias (Memory _ _) = "memory"+ alias (Swap _ _) = "swap"+ alias (Cpu _ _) = "cpu"+ alias (MultiCpu _ _) = "multicpu"+ alias (Battery _ _) = "battery"+ alias (BatteryP _ _ _)= "battery"+ alias (CpuFreq _ _) = "cpufreq"+ alias (TopProc _ _) = "top"+ alias (TopMem _ _) = "topmem"+ alias (CoreTemp _ _) = "coretemp"+ alias (DiskU _ _ _) = "disku"+ alias (DiskIO _ _ _) = "diskio"+ alias (Uptime _ _) = "uptime" #ifdef IWLIB alias (Wireless i _ _) = i ++ "wi" #endif #ifdef LIBMPD- alias (MPD _ _) = "mpd"+ alias (MPD _ _) = "mpd" #endif- start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r- start (Network i a r) = runM (a ++ [i]) netConfig runNet r- start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r- start (Memory a r) = runM a memConfig runMem r- start (Swap a r) = runM a swapConfig runSwap r- start (Cpu a r) = runM a cpuConfig runCpu r- start (MultiCpu a r) = runM a multiCpuConfig runMultiCpu r- start (Battery a r) = runM a battConfig runBatt r- start (BatteryP s a r) = runM a battConfig (runBatt' s) r- start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r- start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r- start (DiskU s a r) = runM a diskUConfig (runDiskU s) r- start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r- start (TopMem a r) = runM a topMemConfig runTopMem r- start (Uptime a r) = runM a uptimeConfig runUptime r- start (TopProc a r) = startTop a r+#ifdef ALSA+ alias (Volume m c _ _) = m ++ ":" ++ c+#endif+ start (Network i a r) = startNet i a r+ start (Cpu a r) = startCpu a r+ start (MultiCpu a r) = startMultiCpu a r+ start (TopProc a r) = startTop a r+ start (TopMem a r) = runM a topMemConfig runTopMem r+ start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r+ start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r+ start (ThermalZone z a r) =+ runM (a ++ [show z]) thermalZoneConfig runThermalZone r+ start (Memory a r) = runM a memConfig runMem r+ start (Swap a r) = runM a swapConfig runSwap r+ start (Battery a r) = runM a battConfig runBatt r+ start (BatteryP s a r) = runM a battConfig (runBatt' s) r+ start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r+ start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r+ start (DiskU s a r) = runM a diskUConfig (runDiskU s) r+ start (DiskIO s a r) = startDiskIO s a r+ start (Uptime a r) = runM a uptimeConfig runUptime r #ifdef IWLIB- start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r+ start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r #endif #ifdef LIBMPD- start (MPD a r) = runM a mpdConfig runMPD r+ start (MPD a r) = runM a mpdConfig runMPD r+#endif+#ifdef ALSA+ start (Volume m c a r) = runM a volumeConfig (runVolume m c) r #endif
src/Plugins/Monitors/Batt.hs view
@@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt--- Copyright : (c) Andrea Rossato, 2010 Petr Rockai, 2010 Jose A Ortega+-- Copyright : (c) 2010, 2011 Jose A Ortega+-- (c) 2010 Andrea Rossato, Petr Rockai -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>@@ -16,6 +17,7 @@ import qualified Data.ByteString.Lazy.Char8 as B import Plugins.Monitors.Common+import System.FilePath ((</>)) import System.Posix.Files (fileExist) import System.Console.GetOpt @@ -28,6 +30,7 @@ , highWColor :: Maybe String , lowThreshold :: Float , highThreshold :: Float+ , onlineFile :: FilePath } defaultOpts :: BattOpts@@ -40,6 +43,7 @@ , highWColor = Nothing , lowThreshold = -12 , highThreshold = -10+ , onlineFile = "AC/online" } options :: [OptDescr (BattOpts -> BattOpts)]@@ -52,6 +56,7 @@ , Option "h" ["high"] (ReqArg (\x o -> o { highWColor = Just x }) "") "" , Option "L" ["lowt"] (ReqArg (\x o -> o { lowThreshold = read x }) "") "" , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") ""+ , Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") "" ] parseOpts :: [String] -> IO BattOpts@@ -62,8 +67,8 @@ data Result = Result Float Float Float String | NA -base :: String-base = "/sys/class/power_supply"+sysDir :: FilePath+sysDir = "/sys/class/power_supply" battConfig :: IO MConfig battConfig = mkMConfig@@ -71,10 +76,10 @@ ["leftbar", "left", "acstatus", "timeleft", "watts"] -- replacements data Files = Files- { f_full :: String- , f_now :: String- , f_voltage :: String- , f_current :: String+ { fFull :: String+ , fNow :: String+ , fVoltage :: String+ , fCurrent :: String } | NoFiles data Battery = Battery@@ -86,52 +91,51 @@ batteryFiles :: String -> IO Files batteryFiles bat =- do is_charge <- fileExist $ prefix ++ "/charge_now"- is_energy <- fileExist $ prefix ++ "/energy_now"+ do is_charge <- fileExist $ prefix </> "charge_now"+ is_energy <- fileExist $ prefix </> "energy_now"+ is_current <- fileExist $ prefix </> "current_now"+ let cf = if is_current then "current_now" else "power_now" return $ case (is_charge, is_energy) of- (True, _) -> files "/charge"- (_, True) -> files "/energy"+ (True, _) -> files "charge" cf+ (_, True) -> files "energy" cf _ -> NoFiles- where prefix = base ++ "/" ++ bat- files ch = Files { f_full = prefix ++ ch ++ "_full"- , f_now = prefix ++ ch ++ "_now"- , f_current = prefix ++ "/current_now"- , f_voltage = prefix ++ "/voltage_now" }+ where prefix = sysDir </> bat+ files ch cf = Files { fFull = prefix </> ch ++ "_full"+ , fNow = prefix </> ch ++ "_now"+ , fCurrent = prefix </> cf+ , fVoltage = prefix </> "voltage_now" } -haveAc :: IO (Maybe Bool)-haveAc = do know <- fileExist $ base ++ "/AC/online"- if know- then do s <- B.unpack `fmap` catRead (base ++ "/AC/online")- return $ Just $ s == "1\n"- else return Nothing+haveAc :: FilePath -> IO Bool+haveAc f = do+ exists <- fileExist ofile+ if exists+ then fmap ((== "1\n") . B.unpack) (B.readFile ofile)+ else return False+ where ofile = sysDir </> f readBattery :: Files -> IO Battery readBattery NoFiles = return $ Battery 0 0 0 0 readBattery files =- do a <- grab $ f_full files -- microwatthours- b <- grab $ f_now files- c <- grab $ f_voltage files -- microvolts- d <- grab $ f_current files -- microwatts (huh!)+ do a <- grab $ fFull files -- microwatthours+ b <- grab $ fNow files+ c <- grab $ fVoltage files -- microvolts+ d <- grab $ fCurrent files -- microwatts (huh!) return $ Battery (3600 * a / 1000000) -- wattseconds (3600 * b / 1000000) -- wattseconds (c / 1000000) -- volts (d / c) -- amperes- where grab = fmap (read . B.unpack) . catRead+ where grab = fmap (read . B.unpack) . B.readFile readBatteries :: BattOpts -> [Files] -> IO Result readBatteries opts bfs = do bats <- mapM readBattery (take 3 bfs)- ac' <- haveAc- let ac = (ac' == Just True)- sign = if ac then 1 else -1+ ac <- haveAc (onlineFile opts)+ let sign = if ac then 1 else -1 left = sum (map now bats) / sum (map full bats) watts = sign * sum (map voltage bats) * sum (map current bats)- time = if watts == 0 then 0 else sum $ map time' bats -- negate sign+ time = if watts == 0 then 0 else sum $ map time' bats time' b = (if ac then full b - now b else now b) / (sign * watts)- acstr = case ac' of- Nothing -> "?"- Just True -> onString opts- Just False -> offString opts+ acstr = if ac then onString opts else offString opts return $ if isNaN left then NA else Result left watts time acstr runBatt :: [String] -> Monitor String
src/Plugins/Monitors/Common.hs view
@@ -1,14 +1,15 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Common--- Copyright : (c) Andrea Rossato+-- Copyright : (c) 2010, 2011 Jose Antonio Ortega Ruiz+-- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable ----- Utilities for creating monitors for Xmobar+-- Utilities used by xmobar's monitors -- ----------------------------------------------------------------------------- @@ -50,14 +51,9 @@ , parseFloat , parseInt , stringParser- -- * Threaded Actions- -- $thread- , doActionTwiceWithDelay- , catRead ) where -import Control.Concurrent import Control.Monad.Reader import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef@@ -67,7 +63,6 @@ import Text.ParserCombinators.Parsec import System.Console.GetOpt import Control.Exception (SomeException,handle)-import System.Process (readProcess) import Plugins -- $monitor@@ -422,25 +417,3 @@ | x <= ll = 1 / bw | otherwise = f + logBase 2 (x / hh) / bw showPercentBar v $ choose v---- $threads--doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a])-doActionTwiceWithDelay delay action =- do v1 <- newMVar []- forkIO $! getData action v1 0- v2 <- newMVar []- forkIO $! getData action v2 delay- threadDelay (delay `div` 3 * 4)- a <- readMVar v1- b <- readMVar v2- return (a,b)--getData :: IO a -> MVar a -> Int -> IO ()-getData action var d =- do threadDelay d- s <- action- modifyMVar_ var (\_ -> return $! s)--catRead :: FilePath -> IO B.ByteString-catRead file = B.pack `fmap` readProcess "/bin/cat" [file] ""
src/Plugins/Monitors/Cpu.hs view
@@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Cpu--- Copyright : (c) Andrea Rossato+-- Copyright : (c) 2011 Jose Antonio Ortega Ruiz+-- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>@@ -12,27 +13,30 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Cpu where+module Plugins.Monitors.Cpu (startCpu) where import Plugins.Monitors.Common import qualified Data.ByteString.Lazy.Char8 as B+import Data.IORef (IORef, newIORef, readIORef, writeIORef) cpuConfig :: IO MConfig cpuConfig = mkMConfig "Cpu: <total>%" ["bar","total","user","nice","system","idle"] +type CpuDataRef = IORef [Float]+ cpuData :: IO [Float]-cpuData = do s <- B.readFile "/proc/stat"- return $ cpuParser s+cpuData = cpuParser `fmap` B.readFile "/proc/stat" cpuParser :: B.ByteString -> [Float]-cpuParser =- map (read . B.unpack) . tail . B.words . head . B.lines+cpuParser = map (read . B.unpack) . tail . B.words . head . B.lines -parseCPU :: IO [Float]-parseCPU =- do (a,b) <- doActionTwiceWithDelay 750000 cpuData+parseCpu :: CpuDataRef -> IO [Float]+parseCpu cref =+ do a <- readIORef cref+ b <- cpuData+ writeIORef cref b let dif = zipWith (-) b a tot = foldr (+) 0 dif percent = map (/ tot) dif@@ -46,8 +50,14 @@ ps <- showPercentsWithColors (t:xs) return (b:ps) -runCpu :: [String] -> Monitor String-runCpu _ =- do c <- io parseCPU+runCpu :: CpuDataRef -> [String] -> Monitor String+runCpu cref _ =+ do c <- io (parseCpu cref) l <- formatCpu c parseTemplate l++startCpu :: [String] -> Int -> (String -> IO ()) -> IO ()+startCpu a r cb = do+ cref <- newIORef []+ _ <- parseCpu cref+ runM a cpuConfig (runCpu cref) r cb
src/Plugins/Monitors/Disk.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk--- Copyright : (c) Jose A Ortega Ruiz+-- Copyright : (c) 2010, 2011 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>@@ -12,13 +12,13 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Disk ( diskUConfig, runDiskU- , diskIOConfig, runDiskIO- ) where+module Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where import Plugins.Monitors.Common import StatFS +import Data.IORef (IORef, newIORef, readIORef, writeIORef)+ import Control.Monad (zipWithM) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, find, intercalate)@@ -33,6 +33,7 @@ type DevName = String type Path = String+type DevDataRef = IORef [(DevName, [Float])] mountedDevices :: [String] -> IO [(DevName, Path)] mountedDevices req = do@@ -52,9 +53,11 @@ let extract ws = (head ws, map read (tail ws)) return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s) -mountedData :: [DevName] -> IO [(DevName, [Float])]-mountedData devs = do- (dt, dt') <- doActionTwiceWithDelay 750000 diskData+mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]+mountedData dref devs = do+ dt <- readIORef dref+ dt' <- diskData+ writeIORef dref dt' return $ map (parseDev (zipWith diff dt' dt)) devs where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys) @@ -110,12 +113,20 @@ setConfigValue tmp template parseTemplate $ s ++ b -runDiskIO :: [(String, String)] -> [String] -> Monitor String-runDiskIO disks _ = do+runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String+runDiskIO dref disks _ = do mounted <- io $ mountedDevices (map fst disks)- dat <- io $ mountedData (map fst mounted)+ dat <- io $ mountedData dref (map fst mounted) strs <- mapM runDiskIO' $ devTemplates disks mounted dat return $ intercalate " " strs++startDiskIO :: [(String, String)] ->+ [String] -> Int -> (String -> IO ()) -> IO ()+startDiskIO disks args rate cb = do+ mounted <- mountedDevices (map fst disks)+ dref <- newIORef (map (\d -> (fst d, repeat 0)) mounted)+ _ <- mountedData dref (map fst mounted)+ runM args diskIOConfig (runDiskIO dref disks) rate cb runDiskU' :: String -> String -> Monitor String runDiskU' tmp path = do
src/Plugins/Monitors/MPD.hs view
@@ -30,9 +30,6 @@ { mPlaying :: String , mStopped :: String , mPaused :: String- , mHost :: String- , mPort :: Integer- , mPassword :: String } defaultOpts :: MOpts@@ -40,9 +37,6 @@ { mPlaying = ">>" , mStopped = "><" , mPaused = "||"- , mHost = "127.0.0.1"- , mPort = 6600- , mPassword = "" } options :: [OptDescr (MOpts -> MOpts)]@@ -50,15 +44,12 @@ [ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") "" , Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") "" , Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") ""- , Option "h" ["host"] (ReqArg (\x o -> o { mHost = x }) "") ""- , Option "p" ["port"] (ReqArg (\x o -> o { mPort = read x }) "") ""- , Option "x" ["password"] (ReqArg (\x o -> o { mPassword = x }) "") "" ] runMPD :: [String] -> Monitor String runMPD args = do opts <- io $ mopts args- let mpd = M.withMPDEx (mHost opts) (mPort opts) (mPassword opts)+ let mpd = M.withMPD status <- io $ mpd M.status song <- io $ mpd M.currentSong s <- parseMPD status song opts
src/Plugins/Monitors/MultiCpu.hs view
@@ -12,11 +12,12 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.MultiCpu(multiCpuConfig, runMultiCpu) where+module Plugins.Monitors.MultiCpu (startMultiCpu) where import Plugins.Monitors.Common import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, transpose, unfoldr)+import Data.IORef (IORef, newIORef, readIORef, writeIORef) multiCpuConfig :: IO MConfig multiCpuConfig =@@ -26,6 +27,7 @@ , k <- monitors] where monitors = ["bar","total","user","nice","system","idle"] +type CpuDataRef = IORef [[Float]] cpuData :: IO [[Float]] cpuData = parse `fmap` B.readFile "/proc/stat"@@ -35,9 +37,11 @@ isCpu _ = False parseList = map (parseFloat . B.unpack) . tail -parseCpuData :: IO [[Float]]-parseCpuData =- do (as, bs) <- doActionTwiceWithDelay 950000 cpuData+parseCpuData :: CpuDataRef -> IO [[Float]]+parseCpuData cref =+ do as <- readIORef cref+ bs <- cpuData+ writeIORef cref bs let p0 = zipWith percent bs as return p0 @@ -68,9 +72,15 @@ formatAutoCpus [] = return $ replicate 6 "" formatAutoCpus xs = return $ map unwords (groupData xs) -runMultiCpu :: [String] -> Monitor String-runMultiCpu _ =- do c <- io parseCpuData+runMultiCpu :: CpuDataRef -> [String] -> Monitor String+runMultiCpu cref _ =+ do c <- io $ parseCpuData cref l <- formatMultiCpus c a <- formatAutoCpus l parseTemplate $ a ++ l++startMultiCpu :: [String] -> Int -> (String -> IO ()) -> IO ()+startMultiCpu a r cb = do+ cref <- newIORef [[]]+ _ <- parseCpuData cref+ runM a multiCpuConfig (runMultiCpu cref) r cb
src/Plugins/Monitors/Net.hs view
@@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Net--- Copyright : (c) Andrea Rossato+-- Copyright : (c) 2011 Jose Antonio Ortega Ruiz+-- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>@@ -12,9 +13,13 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Net (netConfig, runNet) where+module Plugins.Monitors.Net (startNet) where import Plugins.Monitors.Common++import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)+ import qualified Data.ByteString.Lazy.Char8 as B data NetDev = NA@@ -23,8 +28,7 @@ , netTx :: Float } deriving (Eq,Show,Read) -interval :: Int-interval = 500000+type NetDevRef = IORef (NetDev, UTCTime) netConfig :: IO MConfig netConfig = mkMConfig@@ -49,15 +53,20 @@ readNetDev :: [String] -> NetDev readNetDev [] = NA readNetDev xs =- ND (xs !! 0) (r (xs !! 1)) (r (xs !! 2))+ ND (head xs) (r (xs !! 1)) (r (xs !! 2)) where r s | s == "" = 0 | otherwise = read s / 1024 -fileNET :: IO [NetDev]-fileNET =- do f <- B.readFile "/proc/net/dev"- return $ netParser f+fileNet :: IO [NetDev]+fileNet = netParser `fmap` B.readFile "/proc/net/dev" +findNetDev :: String -> IO NetDev+findNetDev dev = do+ nds <- fileNet+ case filter (\d -> netDev d == dev) nds of+ x:_ -> return x+ _ -> return NA+ netParser :: B.ByteString -> [NetDev] netParser = map (readNetDev . getNElements [0,1,9] . wordsBy (`elem` " :") . B.unpack) . drop 2 . B.lines@@ -78,19 +87,26 @@ parseTemplate [d,rx,tx,rb,tb] NA -> return "N/A" -parseNET :: String -> IO [NetDev]-parseNET nd =- do (a,b) <- doActionTwiceWithDelay interval fileNET- let netRate f da db = takeDigits 2 $ (f db - f da) * fromIntegral (1000000 `div` interval)- diffRate (da,db) = ND (netDev da)- (netRate netRx da db)- (netRate netTx da db)- return $ filter (\d -> netDev d == nd) $ map diffRate $ zip a b+parseNet :: NetDevRef -> String -> IO NetDev+parseNet nref nd = do+ (n0, t0) <- readIORef nref+ n1 <- findNetDev nd+ t1 <- getCurrentTime+ writeIORef nref (n1, t1)+ let scx = realToFrac (diffUTCTime t1 t0)+ scx' = if scx > 0 then scx else 1+ netRate f da db = takeDigits 2 $ (f db - f da) / scx'+ diffRate NA _ = NA+ diffRate _ NA = NA+ diffRate da db = ND nd (netRate netRx da db) (netRate netTx da db)+ return $ diffRate n0 n1 -runNet :: [String] -> Monitor String-runNet nd =- do pn <- io $ parseNET $ head nd- n <- case pn of- [x] -> return x- _ -> return NA- printNet n+runNet :: NetDevRef -> String -> [String] -> Monitor String+runNet nref i _ = io (parseNet nref i) >>= printNet++startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO ()+startNet i a r cb = do+ t0 <- getCurrentTime+ nref <- newIORef (NA, t0)+ _ <- parseNet nref i+ runM a netConfig (runNet nref i) r cb
+ src/Plugins/Monitors/ThermalZone.hs view
@@ -0,0 +1,43 @@+------------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.ThermalZone+-- Copyright : (c) 2011 Jose Antonio Ortega Ruiz+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : jao@gnu.org+-- Stability : unstable+-- Portability : portable+-- Created : Fri Feb 25, 2011 03:18+--+--+-- A thermal zone plugin based on the sysfs linux interface.+-- See http://kernel.org/doc/Documentation/thermal/sysfs-api.txt+--+------------------------------------------------------------------------------++module Plugins.Monitors.ThermalZone (thermalZoneConfig, runThermalZone) where++import Plugins.Monitors.Common++import System.Posix.Files (fileExist)+import qualified Data.ByteString.Char8 as B++-- | Default thermal configuration.+thermalZoneConfig :: IO MConfig+thermalZoneConfig = mkMConfig "<temp>C" ["temp"]++-- | Retrieves thermal information. Argument is name of thermal+-- directory in \/sys\/clas\/thermal. Returns the monitor string+-- parsed according to template (either default or user specified).+runThermalZone :: [String] -> Monitor String+runThermalZone args = do+ let zone = head args+ file = "/sys/class/thermal/thermal_zone" ++ zone ++ "/temp"+ parse = return . (read :: String -> Int) . B.unpack+ exists <- io $ fileExist file+ if exists+ then do mdegrees <- io $ B.readFile file >>= parse+ temp <- showWithColors show (mdegrees `quot` 1000)+ parseTemplate [ temp ]+ else return "N/A"+
+ src/Plugins/Monitors/Volume.hs view
@@ -0,0 +1,124 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Volume+-- Copyright : (c) 2011 Thomas Tuegel+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A monitor for ALSA soundcards+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Volume (runVolume, volumeConfig) where++import Control.Monad ( liftM, mplus )+import Data.Maybe+import Plugins.Monitors.Common+import Sound.ALSA.Mixer+import System.Console.GetOpt++volumeConfig :: IO MConfig+volumeConfig = mkMConfig "Vol: <volume>% <status>"+ ["volume", "volumebar", "dB","status"]+++data VolumeOpts = VolumeOpts+ { onString :: String+ , offString :: String+ , onColor :: Maybe String+ , offColor :: Maybe String+ , highDbThresh :: Float+ , lowDbThresh :: Float+ }++defaultOpts :: VolumeOpts+defaultOpts = VolumeOpts+ { onString = "[on] "+ , offString = "[off]"+ , onColor = Just "green"+ , offColor = Just "red"+ , highDbThresh = -5.0+ , lowDbThresh = -30.0+ }++options :: [OptDescr (VolumeOpts -> VolumeOpts)]+options =+ [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") ""+ , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") ""+ , Option "" ["lowd"] (ReqArg (\x o -> o { lowDbThresh = read x }) "") ""+ , Option "" ["highd"] (ReqArg (\x o -> o { highDbThresh = read x }) "") ""+ , Option "C" ["onc"] (ReqArg (\x o -> o { onColor = Just x }) "") ""+ , Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") ""+ ]++parseOpts :: [String] -> IO VolumeOpts+parseOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs++percent :: Integer -> Integer -> Integer -> Float+percent v' lo' hi' = (v - lo) / (hi - lo)+ where v = fromIntegral v'+ lo = fromIntegral lo'+ hi = fromIntegral hi'++formatVol :: Integer -> Integer -> Integer -> Monitor String+formatVol lo hi v =+ showPercentWithColors $ percent v lo hi++formatVolBar :: Integer -> Integer -> Integer -> Monitor String+formatVolBar lo hi v =+ showPercentBar (100 * x) x where x = percent v lo hi++switchHelper :: VolumeOpts+ -> (VolumeOpts -> Maybe String)+ -> (VolumeOpts -> String)+ -> Monitor String+switchHelper opts cHelp strHelp = return $+ colorHelper (cHelp opts)+ ++ strHelp opts+ ++ maybe "" (const "</fc>") (cHelp opts)++formatSwitch :: VolumeOpts -> Bool -> Monitor String+formatSwitch opts True = switchHelper opts onColor onString+formatSwitch opts False = switchHelper opts offColor offString++colorHelper :: Maybe String -> String+colorHelper = maybe "" (\c -> "<fc=" ++ c ++ ">")++formatDb :: VolumeOpts -> Integer -> Monitor String+formatDb opts dbi = do+ h <- getConfigValue highColor+ m <- getConfigValue normalColor+ l <- getConfigValue lowColor+ let db = fromIntegral dbi / 100.0+ digits = showDigits 0 db+ startColor | db >= highDbThresh opts = colorHelper h+ | db < lowDbThresh opts = colorHelper l+ | otherwise = colorHelper m+ stopColor | null startColor = ""+ | otherwise = "</fc>"+ return $ startColor ++ digits ++ stopColor++runVolume :: String -> String -> [String] -> Monitor String+runVolume mixerName controlName argv = do+ opts <- io $ parseOpts argv+ control <- liftM fromJust $ io $ getControlByName mixerName controlName+ let volumeControl = fromJust $ mplus (playback $ volume control)+ (common $ volume control)+ switchControl = fromJust $ mplus (playback $ switch control)+ (common $ switch control)+ maybeNA = maybe (return "N/A")+ (lo, hi) <- io $ getRange volumeControl+ val <- io $ getChannel FrontLeft $ value volumeControl+ db <- io $ getChannel FrontLeft $ dB volumeControl+ sw <- io $ getChannel FrontLeft switchControl+ p <- maybeNA (formatVol lo hi) val+ b <- maybeNA (formatVolBar lo hi) val+ d <- maybeNA (formatDb opts) db+ s <- maybeNA (formatSwitch opts) sw+ parseTemplate [p, b, d, s]
src/Plugins/StdinReader.hs view
@@ -26,7 +26,8 @@ instance Exec StdinReader where start StdinReader cb = do- cb =<< catch (hGetLineSafe stdin) (\(SomeException e) -> do hPrint stderr e; return "")+ cb =<< catch (hGetLineSafe stdin)+ (\(SomeException e) -> do hPrint stderr e; return "") eof <- hIsEOF stdin if eof then exitImmediately ExitSuccess
src/StatFS.hsc view
@@ -23,11 +23,11 @@ import Data.ByteString (useAsCString) import Data.ByteString.Char8 (pack) -#if defined (__FreeBSD__)+#if defined (__FreeBSD__) || defined (__APPLE__) # include <sys/param.h> # include <sys/mount.h> #else-#include <sys/vfs.h>+# include <sys/vfs.h> #endif data FileSystemStats = FileSystemStats {@@ -47,7 +47,7 @@ data CStatfs -#if defined(__FreeBSD__)+#if defined (__FreeBSD__) || defined (__APPLE__) foreign import ccall unsafe "sys/mount.h statfs" #else foreign import ccall unsafe "sys/vfs.h statfs64"
src/Xmobar.hs view
@@ -42,6 +42,7 @@ import Data.Bits import Data.Maybe(fromMaybe) import Data.Typeable (Typeable)+import System.Posix.Process (getProcessID) import Config import Parsers@@ -73,23 +74,25 @@ instance Exception WakeUp -- | The event loop-eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO ()-eventLoop xc@(XConf d _ w fs c) v = block $ do+eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO ()+eventLoop xc@(XConf d _ w fs c) vs = block $ do tv <- atomically $ newTVar [] t <- myThreadId- ct <- forkIO (checker t tv "" `catch` \(SomeException _) -> return ())+ ct <- forkIO (checker t tv [] `catch` \(SomeException _) -> return ()) go tv ct where -- interrupt the drawing thread every time a var is updated checker t tvar ov = do nval <- atomically $ do- nv <- fmap concat $ mapM readTVar (map snd v)+ nv <- mapM concatV vs guard (nv /= ov) writeTVar tvar nv return nv throwTo t WakeUp checker t tvar nval + concatV = fmap concat . mapM (readTVar . snd)+ -- Continuously wait for a timer interrupt or an expose event go tv ct = do catch (unblock $ allocaXEvent $ \e ->@@ -104,7 +107,7 @@ killThread ct destroyWindow d w (r',w') <- createWin d fs c- eventLoop (XConf d r' w' fs c) v+ eventLoop (XConf d r' w' fs c) vs handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar) @@ -145,32 +148,32 @@ setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool) setPosition p rs ht =- case p' of- Top -> (Rectangle rx ry rw h , True)- TopW a i -> (Rectangle (ax a i ) ry (nw i ) h , True)- TopSize a i ch -> (Rectangle (ax a i ) ry (nw i ) (mh ch), True)- Bottom -> (Rectangle rx ny rw h , True)- BottomW a i -> (Rectangle (ax a i ) ny (nw i ) h , True)- BottomSize a i ch -> (Rectangle (ax a i ) ny (nw i ) (mh ch), True)- Static cx cy cw ch -> (Rectangle (fi cx ) (fi cy) (fi cw) (fi ch), True)- OnScreen _ p'' -> setPosition p'' [scr] ht- where- (scr@(Rectangle rx ry rw rh), p') =- case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)- _ -> (head rs, p)- ny = ry + fi (rh - ht)- center i = rx + (fi $ div (remwid i) 2)- right i = rx + (fi $ remwid i)- remwid i = rw - pw (fi i)- ax L = const rx- ax R = right- ax C = center- pw i = rw * (min 100 i) `div` 100- nw = fi . pw . fi- h = fi ht- mh h' = max (fi h') h-- safeIndex i = lookup i . zip [0..]+ case p' of+ Top -> (Rectangle rx ry rw h, True)+ TopW a i -> (Rectangle (ax a i) ry (nw i) h, True)+ TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True)+ Bottom -> (Rectangle rx ny rw h, True)+ BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True)+ BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True)+ Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True)+ OnScreen _ p'' -> setPosition p'' [scr] ht+ where+ (scr@(Rectangle rx ry rw rh), p') =+ case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)+ _ -> (head rs, p)+ ny = ry + fi (rh - ht)+ center i = rx + fi (div (remwid i) 2)+ right i = rx + fi (remwid i)+ remwid i = rw - pw (fi i)+ ax L = const rx+ ax R = right+ ax C = center+ pw i = rw * (min 100 i) `div` 100+ nw = fi . pw . fi+ h = fi ht+ mh h' = max (fi h') h+ ny' h' = ry + fi (rh - mh h')+ safeIndex i = lookup i . zip [0..] setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO () setProperties r c d w srs = do@@ -179,10 +182,17 @@ a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False c2 <- internAtom d "ATOM" False v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False+ p <- internAtom d "_NET_WM_PID" False++ setTextProperty d w "xmobar" wM_CLASS+ setTextProperty d w "xmobar" wM_NAME+ changeProperty32 d w a1 c1 propModeReplace $ map fi $ getStrutValues r (position c) (getRootWindowHeight srs) changeProperty32 d w a2 c2 propModeReplace [fromIntegral v] + getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral+ getRootWindowHeight :: [Rectangle] -> Int getRootWindowHeight srs = foldr1 max (map getMaxScreenYCoord srs) where@@ -217,21 +227,13 @@ xe = xs + cw getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -updateWin :: TVar String -> X ()+updateWin :: TVar [String] -> X () updateWin v = do xc <- ask+ s <- io $ atomically $ readTVar v let (conf,rec) = (config &&& rect) xc- [lc,rc] = if length (alignSep conf) == 2- then alignSep conf- else alignSep defaultConfig- i <- io $ atomically $ readTVar v- let def = [i,[],[]]- [l,c,r] = case break (==lc) i of- (le,_:re) -> case break (==rc) re of- (ce,_:ri) -> [le,ce,ri]- _ -> def- _ -> def- ps <- io $ mapM (parseString conf) [l,c,r]+ l:c:r:_ = s ++ repeat ""+ ps <- io $ mapM (parseString conf) [l, c, r] drawInWin rec ps -- $print@@ -265,18 +267,18 @@ -- resync io $ sync d True -drawBorder :: Border -> Display -> Drawable -> GC -> Pixel -> Dimension- -> Dimension -> IO ()+drawBorder :: Border -> Display -> Drawable -> GC -> Pixel+ -> Dimension -> Dimension -> IO () drawBorder b d p gc c wi ht = case b of NoBorder -> return () TopB -> drawBorder (TopBM 0) d p gc c w h BottomB -> drawBorder (BottomBM 0) d p gc c w h FullB -> drawBorder (FullBM 0) d p gc c w h TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0- BottomBM m -> let rw = (fi h) - (fi m) in+ BottomBM m -> let rw = fi h - fi m in sf >> drawLine d p gc 0 rw (fi w) rw- FullBM m -> let rm = fi m; mp = fi m in- sf >> drawRectangle d p gc mp mp (w - rm) (h - rm)+ FullBM m -> let pad = 2 * fi m; mp = fi m in+ sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) where sf = setForeground d gc c (w, h) = (wi - 1, ht - 1) @@ -290,13 +292,13 @@ let (conf,d) = (config &&& display) r Rectangle _ _ wid ht = rect r totSLen = foldr (\(_,_,len) -> (+) len) 0 sl- valign = fi $ as + ds+ valign = (fi ht + fi (as + ds)) `div` 2 - 1 remWidth = fi wid - fi totSLen offset = case a of C -> (remWidth + offs) `div` 2 R -> remWidth L -> offs- (fc,bc) = case (break (==',') c) of+ (fc,bc) = case break (==',') c of (f,',':b) -> (f, b ) (f, _) -> (f, bgColor conf) withColors d [bc] $ \[bc'] -> do
xmobar.cabal view
@@ -1,5 +1,5 @@ name: xmobar-version: 0.12+version: 0.13 homepage: http://projects.haskell.org/xmobar/ bug-reports: http://code.google.com/p/xmobar/issues synopsis: A Minimalistic Text Based Status Bar@@ -16,8 +16,8 @@ cabal-version: >= 1.6 build-type: Simple -data-files: samples/xmobar.config extra-source-files: README, NEWS,+ samples/xmobar.config, samples/xmonadpropwrite.hs samples/Plugins/helloworld.config, samples/Plugins/HelloWorld.hs @@ -53,6 +53,10 @@ description: Includes all optional extensions. default: False +flag with_alsa+ description: Use alsa-mixer to get the volume from soundcards.+ default: False+ executable xmobar hs-source-dirs: src main-is: Main.hs@@ -65,7 +69,8 @@ Plugins.Monitors.CoreTemp, Plugins.Monitors.CpuFreq, Plugins.Monitors.Cpu, Plugins.Monitors.Disk, Plugins.Monitors.Mem, Plugins.Monitors.MultiCpu, Plugins.Monitors.Net,- Plugins.Monitors.Swap, Plugins.Monitors.Thermal, Plugins.Monitors.Top,+ Plugins.Monitors.Swap, Plugins.Monitors.Thermal,+ Plugins.Monitors.ThermalZone, Plugins.Monitors.Top, Plugins.Monitors.Uptime, Plugins.Monitors.Weather ghc-prof-options: -prof -auto-all@@ -109,3 +114,8 @@ build-depends: libmpd >= 0.5 other-modules: Plugins.Monitors.MPD cpp-options: -DLIBMPD++ if flag(with_alsa) || flag(all_extensions)+ build-depends: alsa-mixer == 0.1.*+ other-modules: Plugins.Monitors.Volume+ cpp-options: -DALSA