xmobar 0.15 → 0.16
raw patch · 33 files changed
+1563/−666 lines, 33 filesdep +dbusdep −dbus-coredep −textdep ~basedep ~libmpddep ~mtl
Dependencies added: dbus
Dependencies removed: dbus-core, text
Dependency ranges changed: base, libmpd, mtl, stm
Files
- LICENSE +0/−27
- license +27/−0
- news.md +48/−0
- readme.md +355/−168
- samples/xmobar.config +1/−0
- src/ColorCache.hs +110/−0
- src/Commands.hs +19/−15
- src/Config.hs +9/−1
- src/IPC/DBus.hs +63/−0
- src/Main.hs +5/−2
- src/MinXft.hsc +139/−0
- src/Parsers.hs +7/−2
- src/Plugins/BufferedPipeReader.hs +84/−0
- src/Plugins/Locks.hs +51/−0
- src/Plugins/MBox.hs +3/−3
- src/Plugins/Monitors.hs +27/−20
- src/Plugins/Monitors/Bright.hs +58/−71
- src/Plugins/Monitors/Common.hs +7/−2
- src/Plugins/Monitors/CoreCommon.hs +1/−1
- src/Plugins/Monitors/Disk.hs +37/−16
- src/Plugins/Monitors/MPD.hs +7/−3
- src/Plugins/Monitors/Mpris.hs +39/−29
- src/Plugins/Monitors/Net.hs +51/−2
- src/Plugins/PipeReader.hs +8/−2
- src/Plugins/StdinReader.hs +4/−4
- src/Plugins/Utils.hs +5/−1
- src/Runnable.hs +3/−2
- src/Signal.hs +70/−0
- src/StatFS.hsc +3/−3
- src/Window.hs +175/−0
- src/XUtil.hsc +35/−73
- src/Xmobar.hs +72/−177
- xmobar.cabal +40/−42
− LICENSE
@@ -1,27 +0,0 @@-Copyright (c) Andrea Rossato--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.-3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-SUCH DAMAGE.
+ license view
@@ -0,0 +1,27 @@+Copyright (c) Andrea Rossato++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
news.md view
@@ -1,5 +1,53 @@ % xmobar - Release notes +## Version 0.16 (Dec 3, 2012)++_New features_++ - New monitor `AutoMPD`, which uses asynchronous events to display+ MPD status (thanks to Ben Boeckel).+ - New monitor `BufferedPipeReader` displaying data from multiple+ pipes (thanks to Jochen Keil).+ - New monitor `DynNetwork`, which detects the active interface+ automatically, by Reto Hablützel+ - New monitor, `Locks`, displaying the status of lock keys, by+ Patrick Chilton.+ - Extension for DBUS signal handling (Jochen Keil)+ - Hide/Reveal: one can send signals to xmobar and make it (un)hide+ itself (Jochen again).+ - `PipeReader`'s default text is now configurable, by Reto Hablützel.+ - Dependencies updated to latest mtl and libmpd (thanks to Sergei+ Trofimovich).+ - Dependencies on the deprecated dbus-core removed in favour of+ dbus 0.10 (thanks to Jochen Keil).+ - MPris2 now includes genre and composer among its fields.++_Bug fixes_++ - `DiskIO` now can report overall activity in all partitions of a device+ which is not mounted itself (e.g., sda when sda1, sda3, etc. are+ the mounted partitions). Thanks to John Soros. See [github #73].+ - `DiskU`, the disk usage monitor, works again correctly on Linux,+ instead of randomly crashing every now and then, and reporting+ wrong used size.+ - When using antialiased fonts, we were causing a memory leak in the+ X server by repeatedly allocating colors that, apparently, the+ server doesn't know how to get rid of (even when told so!). We're+ caching them now and X server memory doesn't grow.+ - Compilation errors and warnings with GHC 7.6 removed (thanks to+ Raghavendra D Prabhu for his reports in [github #71]).++_Known problems_++Some users have reported problems with xmobar compiled with GHC 7.6 in+ArchLinux: see [github #78] and pointers therein. Please, send+reports of any problems or successes in that regard so that we can fix+any remaining issues. Thanks!++[github #71]: https://github.com/jaor/xmobar/issues/71+[github #73]: https://github.com/jaor/xmobar/issues/73+[github #78]: https://github.com/jaor/xmobar/issues/78+ ## Version 0.15 (June 4, 2012) _Incompatible changes_
readme.md view
@@ -11,7 +11,7 @@ features, like dynamic color management, output templates, and extensibility through plugins. -This page documents xmobar 0.15 (see [release notes]).+This page documents xmobar 0.16 (see [release notes]). [This screenshot] shows xmobar running under [sawfish], with antialiased fonts. And [this one] is my desktop with [xmonad] and two@@ -52,26 +52,27 @@ If you don't have `cabal-install` installed, you can get xmobar's source code in a variety of ways: - - From [Hackage]. Just download [xmobar-0.15.tar.gz] from xmobar's+ - From [Hackage]. Just download the latest release from xmobar's hackage page. - From [Github]. You can also obtain a tarball in [Github's downloads page]. You'll find there links to each tagged release. - From the bleeding edge repo. If you prefer to live dangerously, just get the latest and greatest (and buggiest, i guess) using git:+ git clone git://github.com/jaor/xmobar -[xmobar-0.15.tar.gz]: http://hackage.haskell.org/packages/archive/xmobar/0.15/xmobar-0.15.tar.gz+ [Github's downloads page]: https://github.com/jaor/xmobar/downloads -To install simply run (if needed):+If you have cabal installed, you can now use it from within xmobar's+source tree: - tar xvfz xmobar-0.15- cd xmobar-0.15+ cabal install -fall_extensions -If you have cabal installed, you can now use it from within xmobar's-source tree. Otherwise, run the configure script: +Otherwise, run the configure script:+ runhaskell Setup.lhs configure # To enable UTF-8 support run:@@ -100,6 +101,10 @@ automatically downloaded and installed if you're using cabal install. Otherwise, you'll need to install them yourself. +`with_dbus`+: Enables support for DBUS by making xmobar to publish a service on+ the session bus. Requires the [dbus] package.+ `with_threaded` : Uses GHC's threaded runtime. Use this option if xmobar enters a high-CPU regime right after starting.@@ -121,7 +126,7 @@ `with_mpris` : Enables support for MPRIS v1/v2 protocol.- Requires the [dbus-core] and [text] packages.+ Requires the [dbus] and [text] packages. `with_inotify` : Support for inotify in modern linux kernels. This option is needed@@ -221,6 +226,18 @@ : position = Top +`lowerOnStart`+: When True the window is sent the bottom of the window stack initially.++`hideOnStart`+: When set to True the window is initially not mapped, i.e. hidden. It then+ can be toggled manually (for example using the dbus interface) or+ automatically (by a plugin) to make it reappear.++`persistent`+: When True the window status is fixed i.e. hiding or revealing is not+ possible. This option can be toggled at runtime.+ `border` : TopB, TopBM, BottomB, BottomBM, FullB, FullBM or NoBorder (default). @@ -293,6 +310,103 @@ Mail bug reports and suggestions to <xmobar@projects.haskell.org> +## The DBus Interface++When compiled with the optional `with_dbus` flag, xmobar can be+controlled over dbus. All signals defined in [src/Signal.hs] as `data+SignalType` can now be sent over dbus to xmobar. Due to current+limitations of the implementation only one process of xmobar can+aquire the dbus. This is handled on a first-come-first-seved basis,+meaning that the first process will get the dbus interface. Other+processes will run without further problems, yet have no dbus+interface.++[src/Signal.hs]: https://github.com/jaor/xmobar/raw/master/src/Signal.hs++- Bus Name: `org.Xmobar.Control`+- Object Path: `/org/Xmobar/Control`+- Member Name: Any of SignalType, e.g. `string:Reveal`+- Interface Name: `org.Xmobar.Control`++An example using the `dbus-send` command line utility:++ dbus-send \+ --session \+ --dest=org.Xmobar.Control \+ --type=method_call \+ --print-reply \+ '/org/Xmobar/Control' \+ org.Xmobar.Control.SendSignal \+ "string:Toggle"++It is also possible to send multiple signals at once:++ # send to another screen, reveal and toggle the persistent flag+ dbus-send [..] \+ "string:ChangeScreen" "string:Reveal 0" "string:TogglePersistent"++### Example for using the DBus IPC interface with XMonad++Bind the key which should {,un}map xmobar to a dummy value. This is necessary+for {,un}grabKey in xmonad.++ ((0, xK_Alt_L ), return ())++Also, install `avoidStruts` layout modifier from `XMonad.Hooks.ManageDocks`++Finally, install these two event hooks (`handleEventHook` in `XConfig`)+`myDocksEventHook` is a replacement for `docksEventHook` which reacts on unmap+events as well (which `docksEventHook` doesn't).++ import qualified XMonad.Util.ExtensibleState as XS++ data DockToggleTime = DTT { lastTime :: Time } deriving (Eq, Show, Typeable)++ instance ExtensionClass DockToggleTime where+ initialValue = DTT 0++ toggleDocksHook :: Int -> KeySym -> Event -> X All+ toggleDocksHook to ks ( KeyEvent { ev_event_display = d+ , ev_event_type = et+ , ev_keycode = ekc+ , ev_time = etime+ } ) =+ io (keysymToKeycode d ks) >>= toggleDocks >> return (All True)+ where+ toggleDocks kc+ | ekc == kc && et == keyPress = do+ safeSendSignal ["Reveal 0", "TogglePersistent"]+ XS.put ( DTT etime )+ | ekc == kc && et == keyRelease = do+ gap <- XS.gets ( (-) etime . lastTime )+ safeSendSignal [ "TogglePersistent"+ , "Hide " ++ show (if gap < 400 then to else 0)+ ]+ | otherwise = return ()++ safeSendSignal s = catchX (io $ sendSignal s) (return ())+ sendSignal = withSession . callSignal+ withSession mc = connectSession >>= \c -> callNoReply c mc >> disconnect c+ callSignal :: [String] -> MethodCall+ callSignal s = ( methodCall+ ( objectPath_ "/org/Xmobar/Control" )+ ( interfaceName_ "org.Xmobar.Control" )+ ( memberName_ "SendSignal" )+ ) { methodCallDestination = Just $ busName_ "org.Xmobar.Control"+ , methodCallBody = map toVariant s+ }++ toggleDocksHook _ _ _ = return (All True)++ myDocksEventHook :: Event -> X All+ myDocksEventHook e = do+ when (et == mapNotify || et == unmapNotify) $+ whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) refresh+ return (All True)+ where w = ev_window e+ et = ev_event_type e++ ## The Output Template The output template must contain at least one command. xmobar will@@ -338,16 +452,138 @@ ## System Monitor Plugins -This is the description of the system monitor plugins that are-installed by default.+This is the description of the system monitor plugins available in+xmobar. Some of them are only installed when an optional build option+is set: we mention that fact, when needed, in their description. Each monitor has an `alias` to be used in the output template.-Monitors have default aliases.+Monitors have default aliases. The sections below describe every+monitor in turn, but before we provide a list of the configuration+options (or *monitor arguments*) they all share. ++### Default Monitor Arguments++Monitors accept a common set of arguments, described in the first+subsection below. In additon, some monitors accept additional options+that are specific to them. When specifying the list of arguments in+your configuration, the common options come first, followed by "--",+followed by any monitor-specific options.++These are the options available for all monitors below:++- `-t` _string_ Output template+ - Template for the monitor output. Field names must be enclosed+ between pointy brackets (`<foo>`) and will be substituted by the+ computed values. You can also specify the foreground (and+ optionally, background) color for a region by bracketing it+ between `<fc=fgcolor>` (or `<fc=fgcolor,bgcolor>`) and+ `</fc>`. The rest of the template is output verbatim.+ - Long option: `--template`+ - Default value: per monitor (see above).+- `-H` _number_ The high threshold.+ - Numerical values higher than _number_ will be displayed with the+ color specified by `-h` (see below).+ - Long option: `--High`+ - Default value: 66+- `-L` _number_ The low threshold.+ - Numerical values higher than _number_ and lower than the high+ threshold will be displayed with the color specified by `-n`+ (see below). Values lower than _number_ will use the `-l` color.+ - Long option: `--Low`+ - Default value: 33+- `-h` _color_ High threshold color.+ - Color for displaying values above the high threshold. _color_ can+ be either a name (e.g. "blue") or an hexadecimal RGB (e.g.+ "#FF0000").+ - Long option: `--high`+ - Default: none (use the default foreground).+- `-n` _color_ Color for 'normal' values+ - Color used for values greater than the low threshold but lower+ than the high one.+ - Long option: `--normal`+ - Default: none (use the default foreground).+- `-l` _color_ The low threshold color+ - Color for displaying values below the low threshold.+ - Long option: `--low`+ - Default: none (use the default foreground).+- `-S` _boolean_ Display optional suffixes+ - When set to a true designator ("True", "Yes" or "On"), optional+ value suffixes such as the '%' symbol or optional units will be+ displayed.+ - Long option: `--suffix`+ - Default: False.+- `-p` _number_ Percentages padding+ - Width, in number of digits, for quantities representing+ percentages. For instance `-p 3` means that all percentages+ in the monitor will be represented using 3 digits.+ - Long option: `--ppad`+ - Default value: 0 (don't pad)+- `-d` _number_ Decimal digits+ - Number of digits after the decimal period to use in float values.+ - Long option: `--ddigits`+ - Default value: 0 (display only integer part)+- `-m` _number_ Minimum field width+ - Minimum width, in number of characters, of the fields in the+ monitor template. Values whose printed representation is shorter+ than this value will be padded using the padding characters+ given by the `-c` option with the alignment specified by `-a`+ (see below).+ - Long option: `--minwidth`+ - Default: 0+- `-M` _number_ Maximum field width+ - Maximum width, in number of characters, of the fields in the+ monitor template. Values whose printed representation is longer+ than this value will be truncated.+ - Long option: `--maxwidth`+ - Default: 0 (no maximum width)+- `-w` _number_ Fixed field width+ - All fields will be set to this width, padding or truncating as+ needed.+ - Long option: `--width`+ - Default: 0 (variable width)+- `-c` _string_+ - Characters used for padding. The characters of _string_ are used+ cyclically. E.g., with `-P +- -w 6`, a field with value "foo"+ will be represented as "+-+foo".+ - Long option: `--padchars`+ - Default value: " "+- `-a` r|l Field alignment+ - Whether to use right (r) or left (l) alignment of field values+ when padding.+ - Long option: `--align`+ - Default value: r (padding to the left)+- `-b` _string_ Bar background+ - Characters used, cyclically, to draw the background of bars.+ For instance, if you set this option to "·.", an empty bar will+ look like this: `·.·.·.·.·.`+ - Long option: `--bback`+ - Default value: ":"+- `-f` _string_ Bar foreground+ - Characters used, cyclically, to draw the foreground of bars.+ - Long option: `--bfore`+ - Default value: "#"+- `-W` _number_ Bar width+ - Total number of characters used to draw bars.+ - Long option: `--bwidth`+ - Default value: 10++Commands' arguments must be set as a list. E.g.:++ Run Weather "EGPF" ["-t", "<station>: <tempC>C"] 36000++In this case xmobar will run the weather monitor, getting information+for the weather station ID EGPF (Glasgow Airport, as a homage to GHC)+every hour (36000 tenth of seconds), with a template that will output+something like:++ Glasgow Airport: 16.0C++ ### `Uptime Args RefreshRate` - Aliases to `uptime`-- Args: default monitor arguments (see below). The low and high+- Args: default monitor arguments. The low and high thresholds refer to the number of days. - Variables that can be used with the `-t`/`--template` argument: `days`, `hours`, `minutes`, `seconds`. The total uptime is the@@ -358,7 +594,7 @@ ### `Weather StationID Args RefreshRate` - Aliases to the Station ID: so `Weather "LIPB" []` can be used in template as `%LIPB%`-- Args: default monitor arguments (see below)+- 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`,@@ -371,7 +607,7 @@ - Aliases to the interface name: so `Network "eth0" []` can be used as `%eth0%`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `dev`, `rx`, `tx`, `rxbar`, `txbar`. Reception and transmission rates (`rx` and `tx`) are displayed in Kbytes per second, and you@@ -379,11 +615,23 @@ string "Kb/s"). - Default template: `<dev>: <rx>KB|<tx>KB` +### `DynNetwork Args RefreshRate`++- Active interface is detected automatically+- Aliases to "dynnetwork"+- Args: default monitor arguments+- Variables that can be used with the `-t`/`--template` argument:+ `dev`, `rx`, `tx`, `rxbar`, `txbar`. 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, `Wirelss "wlan0" []` can be used as `%wlan0wi%`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `essid`, `quality`, `qualitybar` - Default template: `<essid> <quality>`@@ -394,7 +642,7 @@ ### `Memory Args RefreshRate` - Aliases to `memory`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `total`, `free`, `buffer`, `cache`, `rest`, `used`, `usedratio`, `usedbar`, `freebar`@@ -403,7 +651,7 @@ ### `Swap Args RefreshRate` - Aliases to `swap`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `total`, `used`, `free`, `usedratio` - Default template: `Swap: <usedratio>%`@@ -411,7 +659,7 @@ ### `Cpu Args RefreshRate` - Aliases to `cpu`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `total`, `bar`, `user`, `nice`, `system`, `idle`, `iowait` - Default template: `Cpu: <total>%`@@ -419,7 +667,7 @@ ### `MultiCpu Args RefreshRate` - Aliases to `multicpu`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `autototal`, `autobar`, `autouser`, `autonice`, `autosystem`, `autoidle`, `total`, `bar`, `user`, `nice`,@@ -440,17 +688,19 @@ look for the ACPI files of each battery. Example: `["BAT0","BAT1","BAT2"]`. Only the first 3 directories will be searched.-- Args: default monitor arguments (see below), plus the following specif ones:- - `-O`: string for AC "on" status (default: "On")- - `-o`: string for AC "off" status (default: "Off")- - `-L`: low power (`watts`) threshold (default: -12)- - `-H`: high power threshold (default: -10)- - `-l`: color to display power lower than the `-L` threshold- - `-m`: color to display power lower than the `-H` threshold- - `-h`: color to display power highter than the `-H` threshold- - `-p`: color to display positive power (battery charging)- - `-f`: file in `/sys/class/power_supply` with AC info (default:- "AC/online")+- Args: default monitor arguments, plus the following specific ones+ (these options, being specific to the monitor, are to be specified+ after a `--` in the argument list):+ - `-O`: string for AC "on" status (default: "On")+ - `-o`: string for AC "off" status (default: "Off")+ - `-L`: low power (`watts`) threshold (default: -12)+ - `-H`: high power threshold (default: -10)+ - `-l`: color to display power lower than the `-L` threshold+ - `-m`: color to display power lower than the `-H` threshold+ - `-h`: color to display power highter than the `-H` threshold+ - `-p`: color to display positive power (battery charging)+ - `-f`: file in `/sys/class/power_supply` with AC info (default:+ "AC/online") - Variables that can be used with the `-t`/`--template` argument: `left`, `leftbar`, `timeleft`, `watts`, `acstatus`@@ -465,14 +715,17 @@ "-L", "-15", "-H", "-5", "-l", "red", "-m", "blue", "-h", "green"] 600+ In the above example, the thresholds before the "--" separator- refer to the `<left>` field, while those after the separator affect- how `<watts>` is displayed.+ affect only the `<left>` and `<leftbar>` fields, while those after+ the separator affect how `<watts>` is displayed. For this monitor,+ neither the generic nor the specific options have any effect on+ `<timeleft>`. ### `TopProc Args RefreshRate` - Aliases to `top`-- Args: default monitor arguments (see below). The low and high+- Args: default monitor arguments. The low and high thresholds (`-L` and `-H`) denote, for memory entries, the percent of the process memory over the total amount of memory currently in use and, for cpu entries, the activity percentage (i.e., the value@@ -489,7 +742,7 @@ ### `TopMem Args RefreshRate` - Aliases to `topmem`-- Args: default monitor arguments (see below). The low and high+- Args: default monitor arguments. The low and high thresholds (`-L` and `-H`) denote the percent of the process memory over the total amount of memory currently in use. - Variables that can be used with the `-t`/`--template` argument:@@ -506,7 +759,7 @@ where the template can contain <size>, <free>, <used>, <freep> or <usedp>, <freebar> or <usedbar> for total, free, used, free percentage and used percentage of the given file system capacity.-- Args: default monitor arguments (see below). `-t`/`--template` is ignored.+- Args: default monitor arguments. `-t`/`--template` is ignored. - Default template: none (you must specify a template for each file system). - Example: @@ -520,17 +773,17 @@ - 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.-- Args: default monitor arguments (see below). `-t`/`--template` is ignored.+- Args: default monitor arguments. `-t`/`--template` is ignored. - Default template: none (you must specify a template for each file system). - Example: - Disks [("/", "<read> <write>"), ("sdb1", "<total>")] [] 10+ DiskIO [("/", "<read> <write>"), ("sdb1", "<total>")] [] 10 ### `ThermalZone Number Args RefreshRate` - Aliases to "thermaln": so `ThermalZone 0 []` can be used in template as `%thermal0%`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `temp` - Default template: `<temp>C`@@ -548,7 +801,7 @@ - Aliases to the Zone: so `Thermal "THRM" []` can be used in template as `%THRM%`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `temp` - Default template: `Thm: <temp>C`@@ -561,7 +814,7 @@ ### `CpuFreq Args RefreshRate` - Aliases to `cpufreq`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `cpu0`, `cpu1`, .., `cpuN` - Default template: `Freq: <cpu0>GHz`@@ -574,7 +827,7 @@ ### `CoreTemp Args RefreshRate` - Aliases to `coretemp`-- Args: default monitor arguments (see below)+- Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `core0`, `core1`, .., `coreN` - Default template: `Temp: <core0>C`@@ -589,7 +842,7 @@ - Aliases to the mixer name and element name separated by a colon. Thus, `Volume "default" "Master" [] 10` can be used as `%default:Master%`.-- Args: default monitor arguments (see below). Also accepts:+- Args: default monitor arguments. Also accepts: - `-O` _string_ On string - The string used in place of `<status>` when the mixer element is on. Defaults to "[on]".@@ -622,7 +875,7 @@ - This monitor will only be compiled if you ask for it using the `with_mpd` flag. It needs [libmpd] 5.0 or later (available on Hackage). - Aliases to `mpd`-- Args: default monitor arguments (see below). In addition you can provide+- Args: default monitor arguments. In addition you can provide `-P`, `-S` and `-Z`, with an string argument, to represent the playing, stopped and paused states in the `statei` template field. The environment variables `MPD_HOST` and `MPD_PORT` are used to configure the@@ -644,7 +897,7 @@ ### `Mpris1 PlayerName Args RefreshRate` - Aliases to `mpris1`-- Requires [dbus-core] and [text] packages.+- Requires [dbus] and [text] packages. To activate, pass `--flags="with_mpris"` during compilation. - PlayerName: player supporting MPRIS v1 protocol, in lowercase. - Args: default monitor arguments.@@ -653,14 +906,23 @@ - Default template: `<artist> - <title>` - Example: - Run Mpris1 "clementine" ["-t",- "<artist> - [<tracknumber>] <title>"] 10+ Run Mpris1 "clementine" ["-t", "<artist> - [<tracknumber>] <title>"] 10 ### `Mpris2 PlayerName Args RefreshRate` -- Just like Mpris1.- Supposed to be used with mediaplayers which support MPRIS v2.+- Aliases to `mpris1`+- Requires [dbus] and [text] packages.+ To activate, pass `--flags="with_mpris"` during compilation.+- PlayerName: player supporting MPRIS v2 protocol, in lowercase.+- Args: default monitor arguments.+- Variables that can be used with the `-t`/`--template` argument:+ `album`, `artist`, `arturl`, `length`, `title`,+ `tracknumber`, `composer`, `genre`+- Default template: `<artist> - <title>`+- Example: + Run Mpris2 "clementine" ["-t", "<artist> - [<composer>] <title>"] 10+ ### `Mail Args Alias` - Args: list of maildirs in form@@ -718,7 +980,7 @@ ### `Brightness Args RefreshRate` - Aliases to `bright`-- Args: default monitor arguments (see below), plus the following specif ones:+- Args: default monitor arguments, plus the following specif ones: - `-D`: directory in `/sys/class/backlight/` with files in it (default: "acpi_video0") - `-C`: file with the current brightness (default:@@ -744,118 +1006,13 @@ Run Kbd [("us(dvorak)", "DV"), ("us", "US")] --## Monitor Plugins Commands Arguments--These are the arguments that can be used for internal commands in the-`commands` configuration option:--- `-t` _string_ Output template- - Template for the monitor output. Field names must be enclosed- between pointy brackets (`<foo>`) and will be substituted by the- computed values. You can also specify the foreground (and- optionally, background) color for a region by bracketing it- between `<fc=fgcolor>` (or `<fc=fgcolor,bgcolor>`) and- `</fc>`. The rest of the template is output verbatim.- - Long option: `--template`- - Default value: per monitor (see above).-- `-H` _number_ The high threshold.- - Numerical values higher than _number_ will be displayed with the- color specified by `-h` (see below).- - Long option: `--High`- - Default value: 66-- `-L` _number_ The low threshold.- - Numerical values higher than _number_ and lower than the high- threshold will be displayed with the color specified by `-m`- (see below). Values lower than _number_ will use the `-l` color.- - Long option: `--Low` - Default value: 80- - Default value: 33-- `-h` _color_ High threshold color.- - Color for displaying values above the high threshold. _color_ can- be either a name (e.g. "blue") or an hexadecimal RGB (e.g.- "#FF0000").- - Long option: `--high`- - Default: none (use the default foreground).-- `-n` _color_ Color for 'normal' values- - Color used for values greater than the low threshold but lower- than the high one.- - Long option: `--normal`- - Default: none (use the default foreground).-- `-l` _color_ The low threshold color- - Color for displaying values below the low threshold.- - Long option: `--low`- - Default: none (use the default foreground).-- `-S` _boolean_ Display optional suffixes- - When set to a true designator ("True", "Yes" or "On"), optional- value suffixes such as the '%' symbol or optional units will be- displayed.- - Long option: `--suffix`- - Default: False.-- `-p` _number_ Percentages padding- - Width, in number of digits, for quantities representing- percentages. For instance `-p 3` means that all percentages- in the monitor will be represented using 3 digits.- - Long option: `--ppad`- - Default value: 0 (don't pad)-- `-d` _number_ Decimal digits- - Number of digits after the decimal period to use in float values.- - Long option: `--ddigits`- - Default value: 0 (display only integer part)-- `-m` _number_ Minimum field width- - Minimum width, in number of characters, of the fields in the- monitor template. Values whose printed representation is shorter- than this value will be padded using the padding characters- given by the `-c` option with the alignment specified by `-a`- (see below).- - Long option: `--minwidth`- - Default: 0-- `-M` _number_ Maximum field width- - Maximum width, in number of characters, of the fields in the- monitor template. Values whose printed representation is longer- than this value will be truncated.- - Long option: `--maxwidth`- - Default: 0 (no maximum width)-- `-w` _number_ Fixed field width- - All fields will be set to this width, padding or truncating as- needed.- - Long option: `--width`- - Default: 0 (variable width)-- `-c` _string_- - Characters used for padding. The characters of _string_ are used- cyclically. E.g., with `-P +- -w 6`, a field with value "foo"- will be represented as "+-+foo".- - Long option: `--padchars`- - Default value: " "-- `-a` r|l Field alignment- - Whether to use right (r) or left (l) alignment of field values- when padding.- - Long option: `--align`- - Default value: r (padding to the left)-- `-b` _string_ Bar background- - Characters used, cyclically, to draw the background of bars.- For instance, if you set this option to "·.", an empty bar will- look like this: `·.·.·.·.·.`- - Long option: `--bback`- - Default value: ":"-- `-f` _string_ Bar foreground- - Characters used, cyclically, to draw the foreground of bars.- - Long option: `--bfore`- - Default value: "#"-- `-W` _number_ Bar width- - Total number of characters used to draw bars.- - Long option: `--bwidth`- - Default value: 10--Commands' arguments must be set as a list. E.g.:-- Run Weather "EGPF" ["-t", "<station>: <tempC>C"] 36000+### `Locks` -In this case xmobar will run the weather monitor, getting information-for the weather station ID EGPF (Glasgow Airport, as a homage to GHC)-every hour (36000 tenth of seconds), with a template that will output-something like:+- Displays the status of Caps Lock, Num Lock and Scroll Lock.+- Aliases to `locks`+- Example: - Glasgow Airport: 16.0C+ Run Locks ## Executing External Commands @@ -915,10 +1072,40 @@ - Runs the given program, and displays its standard output. -`PipeReader "/path/to/pipe" Alias`+`PipeReader "default text:/path/to/pipe" Alias` - Reads its displayed output from the given pipe.+- Prefix an optional default text separated by a colon +`BufferedPipeReader Alias [ (Timeout, Bool, "/path/to/pipe1")+ , (Timeout, Bool, "/path/to/pipe2")+ , ..+ ]`++- Display data from multiple pipes.+- Timeout (in tenth of seconds) is the value after which the previous content is+ restored i.e. if there was already something from a previous pipe it will be+ put on display again, overwriting the current status.+- A pipe with Timout of 0 will be displayed permanently, just like `PipeReader`+- The boolean option indicates whether new data for this pipe should make xmobar+ appear (unhide, reveal). In this case, the Timeout additionally specifies when+ the window should be hidden again. The output is restored in any case.+- Use it for OSD like status bars e.g. for setting the volume or brightness:++ Run BufferedPipeReader "bpr"+ [ ( 0, False, "/tmp/xmobar_window" )+ , ( 15, True, "/tmp/xmobar_status" )+ ]++ Have your window manager send window titles to `"/tmp/xmobar_window"`. They will+ always be shown and not reveal your xmobar.+ Sending some status information to `"/tmp/xmobar_status"` will reveal xmonad+ for 1.5 seconds and temporarily overwrite the window titles.+- Take a look at [samples/status.sh]++[samples/status.sh]: http://github.com/jaor/xmobar/raw/master/samples/status.sh++ `XMonadLog` - Aliases to XMonadLog@@ -1063,12 +1250,12 @@ the greater Haskell community. In particular, xmobar [incorporates patches] by Ben Boeckel, Roman-Cheplyaka, John Goerzen, Juraj Hercek, Tomas Janousek, Spencer-Janssen, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry-Kurochkin, Svein Ove, Martin Perner, Jens Petersen, Petr Rockai,-Andrew Sackville-West, Alexander Solovyov, Artem Tarasov, Sergei-Trofimovich, Thomas Tuegel, Jan Vornberger, Daniel Wagner and Norbert-Zeh.+Cheplyaka, Patrick Chilton, John Goerzen, Reto Hablützel, Juraj+Hercek, Tomas Janousek, Spencer Janssen, Jochen Keil, Lennart+Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Svein Ove,+Martin Perner, Jens Petersen, Petr Rockai, Andrew Sackville-West,+Alexander Solovyov, John Soros, Artem Tarasov, Sergei Trofimovich,+Thomas Tuegel, Jan Vornberger, Daniel Wagner and Norbert Zeh. [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors @@ -1127,7 +1314,7 @@ [iwlib]: http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html [hinotify]: http://hackage.haskell.org/package/hinotify/ [libmpd]: http://hackage.haskell.org/package/libmpd/-[dbus-core]: http://hackage.haskell.org/package/dbus-core+[dbus]: http://hackage.haskell.org/package/dbus [text]: http://hackage.haskell.org/package/text [sawfish]: http://sawfish.wikia.com/ [utf8-string]: http://hackage.haskell.org/package/utf8-string/
samples/xmobar.config view
@@ -5,6 +5,7 @@ , fgColor = "grey" , position = Top , lowerOnStart = True+ , persistent = 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
+ src/ColorCache.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE CPP #-}+------------------------------------------------------------------------------+-- |+-- Module: ColorCache+-- Copyright: (c) 2012 Jose Antonio Ortega Ruiz+-- License: BSD3-style (see LICENSE)+--+-- Maintainer: jao@gnu.org+-- Stability: unstable+-- Portability: unportable+-- Created: Mon Sep 10, 2012 00:27+--+--+-- Caching X colors+--+------------------------------------------------------------------------------++#if defined XFT++module ColorCache(withColors, withDrawingColors) where++import MinXft++#else+module ColorCache(withColors) where++#endif++import Data.IORef+import System.IO.Unsafe (unsafePerformIO)+import Control.Monad.Trans (MonadIO, liftIO)+import Control.Exception (SomeException, handle)+import Graphics.X11.Xlib++data DynPixel = DynPixel Bool Pixel++initColor :: Display -> String -> IO DynPixel+initColor dpy c = handle black $ (initColor' dpy c)+ where+ black :: SomeException -> IO DynPixel+ black = (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))++type ColorCache = [(String, Color)]+{-# NOINLINE colorCache #-}+colorCache :: IORef ColorCache+colorCache = unsafePerformIO $ newIORef []++getCachedColor :: String -> IO (Maybe Color)+getCachedColor color_name = lookup color_name `fmap` readIORef colorCache++putCachedColor :: String -> Color -> IO ()+putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c++initColor' :: Display -> String -> IO DynPixel+initColor' dpy c = do+ let colormap = defaultColormap dpy (defaultScreen dpy)+ cached_color <- getCachedColor c+ c' <- case cached_color of+ Just col -> return col+ _ -> do (c'', _) <- allocNamedColor dpy colormap c+ putCachedColor c c''+ return c''+ return $ DynPixel True (color_pixel c')++withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a+withColors d cs f = do+ ps <- mapM (liftIO . initColor d) cs+ f $ map (\(DynPixel _ pixel) -> pixel) ps++#ifdef XFT++type AXftColorCache = [(String, AXftColor)]+{-# NOINLINE xftColorCache #-}+xftColorCache :: IORef AXftColorCache+xftColorCache = unsafePerformIO $ newIORef []++getXftCachedColor :: String -> IO (Maybe AXftColor)+getXftCachedColor name = lookup name `fmap` readIORef xftColorCache++putXftCachedColor :: String -> AXftColor -> IO ()+putXftCachedColor name cptr =+ modifyIORef xftColorCache $ \c -> (name, cptr) : c++initAXftColor' :: Display -> Visual -> Colormap -> String -> IO AXftColor+initAXftColor' d v cm c = do+ cc <- getXftCachedColor c+ c' <- case cc of+ Just col -> return col+ _ -> do c'' <- mallocAXftColor d v cm c+ putXftCachedColor c c''+ return c''+ return c'++initAXftColor :: Display -> Visual -> Colormap -> String -> IO AXftColor+initAXftColor d v cm c = handle black $ (initAXftColor' d v cm c)+ where+ black :: SomeException -> IO AXftColor+ black = (const $ initAXftColor' d v cm "black")++withDrawingColors :: -- MonadIO m =>+ Display -> Drawable -> String -> String+ -> (AXftDraw -> AXftColor -> AXftColor -> IO ()) -> IO ()+withDrawingColors dpy drw fc bc f = do+ let screen = defaultScreenOfDisplay dpy+ colormap = defaultColormapOfScreen screen+ visual = defaultVisualOfScreen screen+ fc' <- initAXftColor dpy visual colormap fc+ bc' <- initAXftColor dpy visual colormap bc+ withAXftDraw dpy drw visual colormap $ \draw -> f draw fc' bc'+#endif
src/Commands.hs view
@@ -23,25 +23,29 @@ , tenthSeconds ) where -import Prelude hiding (catch)+import Prelude import Control.Concurrent-import Control.Exception+import Control.Exception (handle, SomeException(..)) import Data.Char import System.Process import System.Exit import System.IO (hClose)++import Signal import XUtil class Show e => Exec e where- alias :: e -> String- alias e = takeWhile (not . isSpace) $ show e- rate :: e -> Int- rate _ = 10- run :: e -> IO String- run _ = return ""- start :: e -> (String -> IO ()) -> IO ()- start e cb = go+ alias :: e -> String+ alias e = takeWhile (not . isSpace) $ show e+ rate :: e -> Int+ rate _ = 10+ run :: e -> IO String+ run _ = return ""+ start :: e -> (String -> IO ()) -> IO ()+ start e cb = go where go = run e >>= cb >> tenthSeconds (rate e) >> go+ trigger :: e -> (Maybe SignalType -> IO ()) -> IO ()+ trigger _ sh = sh Nothing data Command = Com Program Args Alias Rate deriving (Show,Read,Eq)@@ -61,12 +65,12 @@ (i,o,e,p) <- runInteractiveCommand (unwords (prog:args)) exit <- waitForProcess p let closeHandles = hClose o >> hClose i >> hClose e+ getL = handle (\(SomeException _) -> return "")+ (hGetLineSafe o) case exit of- ExitSuccess -> do- str <- catch (hGetLineSafe o)- (\(SomeException _) -> return "")- closeHandles- cb str+ ExitSuccess -> do str <- getL+ closeHandles+ cb str _ -> do closeHandles cb $ "Could not execute command " ++ prog
src/Config.hs view
@@ -28,11 +28,13 @@ import Plugins.Monitors import Plugins.Date import Plugins.PipeReader+import Plugins.BufferedPipeReader import Plugins.CommandReader import Plugins.StdinReader import Plugins.XMonadLog import Plugins.EWMH import Plugins.Kbd+import Plugins.Locks #ifdef INOTIFY import Plugins.Mail@@ -54,8 +56,12 @@ , position :: XPosition -- ^ Top Bottom or Static , border :: Border -- ^ NoBorder TopB BottomB or FullB , borderColor :: String -- ^ Border color+ , hideOnStart :: Bool -- ^ Hide (Unmap) the window on+ -- initialization , lowerOnStart :: Bool -- ^ Lower to the bottom of the -- window stack on initialization+ , persistent :: Bool -- ^ Whether automatic hiding should+ -- be enabled or disabled , commands :: [Runnable] -- ^ For setting the command, the command arguments -- and refresh rate for the programs to run (optional) , sepChar :: String -- ^ The character to be used for indicating@@ -94,7 +100,9 @@ , position = Top , border = NoBorder , borderColor = "#BFBFBF"+ , hideOnStart = False , lowerOnStart = True+ , persistent = False , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10 , Run StdinReader] , sepChar = "%"@@ -113,7 +121,7 @@ -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types (separated by ':*:') appearing in -- this function's type signature.-runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*:+runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: #ifdef INOTIFY Mail :*: MBox :*: #endif
+ src/IPC/DBus.hs view
@@ -0,0 +1,63 @@+-----------------------------------------------------------------------------+-- |+-- Module : DBus+-- Copyright : (c) Jochen Keil+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jochen Keil <jochen dot keil at gmail dot com>+-- Stability : unstable+-- Portability : unportable+--+-- DBus IPC module for Xmobar+--+-----------------------------------------------------------------------------++module IPC.DBus ( runIPC ) where++import Prelude hiding (catch)++import DBus+import DBus.Client+import Control.Monad (when)+import Control.Concurrent.STM+import Control.Exception (catch)+import System.IO (stderr, hPutStrLn)++import Signal++busName :: BusName+busName = busName_ "org.Xmobar.Control"++objectPath :: ObjectPath+objectPath = objectPath_ "/org/Xmobar/Control"++interfaceName :: InterfaceName+interfaceName = interfaceName_ "org.Xmobar.Control"++runIPC :: TMVar SignalType -> IO ()+runIPC mvst = catch exportConnection printException+ where+ printException :: ClientError -> IO ()+ printException = hPutStrLn stderr . clientErrorMessage+ exportConnection = do+ client <- connectSession+ requestName client busName [ nameDoNotQueue ]+ export client objectPath [ sendSignalMethod mvst ]++sendSignalMethod :: TMVar SignalType -> Method+sendSignalMethod mvst = method interfaceName sendSignalName+ (signature_ [variantType $ toVariant $ (undefined :: SignalType)])+ (signature_ [])+ sendSignalMethodCall+ where+ sendSignalName :: MemberName+ sendSignalName = memberName_ "SendSignal"++ sendSignalMethodCall :: MethodCall -> IO Reply+ sendSignalMethodCall mc = do+ when ( methodCallMember mc == sendSignalName )+ $ mapM_ (sendSignal . fromVariant) (methodCallBody mc)+ return ( replyReturn [] )++ sendSignal :: Maybe SignalType -> IO ()+ sendSignal = maybe (return ()) (atomically . putTMVar mvst)
src/Main.hs view
@@ -36,6 +36,8 @@ import System.Posix.Files import Control.Monad (unless) +import Signal (setupSignalHandler)+ -- $main -- | The main entry point@@ -55,9 +57,10 @@ conf <- doOpts c o fs <- initFont d (font conf) cls <- mapM (parseTemplate conf) (splitTemplate conf)- vars <- mapM (mapM startCommand) cls+ sig <- setupSignalHandler+ vars <- mapM (mapM $ startCommand sig) cls (r,w) <- createWin d fs conf- startLoop (XConf d r w fs conf) vars+ startLoop (XConf d r w fs conf) sig vars -- | Splits the template in its parts splitTemplate :: Config -> [String]
+ src/MinXft.hsc view
@@ -0,0 +1,139 @@+{-# LANGUAGE ForeignFunctionInterface #-}+------------------------------------------------------------------------------+-- |+-- Module: MinXft+-- Copyright: (c) 2012 Jose Antonio Ortega Ruiz+-- (c) Clemens Fruhwirth <clemens@endorphin.org> 2007+-- License: BSD3-style (see LICENSE)+--+-- Maintainer: jao@gnu.org+-- Stability: unstable+-- Portability: unportable+-- Created: Mon Sep 10, 2012 18:12+--+--+-- Pared down Xft library, based on Graphics.X11.Xft and providing+-- explicit management of XftColors, so that they can be cached.+--+-- Most of the code is lifted from Clemens's.+--+------------------------------------------------------------------------------++module MinXft ( AXftColor+ , AXftDraw (..)+ , AXftFont+ , mallocAXftColor+ , freeAXftColor+ , withAXftDraw+ , drawXftString+ , drawXftRect+ , openAXftFont+ , closeAXftFont+ , xftTxtExtents+ , xft_ascent+ , xft_descent+ , xft_height+ )++where++import Graphics.X11+import Graphics.X11.Xlib.Types+import Graphics.X11.Xrender++import Foreign+import Foreign.C.Types+import Foreign.C.String+import Codec.Binary.UTF8.String as UTF8++#include <X11/Xft/Xft.h>++-- Color Handling++newtype AXftColor = AXftColor (Ptr AXftColor)++foreign import ccall "XftColorAllocName"+ cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> AXftColor -> IO (#type Bool)++-- this is the missing bit in X11.Xft, not implementable from the+-- outside because XftColor does not export a constructor.+mallocAXftColor :: Display -> Visual -> Colormap -> String -> IO AXftColor+mallocAXftColor d v cm n = do+ color <- mallocBytes (#size XftColor)+ withCAString n $ \str -> cXftColorAllocName d v cm str (AXftColor color)+ return (AXftColor color)++foreign import ccall "XftColorFree"+ freeAXftColor :: Display -> Visual -> Colormap -> AXftColor -> IO ()++-- Font handling++newtype AXftFont = AXftFont (Ptr AXftFont)++xft_ascent :: AXftFont -> IO Int+xft_ascent (AXftFont p) = peekCUShort p #{offset XftFont, ascent}++xft_descent :: AXftFont -> IO Int+xft_descent (AXftFont p) = peekCUShort p #{offset XftFont, descent}++xft_height :: AXftFont -> IO Int+xft_height (AXftFont p) = peekCUShort p #{offset XftFont, height}++foreign import ccall "XftTextExtentsUtf8"+ cXftTextExtentsUtf8 :: Display -> AXftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO ()++xftTxtExtents :: Display -> AXftFont -> String -> IO XGlyphInfo+xftTxtExtents d f string =+ withArrayLen (map fi (UTF8.encode string)) $+ \len str_ptr -> alloca $+ \cglyph -> do+ cXftTextExtentsUtf8 d f str_ptr (fi len) cglyph+ peek cglyph++foreign import ccall "XftFontOpenName"+ c_xftFontOpen :: Display -> CInt -> CString -> IO AXftFont++openAXftFont :: Display -> Screen -> String -> IO AXftFont+openAXftFont dpy screen name =+ withCAString name $+ \cname -> c_xftFontOpen dpy (fi (screenNumberOfScreen screen)) cname++foreign import ccall "XftFontClose"+ closeAXftFont :: Display -> AXftFont -> IO ()++-- Drawing++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++newtype AXftDraw = AXftDraw (Ptr AXftDraw)++foreign import ccall "XftDrawCreate"+ c_xftDrawCreate :: Display -> Drawable -> Visual -> Colormap -> IO AXftDraw++foreign import ccall "XftDrawDestroy"+ c_xftDrawDestroy :: AXftDraw -> IO ()++withAXftDraw :: Display -> Drawable -> Visual -> Colormap -> (AXftDraw -> IO a) -> IO a+withAXftDraw d p v c act = do+ draw <- c_xftDrawCreate d p v c+ a <- act draw+ c_xftDrawDestroy draw+ return a++foreign import ccall "XftDrawStringUtf8"+ cXftDrawStringUtf8 :: AXftDraw -> AXftColor -> AXftFont -> CInt -> CInt -> Ptr (#type FcChar8) -> CInt -> IO ()++drawXftString :: (Integral a1, Integral a) =>+ AXftDraw -> AXftColor -> AXftFont -> a -> a1 -> String -> IO ()+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))++foreign import ccall "XftDrawRect"+ cXftDrawRect :: AXftDraw -> AXftColor -> CInt -> CInt -> CUInt -> CUInt -> IO ()++drawXftRect :: (Integral a3, Integral a2, Integral a1, Integral a) =>+ AXftDraw -> AXftColor -> a -> a1 -> a2 -> a3 -> IO ()+drawXftRect draw color x y width height =+ cXftDrawRect draw color (fi x) (fi y) (fi width) (fi height)
src/Parsers.hs view
@@ -131,13 +131,16 @@ <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition <|?> pBorder <|?> pBdColor- <|?> pLowerOnStart <|?> pCommands+ <|?> pHideOnStart <|?> pLowerOnStart+ <|?> pPersistent <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" , "border", "borderColor" ,"template", "position"- , "lowerOnStart", "commands"]+ , "hideOnStart", "lowerOnStart", "persistent", "commands"+ ]+ pFont = strField font "font" pBgColor = strField bgColor "bgColor" pFgColor = strField fgColor "fgColor"@@ -147,7 +150,9 @@ pTemplate = strField template "template" pPosition = field position "position" $ tillFieldEnd >>= read' "position"+ pHideOnStart = field hideOnStart "hideOnStart" $ tillFieldEnd >>= read' "hideOnStart" pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart"+ pPersistent = field persistent "persistent" $ tillFieldEnd >>= read' "persistent" pBorder = field border "border" $ tillFieldEnd >>= read' "border" pCommands = field commands "commands" $ readCommands
+ src/Plugins/BufferedPipeReader.hs view
@@ -0,0 +1,84 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.BufferedPipeReader+-- Copyright : (c) Jochen Keil+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jochen Keil <jochen dot keil at gmail dot com>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for reading (temporarily) from named pipes with reset+--+-----------------------------------------------------------------------------++module Plugins.BufferedPipeReader where++import Control.Monad(forM_, when)+import Control.Concurrent+import Control.Concurrent.STM+import System.IO+import System.IO.Unsafe(unsafePerformIO)++import Plugins+import Signal++data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)]+ deriving (Read, Show)++signal :: MVar SignalType+signal = unsafePerformIO newEmptyMVar++instance Exec BufferedPipeReader where+ alias ( BufferedPipeReader a _ ) = a++ trigger br@( BufferedPipeReader _ _ ) sh =+ takeMVar signal >>= sh . Just >> trigger br sh++ start ( BufferedPipeReader _ ps ) cb = do++ (chan, str, rst) <- initV+ forM_ ps $ \p -> forkIO $ reader p chan+ writer chan str rst++ where+ initV :: IO ( TChan (Int, Bool, String), TVar (Maybe String), TVar Bool )+ initV = atomically $ do+ tc <- newTChan+ ts <- newTVar Nothing+ tb <- newTVar False+ return (tc, ts, tb)++ reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO ()+ reader p@(to, tg, fp) tc = do+ openFile fp ReadWriteMode >>= hGetLineSafe >>= \dt ->+ atomically $ writeTChan tc (to, tg, dt)+ reader p tc++ writer :: TChan (Int, Bool, String)+ -> TVar (Maybe String) -> TVar Bool -> IO ()+ writer tc ts otb = do+ (to, tg, dt, ntb) <- update+ cb dt+ when tg $ putMVar signal $ Reveal 0+ when (to /= 0) $ sfork $ reset to tg ts ntb+ writer tc ts ntb++ where+ sfork :: IO () -> IO ()+ sfork f = forkIO f >> return ()++ update :: IO (Int, Bool, String, TVar Bool)+ update = atomically $ do+ (to, tg, dt) <- readTChan tc+ when (to == 0) $ writeTVar ts $ Just dt+ writeTVar otb False+ tb <- newTVar True+ return (to, tg, dt, tb)++ reset :: Int -> Bool -> TVar (Maybe String) -> TVar Bool -> IO ()+ reset to tg ts tb = do+ threadDelay ( to * 100 * 1000 )+ readTVarIO tb >>= \b -> when b $ do+ when tg $ putMVar signal $ Hide 0+ atomically (readTVar ts) >>= maybe (return ()) cb
+ src/Plugins/Locks.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Locks+-- Copyright : (c) Patrick Chilton+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Patrick Chilton <chpatrick@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin that displays the status of the lock keys.+--+-----------------------------------------------------------------------------++module Plugins.Locks where++import Graphics.X11+import Data.List+import Data.Bits+import Control.Monad+import Graphics.X11.Xlib.Extras+import Plugins++data Locks = Locks+ deriving (Read, Show)++locks :: [ ( KeySym, String )]+locks = [ ( xK_Caps_Lock, "CAPS" )+ , ( xK_Num_Lock, "NUM" )+ , ( xK_Scroll_Lock, "SCROLL" )+ ]++instance Exec Locks where+ alias Locks = "locks"+ rate Locks = 2+ run Locks = do+ d <- openDisplay ""+ root <- rootWindow d (defaultScreen d)++ 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+ closeDisplay d++ return $ unwords $ map snd ls
src/Plugins/MBox.hs view
@@ -14,13 +14,13 @@ module Plugins.MBox (MBox(..)) where -import Prelude hiding (catch)+import Prelude import Plugins import Plugins.Utils (changeLoop, expandHome) import Control.Monad (when) import Control.Concurrent.STM-import Control.Exception (SomeException, handle, evaluate)+import Control.Exception (SomeException (..), handle, evaluate) import System.Console.GetOpt import System.Directory (doesFileExist)@@ -99,7 +99,7 @@ countMails :: FilePath -> IO Int countMails f =- handle ((\_ -> evaluate 0) :: SomeException -> IO Int)+ handle (\(SomeException _) -> evaluate 0) (do txt <- B.readFile f evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt) where from = B.pack "From "
src/Plugins/Monitors.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Plugins.Monitors--- Copyright : (c) 2010, 2011 Jose Antonio Ortega Ruiz+-- Copyright : (c) 2010, 2011, 2012 Jose Antonio Ortega Ruiz -- (c) 2007-10 Andrea Rossato -- License : BSD-style (see LICENSE) --@@ -19,7 +19,7 @@ import Plugins -import Plugins.Monitors.Common ( runM )+import Plugins.Monitors.Common (runM) import Plugins.Monitors.Weather import Plugins.Monitors.Net import Plugins.Monitors.Mem@@ -40,6 +40,7 @@ #endif #ifdef LIBMPD import Plugins.Monitors.MPD+import Plugins.Monitors.Common (runMB) #endif #ifdef ALSA import Plugins.Monitors.Volume@@ -48,29 +49,31 @@ import Plugins.Monitors.Mpris #endif -data Monitors = Weather Station Args Rate- | Network Interface Args Rate- | BatteryP [String] Args Rate- | DiskU DiskSpec Args Rate- | DiskIO DiskSpec Args Rate- | Thermal Zone Args Rate- | ThermalZone ZoneNo Args Rate- | Memory Args Rate- | Swap Args Rate- | Cpu Args Rate- | MultiCpu Args Rate- | Battery Args Rate- | Brightness Args Rate- | CpuFreq Args Rate- | CoreTemp Args Rate- | TopProc Args Rate- | TopMem Args Rate- | Uptime Args Rate+data Monitors = Weather Station Args Rate+ | Network Interface Args Rate+ | DynNetwork Args Rate+ | BatteryP [String] Args Rate+ | DiskU DiskSpec Args Rate+ | DiskIO DiskSpec Args Rate+ | Thermal Zone Args Rate+ | ThermalZone ZoneNo Args Rate+ | Memory Args Rate+ | Swap Args Rate+ | Cpu Args Rate+ | MultiCpu Args Rate+ | Battery Args Rate+ | Brightness Args Rate+ | CpuFreq Args Rate+ | CoreTemp Args Rate+ | TopProc Args Rate+ | TopMem Args Rate+ | Uptime Args Rate #ifdef IWLIB | Wireless Interface Args Rate #endif #ifdef LIBMPD | MPD Args Rate+ | AutoMPD Args #endif #ifdef ALSA | Volume String String Args Rate@@ -94,6 +97,7 @@ instance Exec Monitors where alias (Weather s _ _) = s alias (Network i _ _) = i+ alias (DynNetwork _ _) = "dynnetwork" alias (Thermal z _ _) = z alias (ThermalZone z _ _) = "thermal" ++ show z alias (Memory _ _) = "memory"@@ -115,6 +119,7 @@ #endif #ifdef LIBMPD alias (MPD _ _) = "mpd"+ alias (AutoMPD _) = "autompd" #endif #ifdef ALSA alias (Volume m c _ _) = m ++ ":" ++ c@@ -124,6 +129,7 @@ alias (Mpris2 _ _ _) = "mpris2" #endif start (Network i a r) = startNet i a r+ start (DynNetwork a r) = startDynNet a r start (Cpu a r) = startCpu a r start (MultiCpu a r) = startMultiCpu a r start (TopProc a r) = startTop a r@@ -147,6 +153,7 @@ #endif #ifdef LIBMPD start (MPD a r) = runM a mpdConfig runMPD r+ start (AutoMPD a) = runMB a mpdConfig runMPD mpdWait #endif #ifdef ALSA start (Volume m c a r) = runM a volumeConfig (runVolume m c) r
src/Plugins/Monitors/Bright.hs view
@@ -14,105 +14,92 @@ module Plugins.Monitors.Bright (brightConfig, runBright) where -import Plugins.Monitors.Common+import Control.Exception (SomeException, handle) import qualified Data.ByteString.Lazy.Char8 as B import Data.Char import System.FilePath ((</>)) import System.Posix.Files (fileExist) import System.Console.GetOpt -data BrightOpts = BrightOpts- { subDir :: String- , currBright :: String- , maxBright :: String- }+import Plugins.Monitors.Common +data BrightOpts = BrightOpts { subDir :: String+ , currBright :: String+ , maxBright :: String+ }+ defaultOpts :: BrightOpts-defaultOpts = BrightOpts- { subDir = "acpi_video0"- , currBright = "actual_brightness"- , maxBright = "max_brightness"- }+defaultOpts = BrightOpts { subDir = "acpi_video0"+ , currBright = "actual_brightness"+ , maxBright = "max_brightness"+ } 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 }) "") ""- ]+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 }) "") ""+ ] -- from Batt.hs parseOpts :: [String] -> IO BrightOpts parseOpts argv =- case getOpt Permute options argv of- (o, _, []) -> return $ foldr id defaultOpts o- (_, _, errs) -> ioError . userError $ concat errs+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs sysDir :: FilePath sysDir = "/sys/class/backlight/" brightConfig :: IO MConfig-brightConfig = mkMConfig- "<percent>" -- template- ["hbar", "percent", "bar"] -- replacements+brightConfig = mkMConfig "<percent>" -- template+ ["hbar", "percent", "bar"] -- replacements -data Files = Files- { fCurr :: String- , fMax :: String- } | NoFiles+data Files = Files { fCurr :: String+ , fMax :: String+ }+ | NoFiles 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)- }-+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)+ } runBright :: [String] -> Monitor String runBright args = do- opts <- io $ parseOpts args- f <- io $ brightFiles opts- c <- io $ readBright f- case f of- NoFiles -> return "hurz"- _ -> do x <- fmtPercent c- parseTemplate (x)- where- fmtPercent :: Float -> Monitor [String]- fmtPercent c = do- r <- showHorizontalBar (100 * c)- s <- showPercentWithColors c- t <- showPercentBar (100 * c) c- return [r,s,t]+ opts <- io $ parseOpts args+ f <- io $ brightFiles opts+ c <- io $ readBright f+ case f of+ NoFiles -> return "hurz"+ _ -> fmtPercent c >>= parseTemplate+ where fmtPercent :: Float -> Monitor [String]+ fmtPercent c = do r <- showHorizontalBar (100 * c)+ s <- showPercentWithColors c+ t <- showPercentBar (100 * c) c+ return [r,s,t] 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 = catch (fmap (read . B.unpack) $ B.readFile f)(\_ -> 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)+ handler = const (return 0) :: SomeException -> IO Float showHorizontalBar :: Float -> Monitor String showHorizontalBar x = do- return $ [convert x]- where- convert :: Float -> Char- convert val - | t <= 9600 = ' '- | t > 9608 = chr 9608- | otherwise = chr t- where- -- we scale from 0 to 100, we have 8 slots (9 elements), 100/8 = 12- t = 9600 + ((round val) `div` 12)+ return $ [convert x]+ where convert :: Float -> Char+ convert val+ | t <= 9600 = ' '+ | t > 9608 = chr 9608+ | otherwise = chr t+ where+ -- we scale from 0 to 100, we have 8 slots (9 elements), 100/8 = 12+ t = 9600 + ((round val) `div` 12)
src/Plugins/Monitors/Common.hs view
@@ -23,6 +23,7 @@ , getConfigValue , mkMConfig , runM+ , runMB , io -- * Parsers -- $parsers@@ -207,9 +208,13 @@ runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> (String -> IO ()) -> IO ()-runM args conf action r cb = handle (cb . showException) loop+runM args conf action r = runMB args conf action (tenthSeconds r)++runMB :: [String] -> IO MConfig -> ([String] -> Monitor String)+ -> IO () -> (String -> IO ()) -> IO ()+runMB args conf action wait cb = handle (cb . showException) loop where ac = doArgs args action- loop = conf >>= runReaderT ac >>= cb >> tenthSeconds r >> loop+ loop = conf >>= runReaderT ac >>= cb >> wait >> loop showException :: SomeException -> String showException = ("error: "++) . show . flip asTypeOf undefined
src/Plugins/Monitors/CoreCommon.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards, CPP #-}+{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- |
src/Plugins/Monitors/Disk.hs view
@@ -43,7 +43,7 @@ parse `fmap` mapM canon (devs s) where canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}- devs = filter isDev . map (firstTwo . B.words) . B.lines+ devs = filter isDev . map (firstTwo . B.words) . B.lines parse = map undev . filter isReq firstTwo (a:b:_) = (B.unpack a, B.unpack b) firstTwo _ = ("", "")@@ -51,6 +51,26 @@ isReq (d, p) = p `elem` req || drop 5 d `elem` req undev (d, f) = (drop 5 d, f) +diskDevices :: [String] -> IO [(DevName, Path)]+diskDevices req = do+ s <- B.readFile "/proc/diskstats"+ parse `fmap` mapM canon (devs s)+ where+ 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 _ = ("", "")+ isReq (d, p) = p `elem` req || drop 5 d `elem` req+ undev (d, f) = (drop 5 d, f)++mountedOrDiskDevices :: [String] -> IO [(DevName, Path)]+mountedOrDiskDevices req = do+ mnt <- mountedDevices req+ case mnt of+ [] -> diskDevices req+ other -> return other+ diskData :: IO [(DevName, [Float])] diskData = do s <- B.readFile "/proc/diskstats"@@ -77,15 +97,6 @@ dat' = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0] in (dev, dat') -fsStats :: String -> IO [Integer]-fsStats path = do- stats <- getFileSystemStats path- case stats of- Nothing -> return [0, 0, 0]- Just f -> let tot = fsStatByteCount f- free = fsStatBytesAvailable f- in return [tot, free, tot - free]- speedToStr :: Float -> String speedToStr = showWithUnits 2 1 @@ -118,18 +129,28 @@ runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String runDiskIO dref disks _ = do- mounted <- io $ mountedDevices (map fst disks)- dat <- io $ mountedData dref (map fst mounted)- strs <- mapM runDiskIO' $ devTemplates disks mounted dat+ dev <- io $ mountedOrDiskDevices (map fst disks)+ dat <- io $ mountedData dref (map fst dev)+ strs <- mapM runDiskIO' $ devTemplates disks dev dat return $ unwords strs startDiskIO :: [(String, String)] -> [String] -> Int -> (String -> IO ()) -> IO () startDiskIO disks args rate cb = do- mounted <- mountedDevices (map fst disks)- dref <- newIORef (map (\d -> (fst d, repeat 0)) mounted)- _ <- mountedData dref (map fst mounted)+ dev <- mountedOrDiskDevices (map fst disks)+ dref <- newIORef (map (\d -> (fst d, repeat 0)) dev)+ _ <- mountedData dref (map fst dev) runM args diskIOConfig (runDiskIO dref disks) rate cb++fsStats :: String -> IO [Integer]+fsStats path = do+ stats <- getFileSystemStats path+ case stats of+ Nothing -> return [0, 0, 0]+ Just f -> let tot = fsStatByteCount f+ free = fsStatBytesAvailable f+ used = fsStatBytesUsed f+ in return [tot, free, used] runDiskU' :: String -> String -> Monitor String runDiskU' tmp path = do
src/Plugins/Monitors/MPD.hs view
@@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.MPD ( mpdConfig, runMPD ) where+module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait ) where import Plugins.Monitors.Common import System.Console.GetOpt@@ -55,6 +55,10 @@ s <- parseMPD status song opts parseTemplate s +mpdWait :: IO ()+mpdWait = M.withMPD idle >> return ()+ where idle = M.idle [M.PlayerS, M.MixerS]+ mopts :: [String] -> IO MOpts mopts argv = case getOpt Permute options argv of@@ -91,10 +95,10 @@ parseSong (Right (Just s)) = let join [] = "" join (x:xs) = foldl (\a o -> a ++ ", " ++ o) x xs- str sel = maybe "" join (M.sgGetTag sel s)+ str sel = maybe "" (join . map M.toString) (M.sgGetTag sel s) sels = [ M.Name, M.Artist, M.Composer, M.Performer , M.Album, M.Title, M.Track, M.Genre ]- fields = M.sgFilePath s : map str sels+ fields = M.toString (M.sgFilePath s) : map str sels in mapM showWithPadding fields showTime :: Integer -> String
src/Plugins/Monitors/Mpris.hs view
@@ -21,54 +21,64 @@ import Plugins.Monitors.Common import Text.Printf (printf)-import qualified DBus.Client.Simple as C-import DBus.Types-import DBus.Connection ( ConnectionError )++import DBus+import qualified DBus.Client as DC+ import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) import System.IO.Unsafe (unsafePerformIO)-import qualified Data.Text as T import Control.Exception (try) class MprisVersion a where- getProxy :: a -> C.Client -> String -> IO C.Proxy- getMetadataReply :: a -> C.Client -> String -> IO [Variant]+ getMethodCall :: a -> String -> MethodCall+ getMetadataReply :: a -> DC.Client -> String -> IO [Variant]+ getMetadataReply mv c p = fmap methodReturnBody (DC.call_ c $ getMethodCall mv p) fieldsList :: a -> [String] data MprisVersion1 = MprisVersion1 instance MprisVersion MprisVersion1 where- getProxy MprisVersion1 c p = do- let playerBusName = T.concat ["org.mpris.", T.pack p]- C.proxy c (C.busName_ playerBusName) "/Player"- getMetadataReply MprisVersion1 c p = do- player <- getProxy MprisVersion1 c p- C.call player "org.freedesktop.MediaPlayer" "GetMetadata" []- fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title", "tracknumber" ]+ getMethodCall MprisVersion1 p = (methodCall objectPath interfaceName memberName)+ { methodCallDestination = Just busName+ }+ where+ busName = busName_ $ "org.mpris." ++ p+ objectPath = objectPath_ $ "/Player"+ interfaceName = interfaceName_ $ "org.freedesktop.MediaPlayer"+ memberName = memberName_ $ "GetMetadata" + fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title"+ , "tracknumber" ]+ data MprisVersion2 = MprisVersion2 instance MprisVersion MprisVersion2 where- getProxy MprisVersion2 c p = do- let playerBusName = T.concat ["org.mpris.MediaPlayer2.", T.pack p]- C.proxy c (C.busName_ playerBusName) "/org/mpris/MediaPlayer2"- getMetadataReply MprisVersion2 c p = do- player <- getProxy MprisVersion2 c p- C.call player "org.freedesktop.DBus.Properties"- "Get"- (map (toVariant::String -> Variant)- ["org.mpris.MediaPlayer2.Player", "Metadata"]- )+ getMethodCall MprisVersion2 p = (methodCall objectPath interfaceName memberName)+ { methodCallDestination = Just busName+ , methodCallBody = arguments+ }+ where+ 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"]+ fieldsList MprisVersion2 = [ "xesam:album", "xesam:artist", "mpris:artUrl"- , "mpris:length", "xesam:title", "xesam:trackNumber"+ , "mpris:length", "xesam:title",+ "xesam:trackNumber", "xesam:composer",+ "xesam:genre" ] mprisConfig :: IO MConfig mprisConfig = mkMConfig "<artist> - <title>"- [ "album", "artist", "arturl", "length" , "title", "tracknumber"+ [ "album", "artist", "arturl", "length"+ , "title", "tracknumber" , "composer", "genre" ] -dbusClient :: C.Client-dbusClient = unsafePerformIO C.connectSession+dbusClient :: DC.Client+dbusClient = unsafePerformIO DC.connectSession runMPRIS :: (MprisVersion a) => a -> String -> [String] -> Monitor String runMPRIS version playerName _ = do@@ -95,10 +105,10 @@ TypeStructure _ -> unpack $ head $ structureItems $ fromVar v _ -> [] -getMetadata :: (MprisVersion a) => a -> C.Client -> String -> IO [(String, Variant)]+getMetadata :: (MprisVersion a) => a -> DC.Client -> String -> IO [(String, Variant)] getMetadata version client player = do reply <- try (getMetadataReply version client player) ::- IO (Either ConnectionError [Variant])+ IO (Either DC.ClientError [Variant]) return $ case reply of Right metadata -> unpackMetadata metadata; Left _ -> []
src/Plugins/Monitors/Net.hs view
@@ -13,12 +13,18 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Net (startNet) where+module Plugins.Monitors.Net (+ startNet+ , startDynNet+ ) where import Plugins.Monitors.Common import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)+import Control.Monad (forM, filterM)+import System.Directory (getDirectoryContents, doesFileExist)+import System.FilePath ((</>)) import qualified Data.ByteString.Lazy.Char8 as B @@ -28,14 +34,39 @@ type NetDevRef = IORef (NetDev, UTCTime) +-- The more information available, the better.+-- Note that names don't matter. Therefore, if only the names differ,+-- a compare evaluates to EQ while (==) evaluates to False.+instance Ord NetDev where+ compare NA NA = EQ+ compare NA _ = LT+ compare _ NA = GT+ compare (NI _) (NI _) = EQ+ compare (NI _) (ND _ _ _) = LT+ compare (ND _ _ _) (NI _) = GT+ compare (ND _ x1 y1) (ND _ x2 y2) =+ if downcmp /= EQ+ then downcmp+ else y1 `compare` y2+ where downcmp = x1 `compare` x2+ netConfig :: IO MConfig netConfig = mkMConfig "<dev>: <rx>KB|<tx>KB" -- template ["dev", "rx", "tx", "rxbar", "txbar"] -- available replacements +operstateDir :: String -> FilePath+operstateDir d = "/sys/class/net" </> d </> "operstate"++existingDevs :: IO [String]+existingDevs = getDirectoryContents "/sys/class/net" >>= filterM isDev+ where isDev d | d `elem` excludes = return False+ | otherwise = doesFileExist (operstateDir d)+ excludes = [".", "..", "lo"]+ isUp :: String -> IO Bool isUp d = do- operstate <- B.readFile $ "/sys/class/net/" ++ d ++ "/operstate"+ operstate <- B.readFile (operstateDir d) return $ "up" == (B.unpack . head . B.lines) operstate readNetDev :: [String] -> IO NetDev@@ -103,9 +134,27 @@ runNet :: NetDevRef -> String -> [String] -> Monitor String runNet nref i _ = io (parseNet nref i) >>= printNet +parseNets :: [(NetDevRef, String)] -> IO [NetDev]+parseNets = mapM $ \(ref, i) -> parseNet ref i++runNets :: [(NetDevRef, String)] -> [String] -> Monitor String+runNets refs _ = io (parseActive refs) >>= printNet+ where parseActive refs' = parseNets refs' >>= return . selectActive+ selectActive = maximum+ startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO () startNet i a r cb = do t0 <- getCurrentTime nref <- newIORef (NA, t0) _ <- parseNet nref i runM a netConfig (runNet nref i) r cb++startDynNet :: [String] -> Int -> (String -> IO ()) -> IO ()+startDynNet a r cb = do+ devs <- existingDevs+ refs <- forM devs $ \d -> do+ t <- getCurrentTime+ nref <- newIORef (NA, t)+ _ <- parseNet nref d+ return (nref, d)+ runM a netConfig (runNets refs) r cb
src/Plugins/PipeReader.hs view
@@ -23,6 +23,12 @@ instance Exec PipeReader where alias (PipeReader _ a) = a start (PipeReader p _) cb = do- h <- openFile p ReadWriteMode+ let (def, pipe) = split ':' p+ h <- openFile pipe ReadWriteMode+ cb def forever (hGetLineSafe h >>= cb)- where forever a = a >> forever a+ where+ forever a = a >> forever a+ split c xs | c `elem` xs = let (pre, post) = span ((/=) c) xs+ in (pre, dropWhile ((==) c) post)+ | otherwise = ([], xs)
src/Plugins/StdinReader.hs view
@@ -14,11 +14,11 @@ module Plugins.StdinReader where -import Prelude hiding (catch)+import Prelude import System.Posix.Process import System.Exit import System.IO-import Control.Exception (SomeException(..),catch)+import Control.Exception (SomeException(..), handle) import Plugins data StdinReader = StdinReader@@ -26,8 +26,8 @@ instance Exec StdinReader where start StdinReader cb = do- cb =<< catch (hGetLineSafe stdin)- (\(SomeException e) -> do hPrint stderr e; return "")+ cb =<< handle (\(SomeException e) -> do hPrint stderr e; return "")+ (hGetLineSafe stdin) eof <- hIsEOF stdin if eof then exitImmediately ExitSuccess
src/Plugins/Utils.hs view
@@ -15,7 +15,7 @@ ------------------------------------------------------------------------------ -module Plugins.Utils (expandHome, changeLoop) where+module Plugins.Utils (expandHome, changeLoop, safeHead) where import Control.Monad import Control.Concurrent.STM@@ -37,3 +37,7 @@ new <- s guard (new /= old) return new)++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x:_) = Just x
src/Runnable.hs view
@@ -29,8 +29,9 @@ data Runnable = forall r . (Exec r, Read r, Show r) => Run r instance Exec Runnable where- start (Run a) = start a- alias (Run a) = alias a+ start (Run a) = start a+ alias (Run a) = alias a+ trigger (Run a) = trigger a instance Show Runnable where show (Run x) = show x
+ src/Signal.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE DeriveDataTypeable, CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module : Signal+-- Copyright : (c) Andrea Rosatto+-- : (c) Jose A. Ortega Ruiz+-- : (c) Jochen Keil+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Signal handling, including DBUS when available+--+-----------------------------------------------------------------------------++module Signal where++import Data.Typeable (Typeable)+import Control.Concurrent.STM+import Control.Exception hiding (handle)+import System.Posix.Signals++#ifdef DBUS+import DBus (IsVariant(..))+import Control.Monad ((>=>))+#endif++import Plugins.Utils (safeHead)++data WakeUp = WakeUp deriving (Show,Typeable)+instance Exception WakeUp++data SignalType = Wakeup+ | Reposition+ | ChangeScreen+ | Hide Int+ | Reveal Int+ | Toggle Int+ | TogglePersistent+ deriving (Read, Show)++#ifdef DBUS+instance IsVariant SignalType where+ toVariant = toVariant . show+ fromVariant = fromVariant >=> parseSignalType+#endif++parseSignalType :: String -> Maybe SignalType+parseSignalType = fmap fst . safeHead . reads++-- | Signal handling+setupSignalHandler :: IO (TMVar SignalType)+setupSignalHandler = do+ tid <- newEmptyTMVarIO+ installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing+ installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing+ return tid++updatePosHandler :: TMVar SignalType -> IO ()+updatePosHandler sig = do+ atomically $ putTMVar sig Reposition+ return ()++changeScreenHandler :: TMVar SignalType -> IO ()+changeScreenHandler sig = do+ atomically $ putTMVar sig ChangeScreen+ return ()
src/StatFS.hsc view
@@ -54,7 +54,7 @@ #ifdef IS_BSD_SYSTEM foreign import ccall unsafe "sys/mount.h statfs" #else-foreign import ccall unsafe "sys/vfs.h statfs64"+foreign import ccall unsafe "sys/statvfs.h statvfs" #endif c_statfs :: CString -> Ptr CStatfs -> IO CInt @@ -66,7 +66,7 @@ allocaBytes (#size struct statfs) $ \vfs -> useAsCString (pack path) $ \cpath -> do res <- c_statfs cpath vfs- if res == -1 then return Nothing+ if res /= 0 then return Nothing else do bsize <- (#peek struct statfs, f_bsize) vfs bcount <- (#peek struct statfs, f_blocks) vfs@@ -79,5 +79,5 @@ , fsStatByteCount = toI bcount * bpb , fsStatBytesFree = toI bfree * bpb , fsStatBytesAvailable = toI bavail * bpb- , fsStatBytesUsed = toI (bcount - bavail) * bpb+ , fsStatBytesUsed = toI (bcount - bfree) * bpb }
+ src/Window.hs view
@@ -0,0 +1,175 @@+-----------------------------------------------------------------------------+-- |+-- Module : Window+-- Copyright : (c) 2011-12 Jose A. Ortega Ruiz+-- : (c) 2012 Jochen Keil+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Window manipulation functions+--+-----------------------------------------------------------------------------++module Window where++import Prelude+import Control.Monad (when)+import Graphics.X11.Xlib hiding (textExtents, textWidth)+import Graphics.X11.Xlib.Extras+import Graphics.X11.Xinerama++import Data.Maybe(fromMaybe)+import System.Posix.Process (getProcessID)++import Config+import XUtil++-- $window++-- | The function to create the initial window+createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)+createWin d fs c = do+ let dflt = defaultScreen d+ srs <- getScreenInfo d+ rootw <- rootWindow d dflt+ (as,ds) <- textExtents fs "0"+ let ht = as + ds + 4+ (r,o) = setPosition (position c) srs (fi ht)+ win <- newWindow d (defaultScreenOfDisplay d) rootw r o+ setProperties r c d win srs+ when (lowerOnStart c) (lowerWindow d win)+ when (not $ hideOnStart c) $ mapWindow d win+ return (r,win)++-- | Updates the size and position of the window+repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle+repositionWin d win fs c = do+ srs <- getScreenInfo d+ (as,ds) <- textExtents fs "0"+ let ht = as + ds + 4+ (r,_) = setPosition (position c) srs (fi ht)+ moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)+ setProperties r c d win srs+ return r++setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)+setPosition p rs ht =+ case p' of+ Top -> (Rectangle rx ry rw h, True)+ TopW a i -> (Rectangle (ax a i) ry (nw i) h, True)+ TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True)+ Bottom -> (Rectangle rx ny rw h, True)+ BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True)+ BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True)+ Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True)+ OnScreen _ p'' -> setPosition p'' [scr] ht+ where+ (scr@(Rectangle rx ry rw rh), p') =+ case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)+ _ -> (head rs, p)+ ny = ry + fi (rh - ht)+ center i = rx + fi (div (remwid i) 2)+ right i = rx + fi (remwid i)+ remwid i = rw - pw (fi i)+ ax L = const rx+ ax R = right+ ax C = center+ pw i = rw * min 100 i `div` 100+ nw = fi . pw . fi+ h = fi ht+ mh h' = max (fi h') h+ ny' h' = ry + fi (rh - mh h')+ safeIndex i = lookup i . zip [0..]++setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()+setProperties r c d w srs = do+ a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False+ c1 <- internAtom d "CARDINAL" False+ a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False+ c2 <- internAtom d "ATOM" False+ v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False+ p <- internAtom d "_NET_WM_PID" False++ setTextProperty d w "xmobar" wM_CLASS+ setTextProperty d w "xmobar" wM_NAME++ ismapped <- isMapped d w+ changeProperty32 d w a1 c1 propModeReplace $+ if ismapped+ then map fi $ getStrutValues r (position c) (getRootWindowHeight srs)+ else replicate 12 0+ changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]++ getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral++getRootWindowHeight :: [Rectangle] -> Int+getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)+ where+ getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)++getStrutValues :: Rectangle -> XPosition -> Int -> [Int]+getStrutValues r@(Rectangle x y w h) p rwh =+ case p of+ OnScreen _ p' -> getStrutValues r p' rwh+ Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]+ TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]+ TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]+ Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]+ BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]+ BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]+ Static {} -> getStaticStrutValues p rwh+ where st = fi y + fi h+ sb = rwh - fi y+ nx = fi x+ nw = fi (x + fi w - 1)++-- get some reaonable strut values for static placement.+getStaticStrutValues :: XPosition -> Int -> [Int]+getStaticStrutValues (Static cx cy cw ch) rwh+ -- if the yPos is in the top half of the screen, then assume a Top+ -- placement, otherwise, it's a Bottom placement+ | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0]+ | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe]+ where st = cy + ch+ sb = rwh - cy+ xs = cx -- a simple calculation for horizontal (x) placement+ xe = xs + cw+getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]++drawBorder :: Border -> Display -> Drawable -> GC -> Pixel+ -> Dimension -> Dimension -> IO ()+drawBorder b d p gc c wi ht = case b of+ NoBorder -> return ()+ TopB -> drawBorder (TopBM 0) d p gc c w h+ BottomB -> drawBorder (BottomBM 0) d p gc c w h+ FullB -> drawBorder (FullBM 0) d p gc c w h+ TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0+ BottomBM m -> let rw = fi h - fi m in+ 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)++hideWindow :: Display -> Window -> IO ()+hideWindow d w = do+ a <- internAtom d "_NET_WM_STRUT_PARTIAL" False+ c <- internAtom d "CARDINAL" False+ changeProperty32 d w a c propModeReplace $ replicate 12 0+ unmapWindow d w >> sync d False++showWindow :: Rectangle -> Config -> Display -> Window -> IO ()+showWindow r cfg d w = do+ srs <- getScreenInfo d+ a <- internAtom d "_NET_WM_STRUT_PARTIAL" False+ c <- internAtom d "CARDINAL" False+ changeProperty32 d w a c propModeReplace $ map fi $+ getStrutValues r (position cfg) (getRootWindowHeight srs)+ mapWindow d w >> sync d False++isMapped :: Display -> Window -> IO Bool+isMapped d w = fmap ism $ getWindowAttributes d w+ where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped
src/XUtil.hsc view
@@ -2,8 +2,8 @@ ----------------------------------------------------------------------------- -- | -- Module : XUtil--- Copyright : (C) 2007 Andrea Rossato--- (C) 2011, 2012 Jose Antonio Ortega Ruiz+-- Copyright : (C) 2011, 2012 Jose Antonio Ortega Ruiz+-- (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : jao@gnu.org@@ -20,20 +20,17 @@ , textExtents , textWidth , printString- , initColor , newWindow , nextEvent' , readFileSafe , hGetLineSafe , io , fi- , withColors- , DynPixel(..) ) where import Control.Concurrent import Control.Monad.Trans-import Data.IORef+import Control.Exception (SomeException, handle) import Foreign -- import Foreign.C.Types import Graphics.X11.Xlib hiding (textExtents, textWidth)@@ -51,10 +48,12 @@ #endif #if defined XFT import Data.List-import Graphics.X11.Xft+import MinXft import Graphics.X11.Xrender #endif +import ColorCache+ readFileSafe :: FilePath -> IO String #if defined XFT || defined UTF8 readFileSafe = UTF8.readFile@@ -73,11 +72,11 @@ data XFont = Core FontStruct | Utf8 FontSet #ifdef XFT- | Xft XftFont+ | Xft AXftFont #endif --- | When initFont gets a font name that starts with 'xft:' it switchs to the Xft backend--- Example: 'xft:Sans-10'+-- | When initFont gets a font name that starts with 'xft:' it switchs+-- to the Xft backend Example: 'xft:Sans-10' initFont :: Display ->String -> IO XFont initFont d s = #ifdef XFT@@ -92,33 +91,38 @@ fmap Core $ initCoreFont d s #endif +miscFixedFont :: String+miscFixedFont = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+ -- | Given a fontname returns the font structure. If the font name is -- not valid the default font will be loaded and returned. initCoreFont :: Display -> String -> IO FontStruct initCoreFont d s = do- f <- catch getIt fallBack+ f <- handle fallBack getIt addFinalizer f (freeFont d f) return f- where getIt = loadQueryFont d s- fallBack = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+ where getIt = loadQueryFont d s+ fallBack :: SomeException -> IO FontStruct+ fallBack = const $ loadQueryFont d miscFixedFont -- | Given a fontname returns the font structure. If the font name is -- not valid the default font will be loaded and returned. initUtf8Font :: Display -> String -> IO FontSet initUtf8Font d s = do setupLocale- (_,_,f) <- catch getIt fallBack+ (_,_,f) <- handle fallBack getIt addFinalizer f (freeFontSet d f) return f- where getIt = createFontSet d s- fallBack = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+ where getIt = createFontSet d s+ fallBack :: SomeException -> IO ([String], String, FontSet)+ fallBack = const $ createFontSet d miscFixedFont #ifdef XFT-initXftFont :: Display -> String -> IO XftFont+initXftFont :: Display -> String -> IO AXftFont initXftFont d s = do setupLocale- f <- xftFontOpen d (defaultScreenOfDisplay d) (drop 4 s)- addFinalizer f (xftFontClose d f)+ f <- openAXftFont d (defaultScreenOfDisplay d) (drop 4 s)+ addFinalizer f (closeAXftFont d f) return f #endif @@ -127,7 +131,7 @@ textWidth _ (Core fs) s = return $ fi $ Xlib.textWidth fs s #ifdef XFT textWidth dpy (Xft xftdraw) s = do- gi <- xftTextExtents dpy xftdraw s+ gi <- xftTxtExtents dpy xftdraw s return $ xglyphinfo_xOff gi #endif @@ -142,8 +146,8 @@ return (ascent, descent) #ifdef XFT textExtents (Xft xftfont) _ = do- ascent <- fi `fmap` xftfont_ascent xftfont- descent <- fi `fmap` xftfont_descent xftfont+ ascent <- fi `fmap` xft_ascent xftfont+ descent <- fi `fmap` xft_descent xftfont return (ascent, descent) #endif @@ -163,59 +167,17 @@ io $ wcDrawImageString d p fs gc x y s #ifdef XFT-printString dpy drw fs@(Xft font) gc fc bc x y s = do- let screen = defaultScreenOfDisplay dpy- colormap = defaultColormapOfScreen screen- visual = defaultVisualOfScreen screen- withColors dpy [bc] $ \[bcolor] -> do- (a,d) <- textExtents fs s- gi <- xftTextExtents dpy font s- setForeground dpy gc bcolor- fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))- (y - fi (a + d))- (fi $ xglyphinfo_xOff gi)- (fi $ 4 + a + d)- withXftDraw dpy drw visual colormap $- \draw -> withXftColorName dpy visual colormap fc $- \color -> xftDrawString draw color font x (y - 2) s+printString dpy drw fs@(Xft font) _ fc bc x y s = do+ (a,d) <- textExtents fs s+ gi <- xftTxtExtents dpy font 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) #endif -data DynPixel = DynPixel { allocated :: Bool- , pixel :: Pixel- }---- | Get the Pixel value for a named color: if an invalid name is--- given the black pixel will be returned.-initColor :: Display -> String -> IO DynPixel-initColor dpy c = (initColor' dpy c) `catch`- (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))--type ColorCache = [(String, Color)]-{-# NOINLINE colorCache #-}-colorCache :: IORef ColorCache-colorCache = unsafePerformIO $ newIORef []--getCachedColor :: String -> IO (Maybe Color)-getCachedColor color_name = lookup color_name `fmap` readIORef colorCache--putCachedColor :: String -> Color -> IO ()-putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c--initColor' :: Display -> String -> IO DynPixel-initColor' dpy c = do- let colormap = defaultColormap dpy (defaultScreen dpy)- cached_color <- getCachedColor c- c' <- case cached_color of- Just col -> return col- _ -> do (c'', _) <- allocNamedColor dpy colormap c- putCachedColor c c''- return c''- return $ DynPixel True (color_pixel c')--withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a-withColors d cs f = do- ps <- mapM (io . initColor d) cs- f $ map pixel ps -- | Creates a window with the attribute override_redirect set to True. -- Windows Managers should not touch this kind of windows.
src/Xmobar.hs view
@@ -29,7 +29,7 @@ , drawInWin, printStrings ) where -import Prelude hiding (catch)+import Prelude import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama@@ -39,19 +39,26 @@ import Control.Monad.Reader import Control.Concurrent import Control.Concurrent.STM-import Control.Exception hiding (handle)+import Control.Exception (handle, SomeException(..)) import Data.Bits-import Data.Maybe(fromMaybe)-import Data.Typeable (Typeable)-import System.Posix.Process (getProcessID)-import System.Posix.Signals import Config import Parsers import Commands import Runnable+import Signal+import Window import XUtil+import ColorCache +#ifdef XFT+import Graphics.X11.Xft+#endif++#ifdef DBUS+import IPC.DBus+#endif+ -- $main -- -- The Xmobar data type and basic loops and functions.@@ -72,30 +79,29 @@ runX :: XConf -> X () -> IO () runX xc f = runReaderT f xc -data WakeUp = WakeUp deriving (Show,Typeable)-instance Exception WakeUp--data SignalType = Wakeup | Reposition | ChangeScreen- -- | Starts the main event loop and threads-startLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO ()-startLoop xcfg@(XConf _ _ w _ _) vs = do+startLoop :: XConf -> TMVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO ()+startLoop xcfg@(XConf _ _ w _ _) sig vs = do+#ifdef XFT+ xftInitFtLibrary+#endif tv <- atomically $ newTVar []- sig <- setupSignalHandler- _ <- forkIO (checker tv [] vs sig `catch`- \(SomeException _) -> void (putStrLn "Thread checker failed"))+ _ <- forkIO (handle (handler "checker") (checker tv [] vs sig)) #ifdef THREADED_RUNTIME- _ <- forkOS (eventer sig `catch`+ _ <- forkOS (handle (handler "eventer") (eventer sig)) #else- _ <- forkIO (eventer sig `catch`+ _ <- forkIO (handle (handler "eventer") (eventer sig)) #endif- \(SomeException _) -> void (putStrLn "Thread eventer failed"))+#ifdef DBUS+ runIPC sig+#endif eventLoop tv xcfg sig where+ handler thing (SomeException _) =+ putStrLn ("Thread " ++ thing ++ " failed") >> return () -- Reacts on events from X eventer signal = allocaXEvent $ \e -> do- dpy <- openDisplay "" xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask selectInput dpy w (exposureMask .|. structureNotifyMask)@@ -108,16 +114,16 @@ #endif ev <- getEvent e case ev of- ConfigureEvent {} -> putMVar signal Reposition- ExposeEvent {} -> putMVar signal Wakeup- RRScreenChangeNotifyEvent {} -> putMVar signal Reposition+ ConfigureEvent {} -> atomically $ putTMVar signal Reposition+ ExposeEvent {} -> atomically $ putTMVar signal Wakeup+ RRScreenChangeNotifyEvent {} -> atomically $ putTMVar signal Reposition _ -> return () -- | Send signal to eventLoop every time a var is updated checker :: TVar [String] -> [String] -> [[(Maybe ThreadId, TVar String)]]- -> MVar SignalType+ -> TMVar SignalType -> IO () checker tvar ov vs signal = do nval <- atomically $ do@@ -125,16 +131,16 @@ guard (nv /= ov) writeTVar tvar nv return nv- putMVar signal Wakeup+ atomically $ putTMVar signal Wakeup checker tvar nval vs signal where concatV = fmap concat . mapM (readTVar . snd) -- | Continuously wait for a signal from a thread or a interrupt handler-eventLoop :: TVar [String] -> XConf -> MVar SignalType -> IO ()-eventLoop tv xc@(XConf d _ w fs cfg) signal = do- typ <- takeMVar signal+eventLoop :: TVar [String] -> XConf -> TMVar SignalType -> IO ()+eventLoop tv xc@(XConf d r w fs cfg) signal = do+ typ <- atomically $ takeTMVar signal case typ of Wakeup -> do runX xc (updateWin tv)@@ -147,7 +153,38 @@ ncfg <- updateConfigPosition cfg reposWindow ncfg + Hide t -> hide (t*100*1000)+ Reveal t -> reveal (t*100*1000)+ Toggle t -> toggle t++ TogglePersistent -> eventLoop+ tv xc { config = cfg { persistent = not $ persistent cfg } } signal+ where+ isPersistent = not $ persistent cfg++ hide t+ | t == 0 =+ when isPersistent (hideWindow d w) >> eventLoop tv xc signal+ | otherwise = do+ void $ forkIO+ $ threadDelay t >> atomically (putTMVar signal $ Hide 0)+ eventLoop tv xc signal++ reveal t+ | t == 0 = do+ when isPersistent (showWindow r cfg d w)+ eventLoop tv xc signal+ | otherwise = do+ void $ forkIO+ $ threadDelay t >> atomically (putTMVar signal $ Reveal 0)+ eventLoop tv xc signal++ toggle t = do+ ismapped <- isMapped d w+ atomically (putTMVar signal $ if ismapped then Hide t else Reveal t)+ eventLoop tv xc signal+ reposWindow rcfg = do r' <- repositionWin d w fs rcfg eventLoop tv (XConf d r' w fs rcfg) signal@@ -163,149 +200,25 @@ o -> return (ocfg {position = OnScreen 1 o}) ---- | Signal handling-setupSignalHandler :: IO (MVar SignalType)-setupSignalHandler = do- tid <- newEmptyMVar- installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing- installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing- return tid--updatePosHandler :: MVar SignalType -> IO ()-updatePosHandler sig = do- putMVar sig Reposition- return ()--changeScreenHandler :: MVar SignalType -> IO ()-changeScreenHandler sig = do- putMVar sig ChangeScreen- return ()- -- $command -- | Runs a command as an independent thread and returns its thread id -- and the TVar the command will be writing to.-startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String)-startCommand (com,s,ss)+startCommand :: TMVar SignalType+ -> (Runnable,String,String)+ -> IO (Maybe ThreadId, TVar String)+startCommand sig (com,s,ss) | alias com == "" = do var <- atomically $ newTVar is atomically $ writeTVar var (s ++ ss) return (Nothing,var) | otherwise = do var <- atomically $ newTVar is let cb str = atomically $ writeTVar var (s ++ str ++ ss) h <- forkIO $ start com cb+ _ <- forkIO $ trigger com+ $ maybe (return ()) (atomically . putTMVar sig) return (Just h,var) where is = s ++ "Updating..." ++ ss --- $window---- | The function to create the initial window-createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)-createWin d fs c = do- let dflt = defaultScreen d- srs <- getScreenInfo d- rootw <- rootWindow d dflt- (as,ds) <- textExtents fs "0"- let ht = as + ds + 4- (r,o) = setPosition (position c) srs (fi ht)- win <- newWindow d (defaultScreenOfDisplay d) rootw r o- setProperties r c d win srs- when (lowerOnStart c) (lowerWindow d win)- mapWindow d win- return (r,win)---- | Updates the size and position of the window-repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle-repositionWin d win fs c = do- srs <- getScreenInfo d- (as,ds) <- textExtents fs "0"- let ht = as + ds + 4- (r,_) = setPosition (position c) srs (fi ht)- moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)- setProperties r c d win srs- return r--setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)-setPosition p rs ht =- case p' of- Top -> (Rectangle rx ry rw h, True)- TopW a i -> (Rectangle (ax a i) ry (nw i) h, True)- TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True)- Bottom -> (Rectangle rx ny rw h, True)- BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True)- BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True)- Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True)- OnScreen _ p'' -> setPosition p'' [scr] ht- where- (scr@(Rectangle rx ry rw rh), p') =- case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)- _ -> (head rs, p)- ny = ry + fi (rh - ht)- center i = rx + fi (div (remwid i) 2)- right i = rx + fi (remwid i)- remwid i = rw - pw (fi i)- ax L = const rx- ax R = right- ax C = center- pw i = rw * min 100 i `div` 100- nw = fi . pw . fi- h = fi ht- mh h' = max (fi h') h- ny' h' = ry + fi (rh - mh h')- safeIndex i = lookup i . zip [0..]--setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()-setProperties r c d w srs = do- a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False- c1 <- internAtom d "CARDINAL" False- a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False- c2 <- internAtom d "ATOM" False- v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False- p <- internAtom d "_NET_WM_PID" False-- setTextProperty d w "xmobar" wM_CLASS- setTextProperty d w "xmobar" wM_NAME-- changeProperty32 d w a1 c1 propModeReplace $ map fi $- getStrutValues r (position c) (getRootWindowHeight srs)- changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]-- getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral--getRootWindowHeight :: [Rectangle] -> Int-getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)- where- getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)--getStrutValues :: Rectangle -> XPosition -> Int -> [Int]-getStrutValues r@(Rectangle x y w h) p rwh =- case p of- OnScreen _ p' -> getStrutValues r p' rwh- Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]- TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]- TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]- Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]- BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]- BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]- Static {} -> getStaticStrutValues p rwh- where st = fi y + fi h- sb = rwh - fi y- nx = fi x- nw = fi (x + fi w - 1)---- get some reaonable strut values for static placement.-getStaticStrutValues :: XPosition -> Int -> [Int]-getStaticStrutValues (Static cx cy cw ch) rwh- -- if the yPos is in the top half of the screen, then assume a Top- -- placement, otherwise, it's a Bottom placement- | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0]- | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe]- where st = cy + ch- sb = rwh - cy- xs = cx -- a simple calculation for horizontal (x) placement- xe = xs + cw-getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]- updateWin :: TVar [String] -> X () updateWin v = do xc <- ask@@ -346,21 +259,6 @@ -- resync io $ sync d True -drawBorder :: Border -> Display -> Drawable -> GC -> Pixel- -> Dimension -> Dimension -> IO ()-drawBorder b d p gc c wi ht = case b of- NoBorder -> return ()- TopB -> drawBorder (TopBM 0) d p gc c w h- BottomB -> drawBorder (BottomBM 0) d p gc c w h- FullB -> drawBorder (FullBM 0) d p gc c w h- TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0- BottomBM m -> let rw = fi h - fi m in- 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)- -- | An easy way to print the stuff we need to print printStrings :: Drawable -> GC -> XFont -> Position -> Align -> [(String, String, Position)] -> X ()@@ -371,7 +269,7 @@ let (conf,d) = (config &&& display) r Rectangle _ _ wid ht = rect r totSLen = foldr (\(_,_,len) -> (+) len) 0 sl- valign = (fi ht `div` 2) + (fi (as + ds) `div` 3)+ valign = -1 + (fi ht + fi (as + ds)) `div` 2 remWidth = fi wid - fi totSLen offset = case a of C -> (remWidth + offs) `div` 2@@ -380,8 +278,5 @@ (fc,bc) = case break (==',') c of (f,',':b) -> (f, b ) (f, _) -> (f, bgColor conf)- withColors d [bc] $ \[bc'] -> do- io $ setForeground d gc bc'- io $ fillRectangle d dr gc offset 0 (fi l) ht io $ printString d dr fontst gc fc bc offset valign s printStrings dr gc fontst (offs + l) a xs
xmobar.cabal view
@@ -1,5 +1,5 @@ name: xmobar-version: 0.15+version: 0.16 homepage: http://projects.haskell.org/xmobar/ bug-reports: http://code.google.com/p/xmobar/issues synopsis: A Minimalistic Text Based Status Bar@@ -10,7 +10,7 @@ and extensibility through plugins. category: System license: BSD3-license-file: LICENSE+license-file: license author: Andrea Rossato maintainer: Jose A. Ortega Ruiz <jao@gnu.org> cabal-version: >= 1.6@@ -26,9 +26,6 @@ location: git://github.com/jaor/xmobar.git branch: master -flag small_base- description: Choose the new smaller, split-up base package.- flag with_xft description: Use Xft to render text. UTF-8 support included. default: False@@ -58,25 +55,31 @@ default: False flag with_datezone- description: Enables localized date support+ description: Enables localized date support. default: False flag with_mpris- description: MPRIS v1, v2 support+ description: MPRIS v1, v2 support. default: False +flag with_dbus+ description: Publish a service on the session bus for controlling xmobar.+ default: False+ flag with_threaded- description: Use threaded runtime+ description: Use threaded runtime. default: False executable xmobar hs-source-dirs: src main-is: Main.hs other-modules:- Xmobar, Config, Parsers, Commands, Localize, XUtil, StatFS, Runnable,- Plugins, Plugins.CommandReader, Plugins.Date, Plugins.EWMH,+ Xmobar, Config, Parsers, Commands, Localize,+ XUtil, StatFS, Runnable, ColorCache, Window, Signal,+ Plugins, Plugins.BufferedPipeReader,+ Plugins.CommandReader, Plugins.Date, Plugins.EWMH, Plugins.PipeReader, Plugins.StdinReader, Plugins.XMonadLog,- Plugins.Utils, Plugins.Kbd, Plugins.Monitors,+ Plugins.Utils, Plugins.Kbd, Plugins.Locks, Plugins.Monitors, Plugins.Monitors.Batt, Plugins.Monitors.Common, Plugins.Monitors.CoreCommon, Plugins.Monitors.CoreTemp, Plugins.Monitors.CpuFreq, Plugins.Monitors.Cpu,@@ -88,47 +91,37 @@ Plugins.Monitors.Bright ghc-prof-options: -prof -auto-all+ ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind+ extra-libraries: Xrandr - if true- ghc-options: -funbox-strict-fields -Wall- extra-libraries: Xrandr+ build-depends:+ base == 4.*,+ containers,+ process,+ old-locale,+ bytestring,+ directory,+ unix,+ time,+ filepath,+ X11 == 1.6.*,+ mtl >= 2.0 && < 2.2,+ parsec == 3.1.*,+ stm >= 2.3 && < 2.5 if flag(with_threaded)- -- -threaded is a workaround 100% CPU busy loop- -- (http://hackage.haskell.org/trac/ghc/ticket/4934)+ -- -threaded is a workaround for 100% CPU busy loop+ -- (http://hackage.haskell.org/trac/ghc/ticket/4934). -- See also comments in https://github.com/jaor/xmobar/pull/36 ghc-options: -threaded cpp-options: -DTHREADED_RUNTIME - if impl (ghc >= 6.12.1)- ghc-options: -fno-warn-unused-do-bind-- -- for instance declaration in src/Plugins/Monitors/CoreCommon.hs if impl (ghc < 7) cpp-options: -DGHC6 - build-depends:- unix,- time,- filepath,- X11 == 1.6.*,- mtl == 2.0.*,- parsec == 3.1.*,- stm == 2.3.*-- if flag(small_base)- build-depends:- base == 4.*,- containers,- process,- old-locale,- bytestring,- directory- else- build-depends: base < 3- if flag(with_xft) || flag(all_extensions) build-depends: utf8-string == 0.3.*, X11-xft >= 0.2 && < 0.4+ other-modules: MinXft cpp-options: -DXFT if flag(with_utf8) || flag(all_extensions)@@ -146,7 +139,7 @@ cpp-options: -DIWLIB if flag(with_mpd) || flag(all_extensions)- build-depends: libmpd == 0.7.*+ build-depends: libmpd == 0.8.* other-modules: Plugins.Monitors.MPD cpp-options: -DLIBMPD @@ -162,6 +155,11 @@ cpp-options: -DDATEZONE if flag(with_mpris) || flag(all_extensions)- build-depends: dbus-core >= 0.9.2.1, text >= 0.11.1.5 && < 0.12+ build-depends: dbus >= 0.10 other-modules: Plugins.Monitors.Mpris cpp-options: -DMPRIS++ if flag(with_dbus) || flag(all_extensions)+ build-depends: dbus >= 0.10+ other-modules: IPC.DBus+ cpp-options: -DDBUS