xmobar 0.21 → 0.22
raw patch · 46 files changed
+1120/−322 lines, 46 filesdep ~libmpddep ~mtl
Dependency ranges changed: libmpd, mtl
Files
- news.md +38/−0
- readme.md +124/−47
- samples/xmobar.config +16/−5
- src/Actions.hs +3/−3
- src/Bitmap.hs +60/−9
- src/ColorCache.hs +2/−2
- src/Config.hs +6/−1
- src/IPC/DBus.hs +1/−1
- src/Main.hs +8/−4
- src/MinXft.hsc +83/−1
- src/Parsers.hs +22/−16
- src/Plugins/BufferedPipeReader.hs +2/−2
- src/Plugins/Date.hs +2/−1
- src/Plugins/EWMH.hs +6/−6
- src/Plugins/Kbd.hsc +3/−0
- src/Plugins/Locks.hs +25/−12
- src/Plugins/MBox.hs +1/−1
- src/Plugins/Mail.hs +1/−1
- src/Plugins/MarqueePipeReader.hs +68/−0
- src/Plugins/Monitors.hs +5/−5
- src/Plugins/Monitors/Batt.hs +32/−7
- src/Plugins/Monitors/Bright.hs +23/−17
- src/Plugins/Monitors/CatInt.hs +1/−1
- src/Plugins/Monitors/Common.hs +47/−8
- src/Plugins/Monitors/CoreTemp.hs +3/−3
- src/Plugins/Monitors/Cpu.hs +33/−9
- src/Plugins/Monitors/CpuFreq.hs +4/−4
- src/Plugins/Monitors/Disk.hs +73/−16
- src/Plugins/Monitors/MPD.hs +11/−5
- src/Plugins/Monitors/Mem.hs +39/−10
- src/Plugins/Monitors/Mpris.hs +10/−9
- src/Plugins/Monitors/MultiCpu.hs +44/−11
- src/Plugins/Monitors/Net.hs +70/−19
- src/Plugins/Monitors/Swap.hs +2/−2
- src/Plugins/Monitors/Thermal.hs +6/−7
- src/Plugins/Monitors/Top.hs +2/−2
- src/Plugins/Monitors/Volume.hs +11/−2
- src/Plugins/Monitors/Weather.hs +57/−15
- src/Plugins/Monitors/Wireless.hs +29/−5
- src/Plugins/PipeReader.hs +7/−10
- src/Plugins/StdinReader.hs +1/−1
- src/Window.hs +31/−13
- src/XPMFile.hsc +56/−0
- src/XUtil.hsc +23/−13
- src/Xmobar.hs +14/−11
- xmobar.cabal +15/−5
news.md view
@@ -1,5 +1,43 @@ % xmobar - Release notes +## Version 0.22 (Oct 9, 2014)++_New features_++ - New `MarqueePipeReader` plugin by Reto Hablützel.+ - `Network` monitor has now adaptive units (`-S` is used now to+ switch them on), by Axel Angel.+ - `Weather` now offers `dewPointC` and `dewPointF` instead of+ `dewPoint`, and the new `windCardinal`, `windAzimuth`, `windMph`+ and `windKnots` variables, by Tony Morris.+ - Strings in the configuration file can now span multiple lines+ using Haskell-style multiline script, thanks to dunric+ - Icons can now be also xpm files (if xmobar is compiled with+ `with_xpm`), thanks to Alexander Shabalin.+ - New `borderWidth` option to set xmobar's boder width, thanks to+ Travis Staton.+ - Support for multiple Xft fonts, thanks to Phil Xiaojun Hu and+ Cedric staub (see [pull request #196]).+ - Icon patterns for several monitors, that allow you to specify a+ collection of icons to use for successive integer variable values,+ thanks to Alexander Shabalin (see [pull request #192] and the+ documentation for details).+ - Upgrade to libmpd 0.9.++_Bug fixes_++ - Much more efficient implementation of the `Locks` plugin, thanks+ to Anton Vorontsov (see [pull request #195]).+ - Not colorizing total disk size in `DiskU` ([issue #189]).+ - Avoiding zombies on click actions, thanks to Phil Xiaojun Hu+ ([issue #181]).++[issue #181]: https://github.com/jaor/xmobar/issues/181+[issue #189]: https://github.com/jaor/xmobar/issues/189+[pull request #192]: https://github.com/jaor/xmobar/pull/192+[pull request #195]: https://github.com/jaor/xmobar/pull/195+[pull request #196]: https://github.com/jaor/xmobar/pull/196+ ## Version 0.21 (Jul 1, 2014) _New features_
readme.md view
@@ -11,7 +11,7 @@ features, like dynamic color management, icons, output templates, and extensibility through plugins. -This page documents xmobar 0.21 (see [release notes]).+This page documents xmobar 0.22 (see [release notes]). [This screenshot] shows xmobar running under [sawfish], with antialiased fonts. And [this one] is my desktop with [xmonad] and two@@ -124,6 +124,10 @@ font = "xft:Times New Roman-10:italic" + Or to have fallback fonts, just separate them by commas:++ font = "xft:Open Sans:size=9,WenQuanYi Zen Hei:size=9"+ `with_mpd` : Enables support for the [MPD] daemon. Requires the [libmpd] package. @@ -152,6 +156,10 @@ : Support for other timezones. Enables the DateZone plugin. Requires [timezone-olson] and [timezone-series] package. +`with_xpm`+: Support for xpm image file format. This will allow loading .xpm files in `<icon>`.+ Requires the [libXpm] C library.+ `all_extensions` : Enables all the extensions above. @@ -195,7 +203,8 @@ - `<fc=#FF0000>string</fc>` will print `string` with `#FF0000` color (red). -- `<icon=/path/to/icon.xbm/>` will insert the given bitmap.+- `<icon=/path/to/icon.xbm/>` will insert the given bitmap. XPM image+ format is also supported when compiled with `--flags="with_xpm"`. - ```<action=`command` button=12345>``` will execute given command when clicked with specified buttons. If not specified, button is equal to 1@@ -307,6 +316,15 @@ `borderColor` : Border color. +`borderWidth`+: Border width in pixels.++`iconRoot`+: Root folder where icons are stored. For <icon=path/>+ if path start with `"/"`, `"./"` or `"../"` it is interpreted as+ it is. Otherwise it will have `iconRoot ++ "/"` prepended to+ it. Default is `"."`.+ `commands` : For setting the options of the programs to run (optional). @@ -360,6 +378,7 @@ -s char --sepchar=char The character used to separate commands in the output template. Default '%' -t template --template=template The output template+ -i path --iconroot=path Default directory for icon pattern files -c commands --commands=commands The list of commands to be executed -C command --add-command=command Add to the list of commands to be executed -x screen --screen=screen On which X screen number to start@@ -482,7 +501,9 @@ <icon=/path/to/bitmap.xbm/> -which will produce the expected result.+which will produce the expected result. Accepted image formats are XBM+and XPM (when `with_xpm` flag is enabled). If path does not start with+`"/"`, `"./"`, `"../"` it will have `iconRoot ++ "/"` prepended to it. It's also possible to use action directives of the form: @@ -536,7 +557,24 @@ monitor in turn, but before we provide a list of the configuration options (or *monitor arguments*) they all share. +### Icon patterns +Some monitors allow usage of strings that depend on some integer value+from 0 to 8 by replacing all occurences of `"%%"` with it+(i.e. `"<icon=/path/to/icon_%%.xpm/>"` will be interpreted+as `"<icon=/path/to/icon_3.xpm/>"` when the value is `3`, also `"%"` is interpreted+as `"%"`, `"%%"` as `"3"`, `"%%%"` as `"3%"`, `"%%%%"` as `"33"` and so on). Essentially+it allows to replace vertical bars with custom icons. For example,++ Run Brightness+ [ "-t", "<ipat>"+ , "--"+ , "--brightness-icon-pattern", "<icon=bright_%%.xpm/>"+ ] 30++Will display `bright_0.xpm` to `bright_8.xpm` depending on current brightness+value.+ ### Default Monitor Arguments Monitors accept a common set of arguments, described in the first@@ -677,8 +715,9 @@ - Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `station`, `stationState`, `year`, `month`, `day`, `hour`,- `wind`, `visibility`, `skyCondition`, `tempC`, `tempF`,- `dewPoint`, `rh`, `pressure`+ `windCardinal`, `windAzimuth`, `windMph`, `windKnots`,+ `visibility`, `skyCondition`, `tempC`, `tempF`,+ `dewPointC`, `dewPointF`, `rh`, `pressure` - Default template: `<station>: <tempC>C, rh <rh>% (<hour>)` - Retrieves weather information from http://weather.noaa.gov. @@ -686,33 +725,38 @@ - Aliases to the interface name: so `Network "eth0" []` can be used as `%eth0%`-- Args: default monitor arguments+- Args: default monitor arguments, plus:+ - `--rx-icon-pattern`: dynamic string for reception rate in `rxipat`.+ - `--tx-icon-pattern`: dynamic string for transmission rate in `txipat`. - Variables that can be used with the `-t`/`--template` argument:- `dev`, `rx`, `tx`, `rxbar`, `rxvbar`, `txbar`, `txvbar`. Reception and- transmission rates (`rx` and `tx`) are displayed in Kbytes per second,- and you can set the `-S` to "True" to make them displayed with units (the- string "Kb/s").+ `dev`, `rx`, `tx`, `rxbar`, `rxvbar`, `rxipat`, `txbar`, `txvbar`,+ `txipat`. Reception and transmission rates (`rx` and `tx`) are displayed+ by default as Kb/s, without any suffixes, but you can set the `-S` to+ "True" to make them displayed with adaptive units (Kb/s, Mb/s, etc.). - Default template: `<dev>: <rx>KB|<tx>KB` ### `DynNetwork Args RefreshRate` - Active interface is detected automatically - Aliases to "dynnetwork"-- Args: default monitor arguments+- Args: default monitor arguments, plus:+ - `--rx-icon-pattern`: dynamic string for reception rate in `rxipat`.+ - `--tx-icon-pattern`: dynamic string for transmission rate in `txipat`. - Variables that can be used with the `-t`/`--template` argument:- `dev`, `rx`, `tx`, `rxbar`, `rxvbar`, `txbar`, `txvbar`. Reception and- transmission rates (`rx` and `tx`) are displayed in Kbytes per second,- and you can set the `-S` to "True" to make them displayed with units (the- string "Kb/s").+ `dev`, `rx`, `tx`, `rxbar`, `rxvbar`, `rxipat`, `txbar`, `txvbar`,+ `txipat`. Reception and transmission rates (`rx` and `tx`) are displayed+ in Kbytes per second, and you can set the `-S` to "True" to make them+ displayed with units (the string "Kb/s"). - Default template: `<dev>: <rx>KB|<tx>KB` ### `Wireless Interface Args RefreshRate` - Aliases to the interface name with the suffix "wi": thus, `Wireless "wlan0" []` can be used as `%wlan0wi%`-- Args: default monitor arguments+- Args: default monitor arguments, plus:+ - `--quality-icon-pattern`: dynamic string for connection quality in `qualityipat`. - Variables that can be used with the `-t`/`--template` argument:- `essid`, `quality`, `qualitybar`, `qualityvbar`+ `essid`, `quality`, `qualitybar`, `qualityvbar`, `qualityipat` - Default template: `<essid> <quality>` - Requires the C library [iwlib] (part of the wireless tools suite) installed in your system. In addition, to activate this plugin you@@ -721,10 +765,13 @@ ### `Memory Args RefreshRate` - Aliases to `memory`-- Args: default monitor arguments+- Args: default monitor arguments, plus:+ - `--used-icon-pattern`: dynamic string for used memory ratio in `usedipat`.+ - `--free-icon-pattern`: dynamic string for free memory ratio in `freeipat`. - Variables that can be used with the `-t`/`--template` argument: `total`, `free`, `buffer`, `cache`, `rest`, `used`,- `usedratio`, `usedbar`, `usedvbar`, `freeratio`, `freebar`, `freevbar`+ `usedratio`, `usedbar`, `usedvbar`, `usedipat`,+ `freeratio`, `freebar`, `freevbar`, `freeipat` - Default template: `Mem: <usedratio>% (<cache>M)` ### `Swap Args RefreshRate`@@ -738,19 +785,24 @@ ### `Cpu Args RefreshRate` - Aliases to `cpu`-- Args: default monitor arguments+- Args: default monitor arguments, plus:+ - `--load-icon-pattern`: dynamic string for cpu load in `ipat`. - Variables that can be used with the `-t`/`--template` argument:- `total`, `bar`, `vbar`, `user`, `nice`, `system`, `idle`, `iowait`+ `total`, `bar`, `vbar`, `ipat`, `user`, `nice`, `system`, `idle`, `iowait` - Default template: `Cpu: <total>%` ### `MultiCpu Args RefreshRate` - Aliases to `multicpu`-- Args: default monitor arguments+- Args: default monitor arguments, plus:+ - `--load-icon-pattern`: dynamic string for overall cpu load in `ipat`.+ - `--load-icon-patterns`: dynamic string for each cpu load in `autoipat`, `ipat{i}`.+ This option can be specified several times. nth option+ corresponds to nth cpu. - Variables that can be used with the `-t`/`--template` argument:- `autototal`, `autobar`, `autovbar`, `autouser`, `autonice`,- `autosystem`, `autoidle`, `total`, `bar`, `vbar`, `user`, `nice`,- `system`, `idle`, `total0`, `bar0`, `vbar0`, `user0`, `nice0`,+ `autototal`, `autobar`, `autovbar`, `autoipat`, `autouser`, `autonice`,+ `autosystem`, `autoidle`, `total`, `bar`, `vbar`, `ipat`, `user`, `nice`,+ `system`, `idle`, `total0`, `bar0`, `vbar0`, `ipat0`, `user0`, `nice0`, `system0`, `idle0`, ... The auto* variables automatically detect the number of CPUs on the system and display one entry for each.@@ -781,9 +833,15 @@ - `-p`: color to display positive power (battery charging) - `-f`: file in `/sys/class/power_supply` with AC info (default: "AC/online")+ - `--on-icon-pattern`: dynamic string for current battery charge+ when AC is "on" in `leftipat`.+ - `--off-icon-pattern`: dynamic string for current battery charge+ when AC is "off" in `leftipat`.+ - `--idle-icon-pattern`: dynamic string for current battery charge+ when AC is "idle" in `leftipat`. - Variables that can be used with the `-t`/`--template` argument:- `left`, `leftbar`, `leftvbar`, `timeleft`, `watts`, `acstatus`+ `left`, `leftbar`, `leftvbar`, `leftipat`, `timeleft`, `watts`, `acstatus` - Default template: `Batt: <watts>, <left>% / <timeleft>` - Example (note that you need "--" to separate regular monitor options from Battery's specific ones):@@ -856,10 +914,12 @@ - Aliases to `disku` - Disks: list of pairs of the form (device or mount point, template), where the template can contain `<size>`, `<free>`, `<used>`, `<freep>` or- `<usedp>`, `<freebar>`, `<freevbar>`, `<usedbar>` or `<usedvbar>` for total,- free, used, free percentage and used percentage of the given file system- capacity.-- Args: default monitor arguments. `-t`/`--template` is ignored.+ `<usedp>`, `<freebar>`, `<freevbar>`, `<freeipat>`, `<usedbar>`,+ `<usedvbar>` or `<usedipat>` for total, free, used, free percentage and+ used percentage of the given file system capacity.+- Args: default monitor arguments. `-t`/`--template` is ignored. Plus+ - `--free-icon-pattern`: dynamic string for free disk space in `freeipat`.+ - `--used-icon-pattern`: dynamic string for used disk space in `usedipat`. - Default template: none (you must specify a template for each file system). - Example: @@ -873,9 +933,13 @@ - Disks: list of pairs of the form (device or mount point, template), where the template can contain `<total>`, `<read>`, `<write>` for total, read and write speed, respectively. There are also bar versions of each:- `<totalbar>`, `<totalvbar>`, `<readbar>`, `<readvbar>`, `<writebar>`, and- `<writevbar>`.-- Args: default monitor arguments. `-t`/`--template` is ignored.+ `<totalbar>`, `<totalvbar>`, `<totalipat>`,+ `<readbar>`, `<readvbar>`, `<readipat>`,+ `<writebar>`, `<writevbar>`, and `<writeipat>`.+- Args: default monitor arguments. `-t`/`--template` is ignored. Plus+ - `--total-icon-pattern`: dynamic string for total disk I/O in `<totalipat>`.+ - `--write-icon-pattern`: dynamic string for write disk I/O in `<writeipat>`.+ - `--read-icon-pattern`: dynamic string for read disk I/O in `<readipat>`. - Default template: none (you must specify a template for each file system). - Example: @@ -963,8 +1027,9 @@ - Long option: `--offc` - `--highd` _number_ High threshold for dB. Defaults to -5.0. - `--lowd` _number_ Low threshold for dB. Defaults to -30.0.+ - `--volume-icon-pattern` _string_ dynamic string for current volume in `volumeipat`. - Variables that can be used with the `-t`/`--template` argument:- `volume`, `volumebar`, `volumevbar`, `dB`, `status`+ `volume`, `volumebar`, `volumevbar`, `volumeipat`, `dB`, `status` - Note that `dB` might only return 0 on your system. This is known to happen on systems with a pulseaudio backend. - Default template: `Vol: <volume>% <status>`@@ -981,9 +1046,10 @@ `-P`, `-S` and `-Z`, with an string argument, to represent the 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.+ mpd server to communicate with. Also available:+ - `lapsed-icon-pattern`: dynamic string for current track position in `ipat`. - Variables that can be used with the `-t`/`--template` argument:- `bar`, `vbar`, `state`, `statei`, `volume`, `length`,+ `bar`, `vbar`, `ipat`, `state`, `statei`, `volume`, `length`, `lapsed`, `remaining`, `plength` (playlist length), `ppos` (playlist position), `name`, `artist`, `composer`, `performer`,@@ -1103,8 +1169,9 @@ actual_brightness) - `-M`: file with the maximum brightness (default: max_brightness)+ - `--brightness-icon-pattern`: dynamic string for current brightness in `ipat`. - Variables that can be used with the `-t`/`--template` argument:- `vbar`, `percent`, `bar`+ `vbar`, `percent`, `bar`, `ipat` - Default template: `<percent>` - Example: @@ -1220,6 +1287,14 @@ - Reads its displayed output from the given pipe. - Prefix an optional default text separated by a colon +<font size="+1">**`MarqueePipeReader "default text:/path/to/pipe" (length, rate, sep) Alias`**</font>++- Generally equivalent to PipeReader+- Text is displayed as marquee with the specified length, rate in 10th+ seconds and separator when it wraps around++ Run MarqueePipeReader "/tmp/testpipe" (10, 7, "+") "mpipe"+ <font size="+1"> **`BufferedPipeReader Alias [(Timeout, Bool, "/path/to/pipe1"), ..]`** </font>@@ -1408,16 +1483,17 @@ version 0.11.1. Since then, it is maintained and developed by [jao], with the help of the greater xmobar and Haskell communities. -In particular, xmobar [incorporates patches] by Ben Boeckel, Roman-Cheplyaka, Patrick Chilton, Nathaniel Wesley Filardo, John Goerzen,-Reto Hablützel, Juraj Hercek, Tomas Janousek, Spencer Janssen, Jochen-Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin,-Todd Lunter, Robert J. Macomber, Dmitry Malikov, David McLean, Marcin-Mikołajczyk, Eric Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove,-Martin Perner, Jens Petersen, Alexander Polakov, Petr Rockai, Peter-Simons, Andrew Sackville-West, Alexander Solovyov, John Soros, Artem-Tarasov, Sergei Trofimovich, Thomas Tuegel, Jan Vornberger, Daniel-Wagner and Norbert Zeh.+In particular, xmobar [incorporates patches] by Axel Angel, Ben+Boeckel, Roman Cheplyaka, Patrick Chilton, Nathaniel Wesley Filardo,+John Goerzen, Reto Hablützel, Juraj Hercek, Tomas Janousek, Spencer+Janssen, Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz,+Dmitry Kurochkin, Todd Lunter, Robert J. Macomber, Dmitry Malikov,+David McLean, Marcin Mikołajczyk, Tony Morris, Eric Mrak, Thiago+Negri, Edward O'Callaghan, Svein Ove, Martin Perner, Jens Petersen,+Alexander Polakov, Petr Rockai, Andrew Sackville-West, Alexander+Shabalin, Peter Simons, Alexander Solovyov, John Soros, Travis Staton,+Artem Tarasov, Sergei Trofimovich, Thomas Tuegel, Jan Vornberger,+Anton Vorontsov, Daniel Wagner, Phil Xiaojun Hu and Norbert Zeh. [jao]: http://jao.io [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors@@ -1486,3 +1562,4 @@ [alsa-mixer]: http://hackage.haskell.org/package/alsa-mixer [timezone-olson]: http://hackage.haskell.org/package/timezone-olson [timezone-series]: http://hackage.haskell.org/package/timezone-series+[libXpm]: http://cgit.freedesktop.org/xorg/lib/libXpm
samples/xmobar.config view
@@ -8,10 +8,20 @@ , pickBroadest = False , persistent = False , hideOnStart = False- , commands = [ Run Weather "EGPF" ["-t","<station>: <tempC>C","-L","18","-H","25","--normal","green","--high","red","--low","lightblue"] 36000- , Run Network "eth0" ["-L","0","-H","32","--normal","green","--high","red"] 10- , Run Network "eth1" ["-L","0","-H","32","--normal","green","--high","red"] 10- , Run Cpu ["-L","3","-H","50","--normal","green","--high","red"] 10+ , iconRoot = "."+ , allDesktops = True+ , overrideRedirect = True+ , commands = [ Run Weather "EGPF" ["-t","<station>: <tempC>C",+ "-L","18","-H","25",+ "--normal","green",+ "--high","red",+ "--low","lightblue"] 36000+ , Run Network "eth0" ["-L","0","-H","32",+ "--normal","green","--high","red"] 10+ , Run Network "eth1" ["-L","0","-H","32",+ "--normal","green","--high","red"] 10+ , Run Cpu ["-L","3","-H","50",+ "--normal","green","--high","red"] 10 , Run Memory ["-t","Mem: <usedratio>%"] 10 , Run Swap [] 10 , Run Com "uname" ["-s","-r"] "" 36000@@ -19,5 +29,6 @@ ] , sepChar = "%" , alignSep = "}{"- , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }{ <fc=#ee9a00>%date%</fc>| %EGPF% | %uname%"+ , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }\+ \{ <fc=#ee9a00>%date%</fc>| %EGPF% | %uname%" }
src/Actions.hs view
@@ -12,7 +12,7 @@ module Actions (Action(..), runAction, stripActions) where -import System.Process (runCommand)+import System.Process (system) import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Graphics.X11.Types (Button)@@ -21,14 +21,14 @@ deriving (Eq) runAction :: Action -> IO ()-runAction (Spawn _ s) = void $ runCommand s+runAction (Spawn _ s) = void $ system (s ++ "&") stripActions :: String -> String stripActions s = case matchRegex actionRegex s of Nothing -> s Just _ -> stripActions strippedOneLevel where- strippedOneLevel = subRegex actionRegex s $ "[action=\\1\\2]\\3[/action]"+ strippedOneLevel = subRegex actionRegex s "[action=\\1\\2]\\3[/action]" actionRegex :: Regex actionRegex = mkRegex "<action=`?([^>`]*)`?( +button=[12345]+)?>(.+)</action>"
src/Bitmap.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Bitmap@@ -15,47 +16,90 @@ , drawBitmap , Bitmap(..)) where +import Control.Applicative((<|>)) import Control.Monad+import Control.Monad.Except(MonadError(..), runExceptT)+import Control.Monad.Trans(MonadIO(..)) import Data.Map hiding (foldr, map, filter) import Graphics.X11.Xlib import System.Directory (doesFileExist)+import System.FilePath ((</>)) import System.Mem.Weak ( addFinalizer ) import ColorCache import Parsers (Widget(..)) import Actions (Action) +#ifdef XPM+import XPMFile(readXPMFile)+#endif++data BitmapType = Mono Pixel | Poly+ data Bitmap = Bitmap { width :: Dimension , height :: Dimension , pixmap :: Pixmap+ , shapePixmap :: Maybe Pixmap+ , bitmapType :: BitmapType } -updateCache :: Display -> Window -> Map FilePath Bitmap ->+updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath -> [[(Widget, String, Maybe [Action])]] -> IO (Map FilePath Bitmap)-updateCache dpy win cache ps = do+updateCache dpy win cache iconRoot ps = do let paths = map (\(Icon p, _, _) -> p) . concatMap (filter icons) $ ps icons (Icon _, _, _) = True icons _ = False+ expandPath path@('/':_) = path+ expandPath path@('.':'/':_) = path+ expandPath path@('.':'.':'/':_) = path+ expandPath path = iconRoot </> path go m path = if member path m then return m- else do bitmap <- loadBitmap dpy win path+ else do bitmap <- loadBitmap dpy win $ expandPath path return $ maybe m (\b -> insert path b m) bitmap foldM go cache paths +readBitmapFile'+ :: (MonadError String m, MonadIO m)+ => Display+ -> Drawable+ -> String+ -> m (Dimension, Dimension, Pixmap)+readBitmapFile' d w p = do+ res <- liftIO $ readBitmapFile d w p+ case res of+ Left err -> throwError err+ Right (bw, bh, bp, _, _) -> return (bw, bh, bp)+ loadBitmap :: Display -> Drawable -> FilePath -> IO (Maybe Bitmap) loadBitmap d w p = do exist <- doesFileExist p if exist then do- bmap <- readBitmapFile d w p- case bmap of- Right (bw, bh, bp, _, _) -> do- addFinalizer bp (freePixmap d bp)- return $ Just $ Bitmap bw bh bp+ res <- runExceptT $+ tryXBM+#ifdef XPM+ <|> tryXPM+#endif+ case res of+ Right b -> return $ Just b Left err -> do putStrLn err return Nothing else return Nothing+ where tryXBM = do+ (bw, bh, bp) <- readBitmapFile' d w p+ liftIO $ addFinalizer bp (freePixmap d bp)+ return $ Bitmap bw bh bp Nothing (Mono 1)+#ifdef XPM+ tryXPM = do+ (bw, bh, bp, mbpm) <- readXPMFile d w p+ liftIO $ addFinalizer bp (freePixmap d bp)+ case mbpm of+ Nothing -> return ()+ Just bpm -> liftIO $ addFinalizer bpm (freePixmap d bpm)+ return $ Bitmap bw bh bp mbpm Poly+#endif drawBitmap :: Display -> Drawable -> GC -> String -> String -> Position -> Position -> Bitmap -> IO ()@@ -63,6 +107,13 @@ withColors d [fc, bc] $ \[fc', bc'] -> do let w = width i h = height i+ y' = 1 + y - fromIntegral h `div` 2 setForeground d gc fc' setBackground d gc bc'- copyPlane d (pixmap i) p gc 0 0 w h x (1 + y - fromIntegral h `div` 2) 1+ case (shapePixmap i) of+ Nothing -> return ()+ Just mask -> setClipOrigin d gc x y' >> setClipMask d gc mask+ case bitmapType i of+ Poly -> copyArea d (pixmap i) p gc 0 0 w h x y'+ Mono pl -> copyPlane d (pixmap i) p gc 0 0 w h x y' pl+ setClipMask d gc 0
src/ColorCache.hs view
@@ -35,10 +35,10 @@ data DynPixel = DynPixel Bool Pixel initColor :: Display -> String -> IO DynPixel-initColor dpy c = handle black $ (initColor' dpy c)+initColor dpy c = handle black $ initColor' dpy c where black :: SomeException -> IO DynPixel- black = (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))+ black = const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy) type ColorCache = [(String, Color)] {-# NOINLINE colorCache #-}
src/Config.hs view
@@ -30,6 +30,7 @@ import Plugins.Date import Plugins.PipeReader import Plugins.BufferedPipeReader+import Plugins.MarqueePipeReader import Plugins.CommandReader import Plugins.StdinReader import Plugins.XMonadLog@@ -53,6 +54,7 @@ , position :: XPosition -- ^ Top Bottom or Static , border :: Border -- ^ NoBorder TopB BottomB or FullB , borderColor :: String -- ^ Border color+ , borderWidth :: Int -- ^ Border width , hideOnStart :: Bool -- ^ Hide (Unmap) the window on -- initialization , allDesktops :: Bool -- ^ Tell the WM to map to all desktops@@ -65,6 +67,7 @@ -- window stack on initialization , persistent :: Bool -- ^ Whether automatic hiding should -- be enabled or disabled+ , iconRoot :: FilePath -- ^ Root folder for icons , commands :: [Runnable] -- ^ For setting the command, -- the command arguments -- and refresh rate for the programs@@ -109,12 +112,14 @@ , position = Top , border = NoBorder , borderColor = "#BFBFBF"+ , borderWidth = 1 , hideOnStart = False , lowerOnStart = True , persistent = False , allDesktops = True , overrideRedirect = True , pickBroadest = False+ , iconRoot = "." , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10 , Run StdinReader] , sepChar = "%"@@ -136,6 +141,6 @@ -- this function's type signature. runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: Mail :*: MBox :*:- DateZone :*:+ DateZone :*: MarqueePipeReader :*: () runnableTypes = undefined
src/IPC/DBus.hs view
@@ -44,7 +44,7 @@ sendSignalMethod :: TMVar SignalType -> Method sendSignalMethod mvst = method interfaceName sendSignalName- (signature_ [variantType $ toVariant $ (undefined :: SignalType)])+ (signature_ [variantType $ toVariant (undefined :: SignalType)]) (signature_ []) sendSignalMethodCall where
src/Main.hs view
@@ -37,7 +37,7 @@ import System.Environment import System.FilePath ((</>)) import System.Posix.Files-import Control.Monad (unless)+import Control.Monad (unless, liftM) import Signal (setupSignalHandler) @@ -94,13 +94,13 @@ xdgConfigDir = do env <- getEnvironment case lookup "XDG_CONFIG_HOME" env of Just val -> return val- Nothing -> getHomeDirectory >>= return . (</> ".config")+ Nothing -> liftM (</> ".config") getHomeDirectory xmobarConfigDir :: IO FilePath-xmobarConfigDir = xdgConfigDir >>= return . (</> "xmobar")+xmobarConfigDir = liftM (</> "xmobar") xdgConfigDir getXdgConfigFile :: IO FilePath-getXdgConfigFile = xmobarConfigDir >>= return . (</> "xmobarrc")+getXdgConfigFile = liftM (</> "xmobarrc") xmobarConfigDir -- | Read default configuration file or load the default config readDefaultConfig :: IO (Config,[String])@@ -130,6 +130,7 @@ | SepChar String | Template String | OnScr String+ | IconRoot String deriving Show options :: [OptDescr Opts]@@ -141,6 +142,8 @@ "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 "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"@@ -203,6 +206,7 @@ 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})
src/MinXft.hsc view
@@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: MinXft--- Copyright: (c) 2012 Jose Antonio Ortega Ruiz+-- Copyright: (c) 2012, 2014 Jose Antonio Ortega Ruiz -- (c) Clemens Fruhwirth <clemens@endorphin.org> 2007 -- License: BSD3-style (see LICENSE) --@@ -26,13 +26,18 @@ , freeAXftColor , withAXftDraw , drawXftString+ , drawXftString' , drawXftRect , openAXftFont , closeAXftFont , xftTxtExtents+ , xftTxtExtents' , xft_ascent+ , xft_ascent' , xft_descent+ , xft_descent' , xft_height+ , xft_height' ) where@@ -45,6 +50,7 @@ import Foreign.C.Types import Foreign.C.String import Codec.Binary.UTF8.String as UTF8+import Data.Char (ord) #include <X11/Xft/Xft.h> @@ -73,12 +79,21 @@ xft_ascent :: AXftFont -> IO Int xft_ascent (AXftFont p) = peekCUShort p #{offset XftFont, ascent} +xft_ascent' :: [AXftFont] -> IO Int+xft_ascent' = (fmap maximum) . (mapM xft_ascent)+ xft_descent :: AXftFont -> IO Int xft_descent (AXftFont p) = peekCUShort p #{offset XftFont, descent} +xft_descent' :: [AXftFont] -> IO Int+xft_descent' = (fmap maximum) . (mapM xft_descent)+ xft_height :: AXftFont -> IO Int xft_height (AXftFont p) = peekCUShort p #{offset XftFont, height} +xft_height' :: [AXftFont] -> IO Int+xft_height' = (fmap maximum) . (mapM xft_height)+ foreign import ccall "XftTextExtentsUtf8" cXftTextExtentsUtf8 :: Display -> AXftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO () @@ -90,6 +105,12 @@ cXftTextExtentsUtf8 d f str_ptr (fi len) cglyph peek cglyph +xftTxtExtents' :: Display -> [AXftFont] -> String -> IO XGlyphInfo+xftTxtExtents' d fs string = do+ chunks <- getChunks d fs string+ let (_, _, gi, _, _) = last chunks+ return gi+ foreign import ccall "XftFontOpenName" c_xftFontOpen :: Display -> CInt -> CString -> IO AXftFont @@ -101,6 +122,14 @@ foreign import ccall "XftFontClose" closeAXftFont :: Display -> AXftFont -> IO () +foreign import ccall "XftCharExists"+ cXftCharExists :: Display -> AXftFont -> (#type FcChar32) -> IO (#type FcBool)++xftCharExists :: Display -> AXftFont -> Char -> IO Bool+xftCharExists d f c = bool `fmap` cXftCharExists d f (fi $ ord c)+ where+ bool 0 = False+ bool _ = True -- Drawing fi :: (Integral a, Num b) => a -> b@@ -111,6 +140,9 @@ foreign import ccall "XftDrawCreate" c_xftDrawCreate :: Display -> Drawable -> Visual -> Colormap -> IO AXftDraw +foreign import ccall "XftDrawDisplay"+ c_xftDrawDisplay :: AXftDraw -> IO Display+ foreign import ccall "XftDrawDestroy" c_xftDrawDestroy :: AXftDraw -> IO () @@ -129,6 +161,56 @@ drawXftString d c f x y string = withArrayLen (map fi (UTF8.encode string)) (\len ptr -> cXftDrawStringUtf8 d c f (fi x) (fi y) ptr (fi len))++drawXftString' :: AXftDraw ->+ AXftColor ->+ [AXftFont] ->+ Integer ->+ Integer ->+ String -> IO ()+drawXftString' d c fs x y string = do+ display <- c_xftDrawDisplay d+ chunks <- getChunks display fs string+ mapM_ (\(f, s, _, xo, yo) -> drawXftString d c f (x+xo) (y+yo) s) chunks++-- Split string and determine fonts/offsets for individual parts+getChunks :: Display -> [AXftFont] -> [Char] ->+ IO [(AXftFont, String, XGlyphInfo, Integer, Integer)]+getChunks disp fts str = do+ chunks <- getFonts disp fts str+ getOffsets (XGlyphInfo 0 0 0 0 0 0) chunks+ where+ -- Split string and determine fonts for individual parts+ getFonts _ [] _ = return []+ getFonts _ _ [] = return []+ getFonts _ [ft] s = return [(ft, s)]+ getFonts d fonts@(ft:_) s = do+ -- Determine which glyph can be rendered by current font+ glyphs <- mapM (xftCharExists d ft) s+ -- Split string into parts that can/cannot be rendered+ let splits = split (runs glyphs) s+ -- Determine which font to render each chunk with+ concat `fmap` mapM (getFont d fonts) splits++ -- Determine fonts for substrings+ getFont _ [] _ = return []+ getFont _ [ft] (_, s) = return [(ft, s)] -- Last font, use it+ getFont _ (ft:_) (True, s) = return [(ft, s)] -- Current font can render this substring+ getFont d (_:fs) (False, s) = getFonts d fs s -- Fallback to next font++ -- Helpers+ runs [] = []+ runs (x:xs) = let (h, t) = span (==x) xs in (x, length h + 1) : runs t+ split [] _ = []+ split ((x, c):xs) s = let (h, t) = splitAt c s in (x, h) : split xs t++ -- Determine coordinates for chunks using extents+ getOffsets _ [] = return []+ getOffsets (XGlyphInfo _ _ x y xo yo) ((f, s):chunks) = do+ (XGlyphInfo w' h' _ _ xo' yo') <- xftTxtExtents disp f s+ let gi = XGlyphInfo (xo+w') (yo+h') x y (xo+xo') (yo+yo')+ rest <- getOffsets gi chunks+ return $ (f, s, gi, fromIntegral xo, fromIntegral yo) : rest foreign import ccall "XftDrawRect" cXftDrawRect :: AXftDraw -> AXftColor -> CInt -> CInt -> CUInt -> CUInt -> IO ()
src/Parsers.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Parsers@@ -25,7 +25,7 @@ import Commands import Actions -import Control.Monad (guard, mzero)+import Control.Monad (guard, mzero, liftM) import qualified Data.Map as Map import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Perm@@ -87,7 +87,7 @@ char ':' case reads lenstr of [(len,[])] -> do- guard ((len :: Integer) <= (fromIntegral (maxBound :: Int)))+ guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) s <- count (fromIntegral len) anyChar string "/>" return [(Text s, c, a)]@@ -123,7 +123,7 @@ return (concat s) toButtons :: String -> [Button]-toButtons s = map (\x -> read [x]) s+toButtons = map (\x -> read [x]) -- | Parsers a string wrapped in a color specification. colorParser :: Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])]@@ -180,9 +180,6 @@ stripComments = unlines . map (drop 5 . strip False . (replicate 5 ' '++)) . lines where strip m ('-':'-':xs) = if m then "--" ++ strip m xs else ""- strip m ('\\':xss) = case xss of- '\\':xs -> '\\' : strip m xs- _ -> strip m $ drop 1 xss strip m ('"':xs) = '"': strip (not m) xs strip m (x:xs) = x : strip m xs strip _ [] = []@@ -202,16 +199,17 @@ perms = permute $ Config <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition- <|?> pBorder <|?> pBdColor <|?> pHideOnStart <|?> pAllDesktops- <|?> pOverrideRedirect <|?> pPickBroadest- <|?> pLowerOnStart <|?> pPersistent+ <|?> pBorder <|?> pBdColor <|?> pBdWidth <|?> pHideOnStart+ <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest+ <|?> pLowerOnStart <|?> pPersistent <|?> pIconRoot <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" , "border", "borderColor" ,"template", "position" , "allDesktops", "overrideRedirect", "pickBroadest"- , "hideOnStart", "lowerOnStart", "persistent", "commands"+ , "hideOnStart", "lowerOnStart", "persistent", "iconRoot"+ , "commands" ] pFont = strField font "font"@@ -227,9 +225,11 @@ pLowerOnStart = readField lowerOnStart "lowerOnStart" pPersistent = readField persistent "persistent" pBorder = readField border "border"+ pBdWidth = readField borderWidth "borderWidth" pAllDesktops = readField allDesktops "allDesktops" pOverrideRedirect = readField overrideRedirect "overrideRedirect" pPickBroadest = readField pickBroadest "pickBroadest"+ pIconRoot = readField iconRoot "iconRoot" pCommands = field commands "commands" readCommands @@ -249,11 +249,17 @@ readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]" - strField e n = field e n . between (strDel "start" n) (strDel "end" n) .- many $ noneOf "\"\n\r"- strDel t n = char '"' <?> strErr t n- strErr t n = "the " ++ t ++ " of the string field " ++ n ++- " - a double quote (\")."+ strField e n = field e n strMulti++ strMulti = scan '"'+ where+ scan lead = do+ spaces+ char lead+ s <- manyTill anyChar (rowCont <|> unescQuote)+ (char '"' >> return s) <|> liftM (s ++) (scan '\\')+ rowCont = try $ char '\\' >> string "\n"+ unescQuote = lookAhead (noneOf "\\") >> lookAhead (string "\"") wrapSkip x = many space >> x >>= \r -> many space >> return r sepEndSpc = mapM_ (wrapSkip . try . string)
src/Plugins/BufferedPipeReader.hs view
@@ -14,7 +14,7 @@ module Plugins.BufferedPipeReader where -import Control.Monad(forM_, when)+import Control.Monad(forM_, when, void) import Control.Concurrent import Control.Concurrent.STM import System.IO@@ -66,7 +66,7 @@ where sfork :: IO () -> IO ()- sfork f = forkIO f >> return ()+ sfork f = void (forkIO f) update :: IO (Int, Bool, String, TVar Bool) update = atomically $ do
src/Plugins/Date.hs view
@@ -21,6 +21,7 @@ import Plugins import System.Locale+import Control.Monad (liftM) import Data.Time data Date = Date String String Int@@ -32,4 +33,4 @@ rate (Date _ _ r) = r date :: String -> IO String-date format = getZonedTime >>= return . formatTime defaultTimeLocale format+date format = liftM (formatTime defaultTimeLocale format) getZonedTime
src/Plugins/EWMH.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -w #-}-{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- |@@ -58,7 +58,7 @@ liftIO $ nextEvent' d ep e <- liftIO $ getEvent ep case e of- PropertyEvent { ev_atom = a, ev_window = w } -> do+ PropertyEvent { ev_atom = a, ev_window = w } -> case lookup a handlers' of Just f -> f w _ -> return ()@@ -95,7 +95,7 @@ attrs = [(n, [s | (s, b) <- stats i, b]) | (i, n) <- zip [0 ..] (desktopNames e)] nonEmptys = Set.unions . map desktops . Map.elems $ clients e -modifier :: Modifier -> (String -> String)+modifier :: Modifier -> String -> String modifier Hide = const "" modifier (Color fg bg) = \x -> concat ["<fc=", fg, if null bg then "" else "," ++ bg , ">", x, "</fc>"]@@ -227,9 +227,9 @@ dels = Map.difference cl cl' new = Map.difference cl' cl modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'})- mapM_ unmanage (map fst $ Map.toList dels)- mapM_ listen (map fst $ Map.toList cl')- mapM_ update (map fst $ Map.toList new)+ mapM_ (unmanage . fst) (Map.toList dels)+ mapM_ (listen . fst) (Map.toList cl')+ mapM_ (update . fst) (Map.toList new) _ -> return () where unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0
src/Plugins/Kbd.hsc view
@@ -276,6 +276,9 @@ xkbStateNotify :: CUInt xkbStateNotify = #const XkbStateNotify +xkbIndicatorStateNotify :: CUInt+xkbIndicatorStateNotify = #const XkbIndicatorStateNotify+ xkbMapNotify :: CUInt xkbMapNotify = #const XkbMapNotify
src/Plugins/Locks.hs view
@@ -20,6 +20,8 @@ import Control.Monad import Graphics.X11.Xlib.Extras import Plugins+import Plugins.Kbd+import XUtil (nextEvent') data Locks = Locks deriving (Read, Show)@@ -30,22 +32,33 @@ , ( xK_Scroll_Lock, "SCROLL" ) ] +run' :: Display -> Window -> IO String+run' d root = do+ modMap <- getModifierMapping d+ ( _, _, _, _, _, _, _, m ) <- queryPointer d root++ ls <- filterM ( \( ks, _ ) -> do+ kc <- keysymToKeycode d ks+ return $ case find (elem kc . snd) modMap of+ Nothing -> False+ Just ( i, _ ) -> testBit m (fromIntegral i)+ ) locks++ return $ unwords $ map snd ls+ instance Exec Locks where alias Locks = "locks"- rate Locks = 2- run Locks = do+ start Locks cb = do d <- openDisplay "" root <- rootWindow d (defaultScreen d)+ _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m - modMap <- getModifierMapping d- ( _, _, _, _, _, _, _, m ) <- queryPointer d root+ allocaXEvent $ \ep -> forever $ do+ cb =<< run' d root+ nextEvent' d ep+ getEvent ep - ls <- filterM ( \( ks, _ ) -> do- kc <- keysymToKeycode d ks- return $ case find (elem kc . snd) modMap of- Nothing -> False- Just ( i, _ ) -> testBit m (fromIntegral i)- ) locks closeDisplay d-- return $ unwords $ map snd ls+ return ()+ where+ m = xkbAllStateComponentsMask
src/Plugins/MBox.hs view
@@ -71,7 +71,7 @@ instance Exec MBox where alias (MBox _ _ a) = a #ifndef INOTIFY- start _ _ = do+ start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++ " but the MBox plugin requires it" #else
src/Plugins/Mail.hs view
@@ -41,7 +41,7 @@ instance Exec Mail where alias (Mail _ a) = a #ifndef INOTIFY- start _ _ = do+ start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify," ++ " but the Mail plugin requires it." #else
+ src/Plugins/MarqueePipeReader.hs view
@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.MarqueePipeReader+-- Copyright : (c) Reto Habluetzel+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for reading from named pipes for long texts with marquee+--+-----------------------------------------------------------------------------++module Plugins.MarqueePipeReader where++import System.IO (openFile, IOMode(ReadWriteMode), Handle)+import Plugins (tenthSeconds, Exec(alias, start), hGetLineSafe)+import System.Posix.Files (getFileStatus, isNamedPipe)+import Control.Concurrent(forkIO, threadDelay)+import Control.Concurrent.STM (TChan, atomically, writeTChan, tryReadTChan, newTChan)+import Control.Exception+import Control.Monad(forever, unless)++type Length = Int -- length of the text to display+type Rate = Int -- delay in tenth seconds +type Separator = String -- if text wraps around, use separator++data MarqueePipeReader = MarqueePipeReader String (Length, Rate, Separator) String+ deriving (Read, Show)++instance Exec MarqueePipeReader where+ alias (MarqueePipeReader _ _ a) = a+ start (MarqueePipeReader p (len, rate, sep) _) cb = do+ let (def, pipe) = split ':' p+ unless (null def) (cb def)+ checkPipe pipe+ h <- openFile pipe ReadWriteMode+ line <- hGetLineSafe h+ chan <- atomically newTChan+ forkIO $ writer (toInfTxt line sep) sep len rate chan cb+ forever $ pipeToChan h chan+ where+ split c xs | c `elem` xs = let (pre, post) = span (c /=) xs+ in (pre, dropWhile (c ==) post)+ | otherwise = ([], xs)++pipeToChan :: Handle -> TChan String -> IO ()+pipeToChan h chan = do+ line <- hGetLineSafe h + atomically $ writeTChan chan line++writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO ()+writer txt sep len rate chan cb = do + cb (take len txt)+ mbnext <- atomically $ tryReadTChan chan+ case mbnext of+ Just new -> writer (toInfTxt new sep) sep len rate chan cb+ Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb ++toInfTxt :: String -> String -> String+toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ")++checkPipe :: FilePath -> IO ()+checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do+ status <- getFileStatus file+ unless (isNamedPipe status) waitForPipe+ where waitForPipe = threadDelay 1000 >> checkPipe file
src/Plugins/Monitors.hs view
@@ -108,17 +108,17 @@ alias (Cpu _ _) = "cpu" alias (MultiCpu _ _) = "multicpu" alias (Battery _ _) = "battery"- alias (BatteryP _ _ _)= "battery"+ alias (BatteryP {})= "battery" alias (BatteryN _ _ _ a)= a alias (Brightness _ _) = "bright" alias (CpuFreq _ _) = "cpufreq" alias (TopProc _ _) = "top" alias (TopMem _ _) = "topmem" alias (CoreTemp _ _) = "coretemp"- alias (DiskU _ _ _) = "disku"- alias (DiskIO _ _ _) = "diskio"+ alias (DiskU {}) = "disku"+ alias (DiskIO {}) = "diskio" alias (Uptime _ _) = "uptime"- alias (CatInt n _ _ _) = "cat" ++ (show n)+ alias (CatInt n _ _ _) = "cat" ++ show n #ifdef IWLIB alias (Wireless i _ _) = i ++ "wi" #endif@@ -156,7 +156,7 @@ start (Uptime a r) = runM a uptimeConfig runUptime r start (CatInt _ s a r) = runM a catIntConfig (runCatInt s) r #ifdef IWLIB- start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r+ start (Wireless i a r) = runM a wirelessConfig (runWireless i) r #endif #ifdef LIBMPD start (MPD a r) = runMD a mpdConfig runMPD r mpdReady
src/Plugins/Monitors/Batt.hs view
@@ -34,6 +34,9 @@ , highThreshold :: Float , onlineFile :: FilePath , scale :: Float+ , onIconPattern :: Maybe IconPattern+ , offIconPattern :: Maybe IconPattern+ , idleIconPattern :: Maybe IconPattern } defaultOpts :: BattOpts@@ -49,6 +52,9 @@ , highThreshold = -10 , onlineFile = "AC/online" , scale = 1e6+ , onIconPattern = Nothing+ , offIconPattern = Nothing+ , idleIconPattern = Nothing } options :: [OptDescr (BattOpts -> BattOpts)]@@ -64,6 +70,12 @@ , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") "" , Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") "" , Option "s" ["scale"] (ReqArg (\x o -> o {scale = read x}) "") ""+ , Option "" ["on-icon-pattern"] (ReqArg (\x o ->+ o { onIconPattern = Just $ parseIconPattern x }) "") ""+ , Option "" ["off-icon-pattern"] (ReqArg (\x o ->+ o { offIconPattern = Just $ parseIconPattern x }) "") ""+ , Option "" ["idle-icon-pattern"] (ReqArg (\x o ->+ o { idleIconPattern = Just $ parseIconPattern x }) "") "" ] parseOpts :: [String] -> IO BattOpts@@ -72,15 +84,17 @@ (o, _, []) -> return $ foldr id defaultOpts o (_, _, errs) -> ioError . userError $ concat errs -data Result = Result Float Float Float String | NA+data Status = Charging | Discharging | Idle +data Result = Result Float Float Float Status | NA+ sysDir :: FilePath sysDir = "/sys/class/power_supply" battConfig :: IO MConfig battConfig = mkMConfig "Batt: <watts>, <left>% / <timeleft>" -- template- ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts"] -- replacements+ ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"] -- replacements data Files = Files { fFull :: String@@ -105,7 +119,7 @@ do is_charge <- exists "charge_now" is_energy <- if is_charge then return False else exists "energy_now" is_power <- exists "power_now"- plain <- if is_charge then exists "charge_full" else exists "energy_full"+ plain <- exists (if is_charge then "charge_full" else "energy_full") let cf = if is_power then "power_now" else "current_now" sf = if plain then "" else "_design" return $ case (is_charge, is_energy) of@@ -150,9 +164,10 @@ time = if idle then 0 else sum $ map time' bats mwatts = if idle then 1 else sign * watts time' b = (if ac then full b - now b else now b) / mwatts- acstr = if idle then idleString opts else- if ac then onString opts else offString opts- return $ if isNaN left then NA else Result left watts time acstr+ acst | idle = Idle+ | ac = Charging+ | otherwise = Discharging+ return $ if isNaN left then NA else Result left watts time acst runBatt :: [String] -> Monitor String runBatt = runBatt' ["BAT0","BAT1","BAT2"]@@ -167,7 +182,8 @@ Result x w t s -> do l <- fmtPercent x ws <- fmtWatts w opts suffix d- parseTemplate (l ++ [s, fmtTime $ floor t, ws])+ si <- getIconPattern opts s x+ parseTemplate (l ++ [fmtStatus opts s, fmtTime $ floor t, ws, si]) NA -> getConfigValue naString where fmtPercent :: Float -> Monitor [String] fmtPercent x = do@@ -184,9 +200,18 @@ then minutes else '0' : minutes where hours = show (x `div` 3600) minutes = show ((x `mod` 3600) `div` 60)+ fmtStatus opts Idle = idleString opts+ fmtStatus opts Charging = onString opts+ fmtStatus opts Discharging = offString opts maybeColor Nothing str = str maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>" color x o | x >= 0 = maybeColor (posColor o) | -x >= highThreshold o = maybeColor (highWColor o) | -x >= lowThreshold o = maybeColor (mediumWColor o) | otherwise = maybeColor (lowWColor o)+ getIconPattern opts status x = do+ let x' = minimum [1, x]+ case status of+ Idle -> showIconPattern (idleIconPattern opts) x'+ Charging -> showIconPattern (onIconPattern opts) x'+ Discharging -> showIconPattern (offIconPattern opts) x'
src/Plugins/Monitors/Bright.hs view
@@ -14,6 +14,7 @@ module Plugins.Monitors.Bright (brightConfig, runBright) where +import Control.Applicative ((<$>)) import Control.Exception (SomeException, handle) import qualified Data.ByteString.Lazy.Char8 as B import System.FilePath ((</>))@@ -25,18 +26,22 @@ data BrightOpts = BrightOpts { subDir :: String , currBright :: String , maxBright :: String+ , curBrightIconPattern :: Maybe IconPattern } defaultOpts :: BrightOpts defaultOpts = BrightOpts { subDir = "acpi_video0" , currBright = "actual_brightness" , maxBright = "max_brightness"+ , curBrightIconPattern = Nothing } options :: [OptDescr (BrightOpts -> BrightOpts)] options = [ Option "D" ["device"] (ReqArg (\x o -> o { subDir = x }) "") "" , Option "C" ["curr"] (ReqArg (\x o -> o { currBright = x }) "") "" , Option "M" ["max"] (ReqArg (\x o -> o { maxBright = x }) "") ""+ , Option "" ["brightness-icon-pattern"] (ReqArg (\x o ->+ o { curBrightIconPattern = Just $ parseIconPattern x }) "") "" ] -- from Batt.hs@@ -51,7 +56,7 @@ brightConfig :: IO MConfig brightConfig = mkMConfig "<percent>" -- template- ["vbar", "percent", "bar"] -- replacements+ ["vbar", "percent", "bar", "ipat"] -- replacements data Files = Files { fCurr :: String , fMax :: String@@ -60,12 +65,12 @@ brightFiles :: BrightOpts -> IO Files brightFiles opts = do- is_curr <- fileExist $ (fCurr files)- is_max <- fileExist $ (fCurr files)- if is_curr && is_max then return files else return NoFiles- where prefix = sysDir </> (subDir opts)- files = Files { fCurr = prefix </> (currBright opts)- , fMax = prefix </> (maxBright opts)+ is_curr <- fileExist $ fCurr files+ is_max <- fileExist $ fCurr files+ return (if is_curr && is_max then files else NoFiles)+ where prefix = sysDir </> subDir opts+ files = Files { fCurr = prefix </> currBright opts+ , fMax = prefix </> maxBright opts } runBright :: [String] -> Monitor String@@ -75,19 +80,20 @@ c <- io $ readBright f case f of NoFiles -> return "hurz"- _ -> fmtPercent c >>= parseTemplate- where fmtPercent :: Float -> Monitor [String]- fmtPercent c = do r <- showVerticalBar (100 * c) c- s <- showPercentWithColors c- t <- showPercentBar (100 * c) c- return [r,s,t]+ _ -> fmtPercent opts c >>= parseTemplate+ where fmtPercent :: BrightOpts -> Float -> Monitor [String]+ fmtPercent opts c = do r <- showVerticalBar (100 * c) c+ s <- showPercentWithColors c+ t <- showPercentBar (100 * c) c+ d <- showIconPattern (curBrightIconPattern opts) c+ return [r,s,t,d] readBright :: Files -> IO Float readBright NoFiles = return 0 readBright files = do- currVal<- grab $ (fCurr files)- maxVal <- grab $ (fMax files)- return $ (currVal / maxVal)- where grab f = handle handler (fmap (read . B.unpack) $ B.readFile f)+ currVal<- grab $ fCurr files+ maxVal <- grab $ fMax files+ return (currVal / maxVal)+ where grab f = handle handler (read . B.unpack <$> B.readFile f) handler = const (return 0) :: SomeException -> IO Float
src/Plugins/Monitors/CatInt.hs view
@@ -20,6 +20,6 @@ runCatInt :: FilePath -> [String] -> Monitor String runCatInt p _ =- let failureMessage = "Cannot read: " ++ (show p)+ let failureMessage = "Cannot read: " ++ show p fmt x = show (truncate x :: Int) in checkedDataRetrieval failureMessage [[p]] Nothing id fmt
src/Plugins/Monitors/Common.hs view
@@ -40,6 +40,8 @@ , parseTemplate' -- ** String Manipulation -- $strings+ , IconPattern+ , parseIconPattern , padString , showWithPadding , showWithColors@@ -48,8 +50,10 @@ , showPercentsWithColors , showPercentBar , showVerticalBar+ , showIconPattern , showLogBar , showLogVBar+ , showLogIconPattern , showWithUnits , takeDigits , showDigits@@ -60,6 +64,7 @@ ) where +import Control.Applicative ((<$>)) import Control.Monad.Reader import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef@@ -112,7 +117,7 @@ setConfigValue :: a -> Selector a -> Monitor () setConfigValue v s =- mods s (\_ -> v)+ mods s (const v) getConfigValue :: Selector a -> Monitor a getConfigValue = sel@@ -342,11 +347,23 @@ do next <- combine m xs str <- case Map.lookup ts m of Nothing -> return $ "<" ++ ts ++ ">"- Just r -> let f "" = r; f n = n; in fmap f $ parseTemplate' r m+ Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m return $ s ++ str ++ ss ++ next -- $strings +type IconPattern = Int -> String++parseIconPattern :: String -> IconPattern+parseIconPattern path =+ let spl = splitOnPercent path+ in \i -> concat $ intersperse (show i) spl+ where splitOnPercent [] = [[]]+ splitOnPercent ('%':'%':xs) = [] : splitOnPercent xs+ splitOnPercent (x:xs) =+ let rest = splitOnPercent xs+ in (x : head rest) : tail rest+ type Pos = (Int, Int) takeDigits :: Int -> Float -> Float@@ -452,6 +469,15 @@ s <- colorizeString v (take len $ cycle bf) return $ s ++ take (bw - len) (cycle bb) +showIconPattern :: Maybe IconPattern -> Float -> Monitor String+showIconPattern Nothing _ = return ""+showIconPattern (Just str) x = return $ str $ convert $ 100 * x+ where convert val+ | t <= 0 = 0+ | t > 8 = 8+ | otherwise = t+ where t = round val `div` 12+ showVerticalBar :: Float -> Float -> Monitor String showVerticalBar v x = colorizeString v [convert $ 100 * x] where convert :: Float -> Char@@ -459,10 +485,23 @@ | t <= 9600 = ' ' | t > 9608 = chr 9608 | otherwise = chr t- where t = 9600 + ((round val) `div` 12)+ where t = 9600 + (round val `div` 12) showLogBar :: Float -> Float -> Monitor String-showLogBar f v = do+showLogBar f v = + let intConfig c = fromIntegral `fmap` getConfigValue c+ in do+ h <- intConfig high+ l <- intConfig low+ bw <- intConfig barWidth+ let [ll, hh] = sort [l, h]+ choose x | x == 0.0 = 0+ | x <= ll = 1 / bw+ | otherwise = f + logBase 2 (x / hh) / bw+ showPercentBar v $ choose v++showLogVBar :: Float -> Float -> Monitor String+showLogVBar f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth@@ -470,10 +509,10 @@ choose x | x == 0.0 = 0 | x <= ll = 1 / bw | otherwise = f + logBase 2 (x / hh) / bw- showPercentBar v $ choose v+ showVerticalBar v $ choose v -showLogVBar :: Float -> Float -> Monitor String-showLogVBar f v = do+showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String+showLogIconPattern str f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth@@ -481,4 +520,4 @@ choose x | x == 0.0 = 0 | x <= ll = 1 / bw | otherwise = f + logBase 2 (x / hh) / bw- showVerticalBar v $ choose v+ showIconPattern str $ choose v
src/Plugins/Monitors/CoreTemp.hs view
@@ -27,8 +27,8 @@ coreTempConfig :: IO MConfig coreTempConfig = mkMConfig "Temp: <core0>C" -- template- (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available- -- replacements+ (map ((++) "core" . show) [0 :: Int ..]) -- available+ -- replacements -- | -- Function retrieves monitor string holding the core temperature@@ -39,7 +39,7 @@ failureMessage <- getConfigValue naString let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"] path' = ["/sys/bus/platform/devices/coretemp.", "/hwmon/hwmon", "/temp", "_input"]- lbl = Just ("_label", read . (dropWhile (not . isDigit)))+ lbl = Just ("_label", read . dropWhile (not . isDigit)) divisor = 1e3 :: Double show' = showDigits (max 0 dn) checkedDataRetrieval failureMessage [path, path'] lbl (/divisor) show'
src/Plugins/Monitors/Cpu.hs view
@@ -18,11 +18,33 @@ import Plugins.Monitors.Common import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import System.Console.GetOpt +data CpuOpts = CpuOpts+ { loadIconPattern :: Maybe IconPattern+ }++defaultOpts :: CpuOpts+defaultOpts = CpuOpts+ { loadIconPattern = Nothing+ }++options :: [OptDescr (CpuOpts -> CpuOpts)]+options =+ [ Option "" ["load-icon-pattern"] (ReqArg (\x o ->+ o { loadIconPattern = Just $ parseIconPattern x }) "") ""+ ]++parseOpts :: [String] -> IO CpuOpts+parseOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs+ cpuConfig :: IO MConfig cpuConfig = mkMConfig "Cpu: <total>%"- ["bar","vbar","total","user","nice","system","idle","iowait"]+ ["bar","vbar","ipat","total","user","nice","system","idle","iowait"] type CpuDataRef = IORef [Int] @@ -38,23 +60,25 @@ b <- cpuData writeIORef cref b let dif = zipWith (-) b a- tot = fromIntegral $ foldr (+) 0 dif- percent = map (/ tot) (map fromIntegral dif)+ tot = fromIntegral $ sum dif+ percent = map ((/ tot) . fromIntegral) dif return percent -formatCpu :: [Float] -> Monitor [String]-formatCpu [] = return $ replicate 8 ""-formatCpu xs = do+formatCpu :: CpuOpts -> [Float] -> Monitor [String]+formatCpu _ [] = return $ replicate 8 ""+formatCpu opts xs = do let t = sum $ take 3 xs b <- showPercentBar (100 * t) t v <- showVerticalBar (100 * t) t+ d <- showIconPattern (loadIconPattern opts) t ps <- showPercentsWithColors (t:xs)- return (b:v:ps)+ return (b:v:d:ps) runCpu :: CpuDataRef -> [String] -> Monitor String-runCpu cref _ =+runCpu cref argv = do c <- io (parseCpu cref)- l <- formatCpu c+ opts <- io $ parseOpts argv+ l <- formatCpu opts c parseTemplate l startCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
src/Plugins/Monitors/CpuFreq.hs view
@@ -24,8 +24,8 @@ cpuFreqConfig :: IO MConfig cpuFreqConfig = mkMConfig "Freq: <cpu0>" -- template- (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available- -- replacements+ (map ((++) "cpu" . show) [0 :: Int ..]) -- available+ -- replacements -- | -- Function retrieves monitor string holding the cpu frequency (or frequencies)@@ -33,7 +33,7 @@ runCpuFreq _ = do let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"] divisor = 1e6 :: Double- fmt x | x < 1 = (show (round (x * 1000) :: Integer)) ++ "MHz"- | otherwise = (show x) ++ "GHz"+ fmt x | x < 1 = show (round (x * 1000) :: Integer) ++ "MHz"+ | otherwise = show x ++ "GHz" failureMessage <- getConfigValue naString checkedDataRetrieval failureMessage [path] Nothing (/divisor) fmt
src/Plugins/Monitors/Disk.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk--- Copyright : (c) 2010, 2011, 2012 Jose A Ortega Ruiz+-- Copyright : (c) 2010, 2011, 2012, 2014 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>@@ -25,16 +25,67 @@ import Data.List (isPrefixOf, find) import Data.Maybe (catMaybes) import System.Directory (canonicalizePath, doesFileExist)+import System.Console.GetOpt +data DiskIOOpts = DiskIOOpts+ { totalIconPattern :: Maybe IconPattern+ , writeIconPattern :: Maybe IconPattern+ , readIconPattern :: Maybe IconPattern+ }++parseDiskIOOpts :: [String] -> IO DiskIOOpts+parseDiskIOOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs+ where defaultOpts = DiskIOOpts+ { totalIconPattern = Nothing+ , writeIconPattern = Nothing+ , readIconPattern = Nothing+ }+ options =+ [ Option "" ["total-icon-pattern"] (ReqArg (\x o ->+ o { totalIconPattern = Just $ parseIconPattern x}) "") ""+ , Option "" ["write-icon-pattern"] (ReqArg (\x o ->+ o { writeIconPattern = Just $ parseIconPattern x}) "") ""+ , Option "" ["read-icon-pattern"] (ReqArg (\x o ->+ o { readIconPattern = Just $ parseIconPattern x}) "") ""+ ]+ diskIOConfig :: IO MConfig diskIOConfig = mkMConfig "" ["total", "read", "write" ,"totalbar", "readbar", "writebar" ,"totalvbar", "readvbar", "writevbar"+ ,"totalipat", "readipat", "writeipat" ] +data DiskUOpts = DiskUOpts+ { freeIconPattern :: Maybe IconPattern+ , usedIconPattern :: Maybe IconPattern+ }++parseDiskUOpts :: [String] -> IO DiskUOpts+parseDiskUOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs+ where defaultOpts = DiskUOpts+ { freeIconPattern = Nothing+ , usedIconPattern = Nothing+ }+ options =+ [ Option "" ["free-icon-pattern"] (ReqArg (\x o ->+ o { freeIconPattern = Just $ parseIconPattern x}) "") ""+ , Option "" ["used-icon-pattern"] (ReqArg (\x o ->+ o { usedIconPattern = Just $ parseIconPattern x}) "") ""+ ]+ diskUConfig :: IO MConfig diskUConfig = mkMConfig ""- ["size", "free", "used", "freep", "usedp", "freebar", "freevbar", "usedbar", "usedvbar"]+ [ "size", "free", "used", "freep", "usedp"+ , "freebar", "freevbar", "freeipat"+ , "usedbar", "usedvbar", "usedipat"+ ] type DevName = String type Path = String@@ -63,10 +114,10 @@ s <- B.readFile "/proc/diskstats" parse `fmap` mapM canon (devs s) where- canon (d, p) = do {d' <- canonicalizePath (d); return (d', p)}+ canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} devs = map (third . B.words) . B.lines parse = map undev . filter isReq- third (_:_:c:_) = ("/dev/" ++ (B.unpack c), B.unpack c)+ third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c) third _ = ("", "") isReq (d, p) = p `elem` req || drop 5 d `elem` req undev (d, f) = (drop 5 d, f)@@ -127,19 +178,22 @@ Nothing -> [0, 0, 0] Just (_, xs) -> xs -runDiskIO' :: (String, [Float]) -> Monitor String-runDiskIO' (tmp, xs) = do+runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String+runDiskIO' opts (tmp, xs) = do s <- mapM (showWithColors speedToStr) xs b <- mapM (showLogBar 0.8) xs vb <- mapM (showLogVBar 0.8) xs+ ipat <- mapM (\(f,v) -> showLogIconPattern (f opts) 0.8 v)+ $ zip [totalIconPattern, readIconPattern, writeIconPattern] xs setConfigValue tmp template- parseTemplate $ s ++ b ++ vb+ parseTemplate $ s ++ b ++ vb ++ ipat runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String-runDiskIO dref disks _ = do+runDiskIO dref disks argv = do+ opts <- io $ parseDiskIOOpts argv dev <- io $ mountedOrDiskDevices (map fst disks) dat <- io $ mountedData dref (map fst dev)- strs <- mapM runDiskIO' $ devTemplates disks dev dat+ strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat return $ unwords strs startDiskIO :: [(String, String)] ->@@ -160,25 +214,28 @@ used = fsStatBytesUsed f in return [tot, free, used] -runDiskU' :: String -> String -> Monitor String-runDiskU' tmp path = do+runDiskU' :: DiskUOpts -> String -> String -> Monitor String+runDiskU' opts tmp path = do setConfigValue tmp template [total, free, diff] <- io (handle ign $ fsStats path)- let strs = map sizeToStr [total, free, diff]+ let strs = map sizeToStr [free, diff] freep = if total > 0 then free * 100 `div` total else 0 fr = fromIntegral freep / 100- s <- zipWithM showWithColors' strs [100, freep, 100 - freep]+ s <- zipWithM showWithColors' strs [freep, 100 - freep] sp <- showPercentsWithColors [fr, 1 - fr] fb <- showPercentBar (fromIntegral freep) fr fvb <- showVerticalBar (fromIntegral freep) fr+ fipat <- showIconPattern (freeIconPattern opts) fr ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr) uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr)- parseTemplate $ s ++ sp ++ [fb,fvb,ub,uvb]+ uipat <- showIconPattern (usedIconPattern opts) (1 - fr)+ parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] where ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer] runDiskU :: [(String, String)] -> [String] -> Monitor String-runDiskU disks _ = do+runDiskU disks argv = do devs <- io $ mountedDevices (map fst disks)- strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs+ opts <- io $ parseDiskUOpts argv+ strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs return $ unwords strs
src/Plugins/Monitors/MPD.hs view
@@ -15,6 +15,7 @@ module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where import Data.List+import Data.Maybe (fromMaybe) import Plugins.Monitors.Common import System.Console.GetOpt import qualified Network.MPD as M@@ -22,7 +23,7 @@ mpdConfig :: IO MConfig mpdConfig = mkMConfig "MPD: <state>"- [ "bar", "vbar", "state", "statei", "volume", "length"+ [ "bar", "vbar", "ipat", "state", "statei", "volume", "length" , "lapsed", "remaining", "plength", "ppos", "file" , "name", "artist", "composer", "performer" , "album", "title", "track", "genre"@@ -32,6 +33,7 @@ { mPlaying :: String , mStopped :: String , mPaused :: String+ , mLapsedIconPattern :: Maybe IconPattern } defaultOpts :: MOpts@@ -39,6 +41,7 @@ { mPlaying = ">>" , mStopped = "><" , mPaused = "||"+ , mLapsedIconPattern = Nothing } options :: [OptDescr (MOpts -> MOpts)]@@ -46,6 +49,8 @@ [ 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 "" ["lapsed-icon-pattern"] (ReqArg (\x o ->+ o { mLapsedIconPattern = Just $ parseIconPattern x }) "") "" ] runMPD :: [String] -> Monitor String@@ -71,7 +76,7 @@ -- Only cases where MPD isn't responding is an issue; bogus information at -- least won't hold xmobar up. Left M.NoMPD -> return False- Left M.TimedOut -> return False+ Left (M.ConnectionError _) -> return False Left _ -> return True mopts :: [String] -> IO MOpts@@ -87,12 +92,13 @@ songData <- parseSong song bar <- showPercentBar (100 * b) b vbar <- showVerticalBar (100 * b) b- return $ [bar, vbar, ss, si, vol, len, lap, remain, plen, ppos] ++ songData+ ipat <- showIconPattern (mLapsedIconPattern opts) b+ return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos] ++ songData where s = M.stState st ss = show s si = stateGlyph s opts- vol = int2str $ M.stVolume st- (p, t) = M.stTime st+ vol = int2str $ fromMaybe 0 (M.stVolume st)+ (p, t) = fromMaybe (0, 0) (M.stTime st) [lap, len, remain] = map showTime [floor p, t, max 0 (t - floor p)] b = if t > 0 then realToFrac $ p / fromIntegral t else 0 plen = int2str $ M.stPlaylistLength st
src/Plugins/Monitors/Mem.hs view
@@ -16,12 +16,38 @@ import Plugins.Monitors.Common import qualified Data.Map as M+import System.Console.GetOpt +data MemOpts = MemOpts+ { usedIconPattern :: Maybe IconPattern+ , freeIconPattern :: Maybe IconPattern+ }++defaultOpts :: MemOpts+defaultOpts = MemOpts+ { usedIconPattern = Nothing+ , freeIconPattern = Nothing+ }++options :: [OptDescr (MemOpts -> MemOpts)]+options =+ [ Option "" ["used-icon-pattern"] (ReqArg (\x o ->+ o { usedIconPattern = Just $ parseIconPattern x }) "") ""+ , Option "" ["free-icon-pattern"] (ReqArg (\x o ->+ o { freeIconPattern = Just $ parseIconPattern x }) "") ""+ ]++parseOpts :: [String] -> IO MemOpts+parseOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs+ memConfig :: IO MConfig memConfig = mkMConfig "Mem: <usedratio>% (<cache>M)" -- template- ["usedbar", "usedvbar", "freebar", "freevbar", "usedratio", "freeratio", "total",- "free", "buffer", "cache", "rest", "used"] -- available replacements+ ["usedbar", "usedvbar", "usedipat", "freebar", "freevbar", "freeipat", "usedratio", "freeratio",+ "total", "free", "buffer", "cache", "rest", "used"] -- available replacements fileMEM :: IO String fileMEM = readFile "/proc/meminfo"@@ -30,10 +56,10 @@ parseMEM = do file <- fileMEM let content = map words $ take 8 $ lines file- info = M.fromList $ map (\line -> (line !! 0, (read $ line !! 1 :: Float) / 1024)) content+ info = M.fromList $ map (\line -> (head line, (read $ line !! 1 :: Float) / 1024)) content [total, free, buffer, cache] = map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] rest = free + buffer + cache- used = total - (M.findWithDefault rest "MemAvailable:" info)+ used = total - M.findWithDefault rest "MemAvailable:" info usedratio = used / total freeratio = free / total return [usedratio, freeratio, total, free, buffer, cache, rest, used, freeratio]@@ -44,22 +70,25 @@ usedMem :: IO Float usedMem = fmap ((*1024) . (!!6)) parseMEM -formatMem :: [Float] -> Monitor [String]-formatMem (r:fr:xs) =+formatMem :: MemOpts -> [Float] -> Monitor [String]+formatMem opts (r:fr:xs) = do let f = showDigits 0 rr = 100 * r ub <- showPercentBar rr r uvb <- showVerticalBar rr r+ uipat <- showIconPattern (usedIconPattern opts) r fb <- showPercentBar (100 - rr) (1 - r) fvb <- showVerticalBar (100 - rr) ( 1 - r)+ fipat <- showIconPattern (freeIconPattern opts) (1 - r) rs <- showPercentWithColors r fs <- showPercentWithColors fr s <- mapM (showWithColors f) xs- return (ub:uvb:fb:fvb:rs:fs:s)-formatMem _ = replicate 10 `fmap` getConfigValue naString+ return (ub:uvb:uipat:fb:fvb:fipat:rs:fs:s)+formatMem _ _ = replicate 10 `fmap` getConfigValue naString runMem :: [String] -> Monitor String-runMem _ =+runMem argv = do m <- io parseMEM- l <- formatMem m+ opts <- io $ parseOpts argv+ l <- formatMem opts m parseTemplate l
src/Plugins/Monitors/Mpris.hs view
@@ -25,6 +25,7 @@ import DBus import qualified DBus.Client as DC +import Control.Arrow ((***)) import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) import System.IO.Unsafe (unsafePerformIO)@@ -43,10 +44,10 @@ { methodCallDestination = Just busName } where- busName = busName_ $ "org.mpris." ++ p- objectPath = objectPath_ $ "/Player"- interfaceName = interfaceName_ $ "org.freedesktop.MediaPlayer"- memberName = memberName_ $ "GetMetadata"+ busName = busName_ $ "org.mpris." ++ p+ objectPath = objectPath_ "/Player"+ interfaceName = interfaceName_ "org.freedesktop.MediaPlayer"+ memberName = memberName_ "GetMetadata" fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title" , "tracknumber" ]@@ -58,10 +59,10 @@ , methodCallBody = arguments } where- busName = busName_ $ "org.mpris.MediaPlayer2." ++ p- objectPath = objectPath_ $ "/org/mpris/MediaPlayer2"- interfaceName = interfaceName_ $ "org.freedesktop.DBus.Properties"- memberName = memberName_ $ "Get"+ busName = busName_ $ "org.mpris.MediaPlayer2." ++ p+ objectPath = objectPath_ "/org/mpris/MediaPlayer2"+ interfaceName = interfaceName_ "org.freedesktop.DBus.Properties"+ memberName = memberName_ "Get" arguments = map (toVariant::String -> Variant) ["org.mpris.MediaPlayer2.Player", "Metadata"] @@ -98,7 +99,7 @@ unpackMetadata :: [Variant] -> [(String, Variant)] unpackMetadata [] = []-unpackMetadata xs = ((map (\(k, v) -> (fromVar k, fromVar v))) . unpack . head) xs where+unpackMetadata xs = (map (fromVar *** fromVar) . unpack . head) xs where unpack v = case variantType v of TypeDictionary _ _ -> dictionaryItems $ fromVar v TypeVariant -> unpack $ fromVar v
src/Plugins/Monitors/MultiCpu.hs view
@@ -15,12 +15,39 @@ module Plugins.Monitors.MultiCpu (startMultiCpu) where import Plugins.Monitors.Common+import Control.Applicative ((<$>)) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, transpose, unfoldr) import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import System.Console.GetOpt +data MultiCpuOpts = MultiCpuOpts+ { loadIconPatterns :: [IconPattern]+ , loadIconPattern :: Maybe IconPattern+ }++defaultOpts :: MultiCpuOpts+defaultOpts = MultiCpuOpts+ { loadIconPatterns = []+ , loadIconPattern = Nothing+ }++options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)]+options =+ [ Option "" ["load-icon-pattern"] (ReqArg (\x o ->+ o { loadIconPattern = Just $ parseIconPattern x }) "") ""+ , Option "" ["load-icon-patterns"] (ReqArg (\x o ->+ o { loadIconPatterns = parseIconPattern x : loadIconPatterns o }) "") ""+ ]++parseOpts :: [String] -> IO MultiCpuOpts+parseOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs+ variables :: [String]-variables = ["bar", "vbar","total","user","nice","system","idle"]+variables = ["bar", "vbar","ipat","total","user","nice","system","idle"] vNum :: Int vNum = length variables @@ -52,20 +79,25 @@ percent :: [Float] -> [Float] -> [Float] percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0] where dif = zipWith (-) b a- tot = foldr (+) 0 dif+ tot = sum dif -formatMultiCpus :: [[Float]] -> Monitor [String]-formatMultiCpus [] = return []-formatMultiCpus xs = fmap concat $ mapM formatCpu xs+formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [String]+formatMultiCpus _ [] = return []+formatMultiCpus opts xs = concat <$> mapM (\(i, x) -> formatCpu opts i x) (zip [0..] xs) -formatCpu :: [Float] -> Monitor [String]-formatCpu xs+formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [String]+formatCpu opts i xs | length xs < 4 = showPercentsWithColors $ replicate vNum 0.0- | otherwise = let t = foldr (+) 0 $ take 3 xs+ | otherwise = let t = sum $ take 3 xs in do b <- showPercentBar (100 * t) t h <- showVerticalBar (100 * t) t+ d <- showIconPattern tryString t ps <- showPercentsWithColors (t:xs)- return (b:h:ps)+ return (b:h:d:ps)+ where tryString+ | i == 0 = loadIconPattern opts+ | i <= length (loadIconPatterns opts) = Just $ (loadIconPatterns opts) !! (i - 1)+ | otherwise = Nothing splitEvery :: (Eq a) => Int -> [a] -> [[a]] splitEvery n = unfoldr (\x -> if null x then Nothing else Just $ splitAt n x)@@ -78,9 +110,10 @@ formatAutoCpus xs = return $ map unwords (groupData xs) runMultiCpu :: CpuDataRef -> [String] -> Monitor String-runMultiCpu cref _ =+runMultiCpu cref argv = do c <- io $ parseCpuData cref- l <- formatMultiCpus c+ opts <- io $ parseOpts argv+ l <- formatMultiCpus opts c a <- formatAutoCpus l parseTemplate $ a ++ l
src/Plugins/Monitors/Net.hs view
@@ -22,12 +22,47 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)-import Control.Monad (forM, filterM)+import Control.Monad (forM, filterM, liftM) import System.Directory (getDirectoryContents, doesFileExist) import System.FilePath ((</>))+import System.Console.GetOpt import qualified Data.ByteString.Lazy.Char8 as B +data NetOpts = NetOpts+ { rxIconPattern :: Maybe IconPattern+ , txIconPattern :: Maybe IconPattern+ }++defaultOpts :: NetOpts+defaultOpts = NetOpts+ { rxIconPattern = Nothing+ , txIconPattern = Nothing+ }++options :: [OptDescr (NetOpts -> NetOpts)]+options =+ [ Option "" ["rx-icon-pattern"] (ReqArg (\x o ->+ o { rxIconPattern = Just $ parseIconPattern x }) "") ""+ , Option "" ["tx-icon-pattern"] (ReqArg (\x o ->+ o { txIconPattern = Just $ parseIconPattern x }) "") ""+ ]++parseOpts :: [String] -> IO NetOpts+parseOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs++data UnitPerSec = Bs | KBs | MBs | GBs deriving (Eq,Enum,Ord)+data NetValue = NetValue Float UnitPerSec deriving (Eq,Show)++instance Show UnitPerSec where+ show Bs = "B/s"+ show KBs = "KB/s"+ show MBs = "MB/s"+ show GBs = "GB/s"+ data NetDev = NA | NI String | ND String Float Float deriving (Eq,Show,Read)@@ -42,8 +77,8 @@ compare NA _ = LT compare _ NA = GT compare (NI _) (NI _) = EQ- compare (NI _) (ND _ _ _) = LT- compare (ND _ _ _) (NI _) = GT+ compare (NI _) (ND {}) = LT+ compare (ND {}) (NI _) = GT compare (ND _ x1 y1) (ND _ x2 y2) = if downcmp /= EQ then downcmp@@ -53,7 +88,7 @@ netConfig :: IO MConfig netConfig = mkMConfig "<dev>: <rx>KB|<tx>KB" -- template- ["dev", "rx", "tx", "rxbar", "rxvbar", "txbar", "txvbar"] -- available replacements+ ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat"] -- available replacements operstateDir :: String -> FilePath operstateDir d = "/sys/class/net" </> d </> "operstate"@@ -74,7 +109,7 @@ up <- isUp d return (if up then ND d (r x) (r y) else NI d) where r s | s == "" = 0- | otherwise = read s / 1024+ | otherwise = read s readNetDev _ = return NA @@ -97,23 +132,26 @@ isDev (NI d) = d == dev isDev NA = False -formatNet :: Float -> Monitor (String, String, String)-formatNet d = do+formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String)+formatNet mipat d = do s <- getConfigValue useSuffix dd <- getConfigValue decDigits- let str = if s then (++"Kb/s") . showDigits dd else showDigits dd+ let str True v = showDigits dd d' ++ show u+ where (NetValue d' u) = byteNetVal v+ str False v = showDigits dd $ v / 1024 b <- showLogBar 0.9 d vb <- showLogVBar 0.9 d- x <- showWithColors str d- return (x, b, vb)+ ipat <- showLogIconPattern mipat 0.9 d+ x <- showWithColors (str s) d+ return (x, b, vb, ipat) -printNet :: NetDev -> Monitor String-printNet nd =+printNet :: NetOpts -> NetDev -> Monitor String+printNet opts nd = case nd of ND d r t -> do- (rx, rb, rvb) <- formatNet r- (tx, tb, tvb) <- formatNet t- parseTemplate [d,rx,tx,rb,rvb,tb,tvb]+ (rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r+ (tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t+ parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat] NI _ -> return "" NA -> getConfigValue naString @@ -133,14 +171,20 @@ return $ diffRate n0 n1 runNet :: NetDevRef -> String -> [String] -> Monitor String-runNet nref i _ = io (parseNet nref i) >>= printNet+runNet nref i argv = do+ dev <- io $ parseNet nref i+ opts <- io $ parseOpts argv+ printNet opts dev parseNets :: [(NetDevRef, String)] -> IO [NetDev]-parseNets = mapM $ \(ref, i) -> parseNet ref i+parseNets = mapM $ uncurry parseNet runNets :: [(NetDevRef, String)] -> [String] -> Monitor String-runNets refs _ = io (parseActive refs) >>= printNet- where parseActive refs' = parseNets refs' >>= return . selectActive+runNets refs argv = do+ dev <- io $ parseActive refs+ opts <- io $ parseOpts argv+ printNet opts dev+ where parseActive refs' = liftM selectActive (parseNets refs') selectActive = maximum startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO ()@@ -159,3 +203,10 @@ _ <- parseNet nref d return (nref, d) runM a netConfig (runNets refs) r cb++byteNetVal :: Float -> NetValue+byteNetVal v+ | v < 1024**1 = NetValue v Bs+ | v < 1024**2 = NetValue (v/1024**1) KBs+ | v < 1024**3 = NetValue (v/1024**2) MBs+ | otherwise = NetValue (v/1024**3) GBs
src/Plugins/Monitors/Swap.hs view
@@ -33,8 +33,8 @@ | l /= [] = head l !! i | otherwise = B.empty fs s l- | l == [] = False- | otherwise = head l == B.pack s+ | null l = False+ | otherwise = head l == B.pack s get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s) st = map B.words . B.lines $ file tot = get_data "SwapTotal:" st
src/Plugins/Monitors/Thermal.hs view
@@ -14,6 +14,7 @@ module Plugins.Monitors.Thermal where +import Control.Monad (liftM) import qualified Data.ByteString.Lazy.Char8 as B import Plugins.Monitors.Common import System.Posix.Files (fileExist)@@ -32,11 +33,9 @@ let zone = head args file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature" exists <- io $ fileExist file- case exists of- False -> return $ "Thermal (" ++ zone ++ "): N/A"- True -> do number <- io $ B.readFile file- >>= return . (read :: String -> Int)- . stringParser (1, 0)- thermal <- showWithColors show number- parseTemplate [ thermal ]+ if exists+ then do number <- io $ liftM ((read :: String -> Int) . stringParser (1, 0)) (B.readFile file)+ thermal <- showWithColors show number+ parseTemplate [ thermal ]+ else return $ "Thermal (" ++ zone ++ "): N/A"
src/Plugins/Monitors/Top.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top--- Copyright : (c) Jose A Ortega Ruiz+-- Copyright : (c) 2010, 2011, 2012, 2013, 2014 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>@@ -101,7 +101,7 @@ showMemInfo :: Float -> MemInfo -> Monitor [String] showMemInfo scale (nm, rss) =- showInfo nm (showWithUnits 2 1 rss) (100 * rss / sc)+ showInfo nm (showWithUnits 3 1 rss) (100 * rss / sc) where sc = if scale > 0 then scale else 100 showMemInfos :: [MemInfo] -> Monitor [[String]]
src/Plugins/Monitors/Volume.hs view
@@ -24,7 +24,7 @@ volumeConfig :: IO MConfig volumeConfig = mkMConfig "Vol: <volume>% <status>"- ["volume", "volumebar", "volumevbar", "dB","status"]+ ["volume", "volumebar", "volumevbar", "dB","status", "volumeipat"] data VolumeOpts = VolumeOpts@@ -34,6 +34,7 @@ , offColor :: Maybe String , highDbThresh :: Float , lowDbThresh :: Float+ , volumeIconPattern :: Maybe IconPattern } defaultOpts :: VolumeOpts@@ -44,6 +45,7 @@ , offColor = Just "red" , highDbThresh = -5.0 , lowDbThresh = -30.0+ , volumeIconPattern = Nothing } options :: [OptDescr (VolumeOpts -> VolumeOpts)]@@ -54,6 +56,8 @@ , 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 }) "") ""+ , Option "" ["volume-icon-pattern"] (ReqArg (\x o ->+ o { volumeIconPattern = Just $ parseIconPattern x }) "") "" ] parseOpts :: [String] -> IO VolumeOpts@@ -80,6 +84,10 @@ formatVolVBar lo hi v = showVerticalBar (100 * x) x where x = percent v lo hi +formatVolDStr :: Maybe IconPattern -> Integer -> Integer -> Integer -> Monitor String+formatVolDStr ipat lo hi v =+ showIconPattern ipat $ percent v lo hi+ switchHelper :: VolumeOpts -> (VolumeOpts -> Maybe String) -> (VolumeOpts -> String)@@ -126,7 +134,8 @@ v <- liftMonitor $ liftM3 formatVolVBar lo hi val d <- getFormatDB opts db s <- getFormatSwitch opts sw- parseTemplate [p, b, v, d, s]+ ipat <- liftMonitor $ liftM3 (formatVolDStr $ volumeIconPattern opts) lo hi val+ parseTemplate [p, b, v, d, s, ipat] where
src/Plugins/Monitors/Weather.hs view
@@ -22,7 +22,6 @@ import Text.ParserCombinators.Parsec - weatherConfig :: IO MConfig weatherConfig = mkMConfig "<station>: <tempC>C, rh <rh>% (<hour>)" -- template@@ -32,12 +31,16 @@ , "month" , "day" , "hour"- , "wind"+ , "windCardinal"+ , "windAzimuth"+ , "windMph"+ , "windKnots" , "visibility" , "skyCondition" , "tempC" , "tempF"- , "dewPoint"+ , "dewPointC"+ , "dewPointF" , "rh" , "pressure" ]@@ -49,12 +52,16 @@ , month :: String , day :: String , hour :: String- , wind :: String+ , windCardinal :: String+ , windAzimuth :: String+ , windMph :: String+ , windKnots :: String , visibility :: String , skyCondition :: String , tempC :: Int , tempF :: Int- , dewPoint :: String+ , dewPointC :: Int+ , dewPointF :: Int , humidity :: Int , pressure :: Int } deriving (Show)@@ -68,18 +75,52 @@ char ' ' (h:hh:mi:mimi) <- getNumbersAsString char ' '- return (y, m, d ,([h]++[hh]++":"++[mi]++mimi))+ return (y, m, d ,h:hh:":"++mi:mimi) +-- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0"+pWind0 ::+ (+ String -- cardinal direction+ , String -- azimuth direction+ , String -- speed (MPH)+ , String -- speed (knot)+ ) +pWind0 =+ ("μ", "μ", "0", "0")++pWind ::+ Parser (+ String -- cardinal direction+ , String -- azimuth direction+ , String -- speed (MPH)+ , String -- speed (knot)+ ) +pWind =+ let tospace = manyTill anyChar (char ' ')+ wind0 = do manyTill skipRestOfLine (string "Wind: Calm:0")+ return pWind0+ wind = do manyTill skipRestOfLine (string "Wind: from the ")+ cardinal <- tospace+ char '('+ azimuth <- tospace+ string "degrees) at "+ mph <- tospace+ string "MPH ("+ knot <- tospace+ manyTill anyChar newline+ return (cardinal, azimuth, mph, knot)+ in try wind0 <|> wind+ pTemp :: Parser (Int, Int) pTemp = do let num = digit <|> char '-' <|> char '.' f <- manyTill num $ char ' ' manyTill anyChar $ char '(' c <- manyTill num $ char ' ' skipRestOfLine- return $ (floor (read c :: Double), floor (read f :: Double))+ return (floor (read c :: Double), floor (read f :: Double)) pRh :: Parser Int-pRh = do s <- manyTill digit $ (char '%' <|> char '.')+pRh = do s <- manyTill digit (char '%' <|> char '.') return $ read s pPressure :: Parser Int@@ -112,18 +153,19 @@ ) skipRestOfLine >> getAllBut "/" (y,m,d,h) <- pTime- w <- getAfterString "Wind: "+ (wc, wa, wm, wk) <- pWind v <- getAfterString "Visibility: " sk <- getAfterString "Sky conditions: " skipTillString "Temperature: " (tC,tF) <- pTemp- dp <- getAfterString "Dew Point: "+ skipTillString "Dew Point: "+ (dC, dF) <- pTemp skipTillString "Relative Humidity: " rh <- pRh skipTillString "Pressure (altimeter): " p <- pPressure manyTill skipRestOfLine eof- return $ [WI st ss y m d h w v sk tC tF dp rh p]+ return [WI st ss y m d h wc wa wm wk v sk tC tF dC dF rh p] defUrl :: String defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/"@@ -139,10 +181,10 @@ errHandler _ = return "<Could not retrieve data>" formatWeather :: [WeatherInfo] -> Monitor String-formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] =+formatWeather [WI st ss y m d h wc wa wm wk v sk tC tF dC dF r p] = do cel <- showWithColors show tC far <- showWithColors show tF- parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ]+ parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, v, sk, cel, far, show dC, show dF, show r , show p ] formatWeather _ = getConfigValue naString runWeather :: [String] -> Monitor String@@ -158,10 +200,10 @@ io $ CE.catch (simpleHTTP request >>= checkResult) errHandler where errHandler :: CE.IOException -> IO Bool errHandler _ = return False- checkResult result = do+ checkResult result = case result of Left _ -> return False- Right response -> do+ Right response -> case rspCode response of -- Permission or network errors are failures; anything -- else is recoverable.
src/Plugins/Monitors/Wireless.hs view
@@ -14,15 +14,39 @@ module Plugins.Monitors.Wireless (wirelessConfig, runWireless) where +import System.Console.GetOpt+ import Plugins.Monitors.Common import IWlib +data WirelessOpts = WirelessOpts+ { qualityIconPattern :: Maybe IconPattern+ }++defaultOpts :: WirelessOpts+defaultOpts = WirelessOpts+ { qualityIconPattern = Nothing+ }++options :: [OptDescr (WirelessOpts -> WirelessOpts)]+options =+ [ Option "" ["quality-icon-pattern"] (ReqArg (\d opts ->+ opts { qualityIconPattern = Just $ parseIconPattern d }) "") ""+ ]++parseOpts :: [String] -> IO WirelessOpts+parseOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs+ wirelessConfig :: IO MConfig wirelessConfig =- mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar", "qualityvbar"]+ mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar", "qualityvbar", "qualityipat"] -runWireless :: [String] -> Monitor String-runWireless (iface:_) = do+runWireless :: String -> [String] -> Monitor String+runWireless iface args = do+ opts <- io $ parseOpts args wi <- io $ getWirelessInfo iface na <- getConfigValue naString let essid = wiEssid wi@@ -34,5 +58,5 @@ else showWithPadding "" qb <- showPercentBar qlty (qlty / 100) qvb <- showVerticalBar qlty (qlty / 100)- parseTemplate [ep, q, qb, qvb]-runWireless _ = getConfigValue naString+ qipat <- showIconPattern (qualityIconPattern opts) (qlty / 100)+ parseTemplate [ep, q, qb, qvb, qipat]
src/Plugins/PipeReader.hs view
@@ -19,7 +19,7 @@ import System.Posix.Files import Control.Concurrent(threadDelay) import Control.Exception-import Control.Monad(when)+import Control.Monad(forever, unless) data PipeReader = PipeReader String String deriving (Read, Show)@@ -28,21 +28,18 @@ alias (PipeReader _ a) = a start (PipeReader p _) cb = do let (def, pipe) = split ':' p- when (not $ null def) (cb def)+ unless (null def) (cb def) checkPipe pipe h <- openFile pipe ReadWriteMode forever (hGetLineSafe h >>= cb) where- forever a = a >> forever a- split c xs | c `elem` xs = let (pre, post) = span ((/=) c) xs- in (pre, dropWhile ((==) c) post)+ split c xs | c `elem` xs = let (pre, post) = span (c /=) xs+ in (pre, dropWhile (c ==) post) | otherwise = ([], xs) checkPipe :: FilePath -> IO ()-checkPipe file = do+checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do- status <- getFileStatus file- if isNamedPipe status- then return ()- else waitForPipe+ status <- getFileStatus file+ unless (isNamedPipe status) waitForPipe where waitForPipe = threadDelay 1000 >> checkPipe file
src/Plugins/StdinReader.hs view
@@ -34,7 +34,7 @@ s <- handle (\(SomeException e) -> do hPrint stderr e; return "") (hGetLineSafe stdin) cb $ escape stdinReader s- eof <- hIsEOF stdin+ eof <- isEOF if eof then exitImmediately ExitSuccess else start stdinReader cb
src/Window.hs view
@@ -16,6 +16,7 @@ module Window where import Prelude+import Control.Applicative ((<$>)) import Control.Monad (when, unless) import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras@@ -163,20 +164,22 @@ xe = xs + cw getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -drawBorder :: Border -> Display -> Drawable -> GC -> Pixel+drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel -> Dimension -> Dimension -> IO ()-drawBorder b d p gc c wi ht = case b of+drawBorder b lw 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- sf >> drawLine d p gc 0 rw (fi w) rw- 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)+ TopB -> drawBorder (TopBM 0) lw d p gc c wi ht+ BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht+ FullB -> drawBorder (FullBM 0) lw d p gc c wi ht+ TopBM m -> sf >> sla >> drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff)+ BottomBM m -> let rw = fi ht - fi m + boff in+ sf >> sla >> drawLine d p gc 0 rw (fi wi) rw+ FullBM m -> let pad = 2 * fi m + 2 * fi boff'; mp = fi m + fi boff' in+ sf >> sla >> drawRectangle d p gc mp mp (wi - pad) (ht - pad)+ where sf = setForeground d gc c+ sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter+ boff = borderOffset b lw+ boff' = calcBorderOffset lw :: Int hideWindow :: Display -> Window -> IO () hideWindow d w = do@@ -190,5 +193,20 @@ sync d False isMapped :: Display -> Window -> IO Bool-isMapped d w = fmap ism $ getWindowAttributes d w+isMapped d w = ism <$> getWindowAttributes d w where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped++borderOffset :: (Integral a) => Border -> Int -> a+borderOffset b lw =+ case b of+ BottomB -> negate boffs+ BottomBM _ -> negate boffs+ TopB -> boffs+ TopBM _ -> boffs+ _ -> 0+ where boffs = calcBorderOffset lw++calcBorderOffset :: (Integral a) => Int -> a+calcBorderOffset = ceiling . (/2) . toDouble+ where toDouble = fi :: (Integral a) => a -> Double+
+ src/XPMFile.hsc view
@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module : XPMFile+-- Copyright : (C) 2014 Alexander Shabalin+-- License : BSD3+--+-- Maintainer : jao@gnu.org+-- Stability : unstable+-- Portability : unportable+--+-----------------------------------------------------------------------------++module XPMFile(readXPMFile) where++import Control.Monad.Except(MonadError(..))+import Control.Monad.Trans(MonadIO(..))+import Graphics.X11.Xlib(Dimension, Display(..), Drawable, Pixmap)+import Foreign.C.String(CString, withCString)+import Foreign.C.Types(CInt(..), CLong)+import Foreign.Ptr(Ptr)+import Foreign.Marshal.Alloc(alloca, allocaBytes)+import Foreign.Storable(peek, peekByteOff, pokeByteOff)++#include <X11/xpm.h>++foreign import ccall "XpmReadFileToPixmap"+ xpmReadFileToPixmap :: Display -> Drawable -> CString -> Ptr Pixmap -> Ptr Pixmap -> Ptr () -> IO CInt++readXPMFile+ :: (MonadError String m, MonadIO m)+ => Display+ -> Drawable+ -> String+ -> m (Dimension, Dimension, Pixmap, Maybe Pixmap)+readXPMFile display d filename =+ toError $ withCString filename $ \c_filename ->+ alloca $ \pixmap_return ->+ alloca $ \shapemask_return ->+ allocaBytes (#size XpmAttributes) $ \attributes -> do+ (#poke XpmAttributes, valuemask) attributes ((#const XpmReturnAllocPixels) :: CLong)+ res <- xpmReadFileToPixmap display d c_filename pixmap_return shapemask_return attributes+ case res of+ 0 -> do+ width <- (#peek XpmAttributes, width) attributes+ height <- (#peek XpmAttributes, height) attributes+ pixmap <- peek pixmap_return+ shapemask <- peek shapemask_return+ return $ Right (width, height, pixmap, if shapemask == 0 then Nothing else Just shapemask)+ 1 -> return $ Left "readXPMFile: XpmColorError"+ -1 -> return $ Left "readXPMFile: XpmOpenFailed"+ -2 -> return $ Left "readXPMFile: XpmFileInvalid"+ -3 -> return $ Left "readXPMFile: XpmNoMemory"+ -4 -> return $ Left "readXPMFile: XpmColorFailed"+ _ -> return $ Left "readXPMFile: Unknown error"+ where toError m = either throwError return =<< liftIO m
src/XUtil.hsc view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XUtil--- Copyright : (C) 2011, 2012, 2013 Jose Antonio Ortega Ruiz+-- Copyright : (C) 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz -- (C) 2007 Andrea Rossato -- License : BSD3 --@@ -72,7 +72,7 @@ data XFont = Core FontStruct | Utf8 FontSet #ifdef XFT- | Xft AXftFont+ | Xft [AXftFont] #endif -- | When initFont gets a font name that starts with 'xft:' it switchs@@ -118,12 +118,22 @@ fallBack = const $ createFontSet d miscFixedFont #ifdef XFT-initXftFont :: Display -> String -> IO AXftFont+initXftFont :: Display -> String -> IO [AXftFont] initXftFont d s = do setupLocale- f <- openAXftFont d (defaultScreenOfDisplay d) (drop 4 s)- addFinalizer f (closeAXftFont d f)- return f+ let fontNames = wordsBy (== ',') (drop 4 s)+ fonts <- mapM openFont fontNames+ return fonts+ where+ openFont fontName = do+ f <- openAXftFont d (defaultScreenOfDisplay d) fontName+ addFinalizer f (closeAXftFont d f)+ return f+ wordsBy p str = case dropWhile p str of+ "" -> []+ str' -> w : wordsBy p str''+ where+ (w, str'') = break p str' #endif textWidth :: Display -> XFont -> String -> IO Int@@ -131,7 +141,7 @@ textWidth _ (Core fs) s = return $ fi $ Xlib.textWidth fs s #ifdef XFT textWidth dpy (Xft xftdraw) s = do- gi <- xftTxtExtents dpy xftdraw s+ gi <- xftTxtExtents' dpy xftdraw s return $ xglyphinfo_xOff gi #endif @@ -145,9 +155,9 @@ descent = fi $ rect_height rl + (fi $ rect_y rl) return (ascent, descent) #ifdef XFT-textExtents (Xft xftfont) _ = do- ascent <- fi `fmap` xft_ascent xftfont- descent <- fi `fmap` xft_descent xftfont+textExtents (Xft xftfonts) _ = do+ ascent <- fi `fmap` xft_ascent' xftfonts+ descent <- fi `fmap` xft_descent' xftfonts return (ascent, descent) #endif @@ -167,15 +177,15 @@ io $ wcDrawImageString d p fs gc x y s #ifdef XFT-printString dpy drw fs@(Xft font) _ fc bc x y s = do+printString dpy drw fs@(Xft fonts) _ fc bc x y s = do (a,d) <- textExtents fs s- gi <- xftTxtExtents dpy font s+ gi <- xftTxtExtents' dpy fonts s withDrawingColors dpy drw fc bc $ \draw -> \fc' -> \bc' -> (drawXftRect draw bc' (x + 1 - fi (xglyphinfo_x gi)) (y - (a + d) + 1) (xglyphinfo_xOff gi) (a + d)) >>- (drawXftString draw fc' font x (y - 2) s)+ (drawXftString' draw fc' fonts (toInteger x) (toInteger (y - 2)) s) #endif
src/Xmobar.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, CPP #-}+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar@@ -36,13 +36,14 @@ import Graphics.X11.Xrandr import Control.Arrow ((&&&))+import Control.Applicative ((<$>)) import Control.Monad.Reader import Control.Concurrent import Control.Concurrent.STM import Control.Exception (handle, SomeException(..)) import Data.Bits import Data.Map hiding (foldr, map, filter)-import Data.Maybe (fromJust)+import Data.Maybe (fromJust, isJust) import Bitmap import Config@@ -150,7 +151,7 @@ case typ of Wakeup -> do str <- updateString cfg tv- xc' <- updateCache d w is str >>= \c -> return xc { iconS = c }+ xc' <- updateCache d w is (iconRoot cfg) str >>= \c -> return xc { iconS = c } as' <- updateActions xc r str runX xc' $ drawInWin r str eventLoop tv xc' as' signal@@ -204,10 +205,11 @@ case position ocfg of OnScreen n o -> do srs <- getScreenInfo d- if n == length srs then- return (ocfg {position = OnScreen 1 o})- else- return (ocfg {position = OnScreen (n+1) o})+ return (if n == length srs+ then+ (ocfg {position = OnScreen 1 o})+ else+ (ocfg {position = OnScreen (n+1) o})) o -> return (ocfg {position = OnScreen 1 o}) @@ -254,7 +256,7 @@ getCoords (Text s,_,a) = textWidth d fs s >>= \tw -> return (a, 0, fi tw) getCoords (Icon s,_,a) = return (a, 0, fi $ iconW s) partCoord off xs = map (\(a, x, x') -> (fromJust a, x, x')) $- filter (\(a, _,_) -> a /= Nothing) $+ filter (\(a, _,_) -> isJust a) $ scanl (\(_,_,x') (a,_,w') -> (a, x', x' + w')) (Nothing, 0, off) xs totSLen = foldr (\(_,_,len) -> (+) len) 0@@ -265,7 +267,7 @@ R -> remWidth xs L -> offs - fmap concat $ mapM (\(a,xs) -> fmap (\xs' -> partCoord (offset a xs') xs') $ strLn xs) $+ fmap concat $ mapM (\(a,xs) -> (\xs' -> partCoord (offset a xs') xs') <$> strLn xs) $ zip [L,C,R] [left,center,right] -- $print@@ -294,7 +296,7 @@ printStrings p gc fs 1 R =<< strLn right printStrings p gc fs 1 C =<< strLn center -- draw 1 pixel border if requested- io $ drawBorder (border c) d p gc bdcolor wid ht+ io $ drawBorder (border c) (borderWidth c) d p gc bdcolor wid ht -- copy the pixmap with the new string to the window io $ copyArea d p w gc 0 0 wid ht 0 0 -- free up everything (we do not want to leak memory!)@@ -313,9 +315,10 @@ Text t -> io $ textExtents fontst t Icon _ -> return (0, 0) let (conf,d) = (config &&& display) r+ boffs = borderOffset (border conf) (borderWidth conf) Rectangle _ _ wid ht = rect r totSLen = foldr (\(_,_,len) -> (+) len) 0 sl- valign = -1 + (fi ht + fi (as + ds)) `div` 2+ valign = boffs-1 + (fi ht + fi (as + ds)) `div` 2 remWidth = fi wid - fi totSLen offset = case a of C -> (remWidth + offs) `div` 2
xmobar.cabal view
@@ -1,5 +1,5 @@ name: xmobar-version: 0.21+version: 0.22 homepage: http://xmobar.org synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar.@@ -66,6 +66,10 @@ description: Publish a service on the session bus for controlling xmobar. default: False +flag with_xpm+ description: Enable usage of xpm for icons+ default: False+ flag with_threaded description: Use threaded runtime. default: False@@ -75,10 +79,11 @@ main-is: Main.hs other-modules: Xmobar, Actions, Bitmap, Config, Parsers, Commands, Localize,- XUtil, StatFS, Runnable, ColorCache, Window, Signal,+ XUtil, XPMFile, StatFS, Runnable, ColorCache, Window, Signal, Plugins, Plugins.BufferedPipeReader, Plugins.CommandReader, Plugins.Date, Plugins.EWMH,- Plugins.PipeReader, Plugins.StdinReader, Plugins.XMonadLog,+ Plugins.PipeReader, Plugins.MarqueePipeReader,+ Plugins.StdinReader, Plugins.XMonadLog, Plugins.Utils, Plugins.Kbd, Plugins.Locks, Plugins.Monitors, Plugins.Monitors.Batt, Plugins.Monitors.Common, Plugins.Monitors.CoreCommon, Plugins.Monitors.CoreTemp,@@ -106,7 +111,7 @@ time, filepath, X11 >= 1.6.1,- mtl >= 2.0 && < 2.3,+ mtl >= 2.2.1 && < 2.3, parsec == 3.1.*, HTTP >= 4000, stm >= 2.3 && < 2.5@@ -141,7 +146,7 @@ cpp-options: -DIWLIB if flag(with_mpd) || flag(all_extensions)- build-depends: libmpd == 0.8.*+ build-depends: libmpd == 0.9.* other-modules: Plugins.Monitors.MPD cpp-options: -DLIBMPD @@ -165,3 +170,8 @@ build-depends: dbus >= 0.10 other-modules: IPC.DBus cpp-options: -DDBUS++ if flag(with_xpm) || flag(all_extensions)+ extra-libraries: Xpm+ other-modules: XPMFile+ cpp-options: -DXPM